00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037 static char USMID[] = "\n@(#)5.0_pl/sources/s_intrin.c 5.31 10/27/99 16:50:34\n";
00038
00039 # include "defines.h"
00040 # include "host.m"
00041 # include "host.h"
00042 # include "target.m"
00043 # include "target.h"
00044 # include "globals.m"
00045 # include "tokens.m"
00046 # include "sytb.m"
00047 # include "s_globals.m"
00048 # include "debug.m"
00049 # include "fmath.h"
00050 # include "globals.h"
00051 # include "tokens.h"
00052 # include "sytb.h"
00053 # include "s_globals.h"
00054
00055 # if defined(_HOST_OS_UNICOS) || defined(_HOST_OS_MAX)
00056 # include <fortran.h>
00057 # endif
00058
00059
00060 extern boolean has_present_opr;
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080 static void generate_bounds_list(int bd_idx,
00081 opnd_type *result_opnd,
00082 expr_arg_type *exp_desc)
00083
00084 {
00085
00086 int col;
00087 int i;
00088 int ir_idx;
00089 int line;
00090 int list_idx = NULL_IDX;
00091 opnd_type opnd;
00092 cif_usage_code_type save_xref_state;
00093
00094
00095 TRACE (Func_Entry, "generate_bounds_list", NULL);
00096
00097 find_opnd_line_and_column(result_opnd, &line, &col);
00098
00099 NTR_IR_TBL(ir_idx);
00100 IR_OPR(ir_idx) = Array_Construct_Opr;
00101 IR_LINE_NUM(ir_idx) = line;
00102 IR_COL_NUM(ir_idx) = col;
00103
00104 IR_FLD_R(ir_idx) = IL_Tbl_Idx;
00105 IR_LIST_CNT_R(ir_idx) = 2 * BD_RANK(bd_idx);
00106
00107
00108 for (i = 1; i <= BD_RANK(bd_idx); i++) {
00109 if (list_idx == NULL_IDX) {
00110 NTR_IR_LIST_TBL(list_idx);
00111 IR_IDX_R(ir_idx) = list_idx;
00112 }
00113 else {
00114 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
00115 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
00116 list_idx = IL_NEXT_LIST_IDX(list_idx);
00117 }
00118
00119 IL_FLD(list_idx) = BD_LB_FLD(bd_idx, i);
00120 IL_IDX(list_idx) = BD_LB_IDX(bd_idx, i);
00121 IL_LINE_NUM(list_idx) = line;
00122 IL_COL_NUM(list_idx) = col;
00123
00124 COPY_OPND(opnd, IL_OPND(list_idx));
00125 cast_opnd_to_type_idx(&opnd, CG_INTEGER_DEFAULT_TYPE);
00126 COPY_OPND(IL_OPND(list_idx), opnd);
00127
00128 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
00129 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
00130 list_idx = IL_NEXT_LIST_IDX(list_idx);
00131
00132 if (BD_ARRAY_CLASS(bd_idx) == Assumed_Size &&
00133 i == BD_RANK(bd_idx)) {
00134
00135 IL_FLD(list_idx) = CN_Tbl_Idx;
00136 IL_IDX(list_idx) = CN_INTEGER_ZERO_IDX;
00137 }
00138 else {
00139 IL_FLD(list_idx) = BD_UB_FLD(bd_idx, i);
00140 IL_IDX(list_idx) = BD_UB_IDX(bd_idx, i);
00141 }
00142
00143 IL_LINE_NUM(list_idx) = line;
00144 IL_COL_NUM(list_idx) = col;
00145
00146 COPY_OPND(opnd, IL_OPND(list_idx));
00147 cast_opnd_to_type_idx(&opnd, CG_INTEGER_DEFAULT_TYPE);
00148 COPY_OPND(IL_OPND(list_idx), opnd);
00149 }
00150
00151 save_xref_state = xref_state;
00152 xref_state = CIF_No_Usage_Rec;
00153 OPND_FLD((*result_opnd)) = IR_Tbl_Idx;
00154 OPND_IDX((*result_opnd)) = ir_idx;
00155 exp_desc->rank = 0;
00156 expr_semantics(result_opnd, exp_desc);
00157 xref_state = save_xref_state;
00158
00159 TRACE (Func_Exit, "generate_bounds_list", NULL);
00160
00161 return;
00162
00163 }
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180
00181
00182
00183 static int cri_ptr_type(int type_idx)
00184
00185 {
00186 int ptr_type;
00187
00188
00189 TRACE (Func_Entry, "cri_ptr_type", NULL);
00190
00191 ptr_type = CRI_Ptr_8;
00192
00193 # ifdef _TRANSFORM_CHAR_SEQUENCE
00194 if (TYP_TYPE(type_idx) == Character ||
00195 (TYP_TYPE(type_idx) == Structure &&
00196 ATT_CHAR_SEQ(TYP_IDX(type_idx))))
00197 # else
00198 if (TYP_TYPE(type_idx) == Character)
00199 # endif
00200 {
00201
00202 ptr_type = CRI_Ch_Ptr_8;
00203 }
00204 # ifdef _TARGET32
00205 else if (TARGET_32BIT_DOUBLE_WORD_STORAGE_TYPE(type_idx) ||
00206 TYP_LINEAR(type_idx) == Complex_4) {
00207
00208 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
00209 TYP_TYPE(TYP_WORK_IDX) = CRI_Ptr;
00210 TYP_LINEAR(TYP_WORK_IDX) = CRI_Ptr_8;
00211 TYP_PTR_INCREMENT(TYP_WORK_IDX) = 64;
00212 ptr_type = ntr_type_tbl();
00213
00214 }
00215 # endif
00216
00217 # ifdef _TARGET_OS_MAX
00218 else if (TARGET_MAX_HALF_WORD_STORAGE_TYPE(type_idx)) {
00219
00220 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
00221 TYP_TYPE(TYP_WORK_IDX) = CRI_Ptr;
00222 TYP_LINEAR(TYP_WORK_IDX) = CRI_Ptr_8;
00223 TYP_PTR_INCREMENT(TYP_WORK_IDX) = 32;
00224 ptr_type = ntr_type_tbl();
00225 }
00226 # endif
00227
00228
00229 TRACE (Func_Exit, "cri_ptr_type", NULL);
00230
00231 return(ptr_type);
00232
00233 }
00234
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252 #if defined(GENERATE_WHIRL)
00253 #if COMPILER_VERSION < 730
00254 static void dummydummydummy(void *a, void *b){}
00255 #endif
00256 #endif
00257
00258 static boolean optimize_reshape(opnd_type *result_opnd,
00259 expr_arg_type *res_exp_desc)
00260
00261 {
00262 int asg_idx;
00263 int attr_idx;
00264 int bd_idx;
00265 int col;
00266 expr_arg_type exp_desc1;
00267 expr_arg_type exp_desc2;
00268 expr_arg_type exp_desc4;
00269 long i;
00270 int info_idx1;
00271 int info_idx2;
00272 int info_idx4;
00273 int ir_idx;
00274 int line;
00275 int list_idx1;
00276 int list_idx2;
00277 int list_idx3;
00278 int list_idx4;
00279 expr_arg_type loc_exp_desc;
00280 int loc_idx;
00281 opnd_type l_opnd;
00282 boolean ok;
00283 opnd_type opnd;
00284 boolean optimized = FALSE;
00285 boolean equal = TRUE;
00286 int ptee_idx;
00287 int ptr_idx;
00288 opnd_type r_opnd;
00289 int type_idx;
00290 int unused1;
00291 int unused2;
00292
00293
00294 TRACE (Func_Entry, "optimize_reshape", NULL);
00295
00296 if (OPND_FLD((*result_opnd)) == IR_Tbl_Idx &&
00297 IR_OPR(OPND_IDX((*result_opnd))) == Call_Opr) {
00298
00299 ir_idx = OPND_IDX((*result_opnd));
00300
00301 list_idx1 = IR_IDX_R(ir_idx);
00302 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
00303 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
00304 list_idx4 = IL_NEXT_LIST_IDX(list_idx3);
00305
00306 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
00307 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
00308
00309 #if defined(GENERATE_WHIRL)
00310 #if COMPILER_VERSION < 730
00311
00312 dummydummydummy(&info_idx1,&info_idx2);
00313 #endif
00314 #endif
00315
00316 exp_desc1 = arg_info_list[info_idx1].ed;
00317 exp_desc2 = arg_info_list[info_idx2].ed;
00318
00319 if (IL_FLD(list_idx4) != NO_Tbl_Idx) {
00320 info_idx4 = IL_ARG_DESC_IDX(list_idx4);
00321 exp_desc4 = arg_info_list[info_idx4].ed;
00322
00323 if (exp_desc4.foldable) {
00324
00325 attr_idx = find_base_attr(&IL_OPND(list_idx4), &line, &col);
00326 loc_exp_desc = init_exp_desc;
00327 loc_exp_desc.type_idx = ATD_TYPE_IDX(attr_idx);
00328 loc_exp_desc.type = TYP_TYPE(loc_exp_desc.type_idx);
00329 loc_exp_desc.linear_type = TYP_LINEAR(loc_exp_desc.type_idx);
00330
00331 loc_exp_desc.foldable = TRUE;
00332 loc_exp_desc.constant = TRUE;
00333
00334 for (i = 1; i <= res_exp_desc->rank; i++) {
00335 change_section_to_this_element(&IL_OPND(list_idx4),
00336 &opnd,
00337 i);
00338
00339 ok = fold_aggragate_expression(&opnd,
00340 &loc_exp_desc,
00341 TRUE);
00342
00343 equal = equal && compare_cn_and_value(OPND_IDX(opnd), i, Eq_Opr);
00344 }
00345
00346 if (equal && compare_cn_and_value(OPND_IDX(exp_desc4.shape[0]),
00347 (long) res_exp_desc->rank,
00348 Eq_Opr)) {
00349 IL_OPND(list_idx4) = null_opnd;
00350 }
00351 }
00352
00353 }
00354
00355 if (IL_FLD(list_idx3) == NO_Tbl_Idx &&
00356 IL_FLD(list_idx4) == NO_Tbl_Idx) {
00357
00358 if (exp_desc1.reference ||
00359 exp_desc1.tmp_reference) {
00360
00361 if (! exp_desc1.contig_array) {
00362 goto EXIT;
00363 }
00364
00365 attr_idx = find_base_attr(&IL_OPND(list_idx1), &line, &col);
00366
00367 if (ATD_POINTER(attr_idx)) {
00368 goto EXIT;
00369 }
00370
00371 if (ATD_ARRAY_IDX(attr_idx) &&
00372 BD_ARRAY_CLASS(ATD_ARRAY_IDX(attr_idx)) == Assumed_Shape) {
00373 goto EXIT;
00374 }
00375 }
00376 else {
00377
00378
00379 COPY_OPND(r_opnd, IL_OPND(list_idx1));
00380 attr_idx = create_tmp_asg(&r_opnd,
00381 &exp_desc1,
00382 &l_opnd,
00383 Intent_In,
00384 FALSE,
00385 FALSE);
00386
00387 COPY_OPND(IL_OPND(list_idx1), l_opnd);
00388 arg_info_list[info_idx1].ed = exp_desc1;
00389 }
00390
00391
00392 if (! exp_desc2.reference &&
00393 ! exp_desc2.tmp_reference) {
00394
00395 COPY_OPND(r_opnd, IL_OPND(list_idx2));
00396 attr_idx = create_tmp_asg(&r_opnd,
00397 &exp_desc2,
00398 &l_opnd,
00399 Intent_In,
00400 FALSE,
00401 FALSE);
00402
00403 COPY_OPND(IL_OPND(list_idx2), l_opnd);
00404 arg_info_list[info_idx2].ed = exp_desc2;
00405 }
00406
00407 attr_idx = find_base_attr(&IL_OPND(list_idx2), &line, &col);
00408 loc_exp_desc = init_exp_desc;
00409 loc_exp_desc.type_idx = ATD_TYPE_IDX(attr_idx);
00410 loc_exp_desc.type = TYP_TYPE(loc_exp_desc.type_idx);
00411 loc_exp_desc.linear_type = TYP_LINEAR(loc_exp_desc.type_idx);
00412
00413 if (exp_desc2.foldable) {
00414 loc_exp_desc.foldable = TRUE;
00415 loc_exp_desc.constant = TRUE;
00416 }
00417
00418 for (i = 1; i <= res_exp_desc->rank; i++) {
00419
00420 change_section_to_this_element(&IL_OPND(list_idx2),
00421 &opnd,
00422 i);
00423 if (exp_desc2.foldable) {
00424 ok = fold_aggragate_expression(&opnd,
00425 &loc_exp_desc,
00426 TRUE);
00427 }
00428
00429 COPY_OPND(res_exp_desc->shape[i-1], opnd);
00430 }
00431
00432 if (gen_bd_entry(NULL, res_exp_desc, &bd_idx, line, col)) {
00433
00434 }
00435
00436 type_idx = cri_ptr_type(exp_desc1.type_idx);
00437
00438
00439
00440 ptr_idx = gen_compiler_tmp(line, col, Shared, TRUE);
00441 ATD_TYPE_IDX(ptr_idx) = type_idx;
00442 AT_SEMANTICS_DONE(ptr_idx) = TRUE;
00443 ATD_STOR_BLK_IDX(ptr_idx) = SCP_SB_STACK_IDX(curr_scp_idx);
00444
00445 ptee_idx = gen_compiler_tmp(line, col, Shared, TRUE);
00446 ATD_CLASS(ptee_idx) = CRI__Pointee;
00447 AT_SEMANTICS_DONE(ptee_idx) = TRUE;
00448 ATD_STOR_BLK_IDX(ptee_idx) = SCP_SB_BASED_IDX(curr_scp_idx);
00449 ATD_TYPE_IDX(ptee_idx) = exp_desc1.type_idx;
00450 ATD_ARRAY_IDX(ptee_idx) = bd_idx;
00451 ATD_PTR_IDX(ptee_idx) = ptr_idx;
00452
00453
00454
00455 attr_idx = find_base_attr(&IL_OPND(list_idx1), &unused1, &unused2);
00456
00457 # if defined(GENERATE_WHIRL)
00458 if (AT_OBJ_CLASS(attr_idx) == Data_Obj) {
00459 ATD_NOT_PT_UNIQUE_MEM(attr_idx) = TRUE;
00460 }
00461 # endif
00462
00463 if (AT_OBJ_CLASS(attr_idx) == Data_Obj &&
00464 ATD_CLASS(attr_idx) == Compiler_Tmp &&
00465 exp_desc1.type != Character &&
00466 ATD_IM_A_DOPE(attr_idx)) {
00467
00468 asg_idx = gen_ir(AT_Tbl_Idx, ptr_idx,
00469 Asg_Opr, type_idx, line, col,
00470 IR_Tbl_Idx, gen_ir(AT_Tbl_Idx, attr_idx,
00471 Dv_Access_Base_Addr,
00472 SA_INTEGER_DEFAULT_TYPE,line,col,
00473 NO_Tbl_Idx, NULL_IDX));
00474
00475 }
00476 else {
00477
00478 COPY_OPND(opnd, IL_OPND(list_idx1));
00479 unused1 = NULL_IDX;
00480 unused2 = NULL_IDX;
00481 make_base_subtree(&opnd, &r_opnd, &unused1, &unused2);
00482
00483 loc_idx = gen_ir(OPND_FLD(r_opnd), OPND_IDX(r_opnd),
00484 Loc_Opr, type_idx, line, col,
00485 NO_Tbl_Idx, NULL_IDX);
00486
00487 # ifdef _TRANSFORM_CHAR_SEQUENCE
00488 if (exp_desc1.type == Structure &&
00489 ATT_CHAR_SEQ(TYP_IDX(exp_desc1.type_idx))) {
00490
00491 COPY_OPND(opnd, IR_OPND_L(loc_idx));
00492 transform_char_sequence_ref(&opnd, exp_desc1.type_idx);
00493 COPY_OPND(IR_OPND_L(loc_idx), opnd);
00494 }
00495 # endif
00496
00497 asg_idx = gen_ir(AT_Tbl_Idx, ptr_idx,
00498 Asg_Opr, type_idx, line, col,
00499 IR_Tbl_Idx, loc_idx);
00500
00501 }
00502
00503 gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00504
00505 SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
00506 SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00507
00508 gen_opnd(result_opnd, ptee_idx, AT_Tbl_Idx, line, col);
00509
00510 res_exp_desc->tmp_reference = TRUE;
00511 ok = gen_whole_subscript(result_opnd, res_exp_desc);
00512
00513 optimized = TRUE;
00514 }
00515 }
00516
00517 EXIT:
00518
00519 TRACE (Func_Exit, "optimize_reshape", NULL);
00520
00521 return(optimized);
00522
00523 }
00524
00525
00526
00527
00528
00529
00530
00531
00532
00533
00534
00535
00536
00537
00538
00539
00540
00541
00542
00543 void conform_check(int check_args,
00544 int ir_idx,
00545 expr_arg_type *res_exp_desc,
00546 int *spec_idx,
00547 boolean assumed_size_allowed)
00548 {
00549 int line;
00550 int col;
00551 int which_arg;
00552 int max_rank;
00553 int attr_idx;
00554 int temp_ir_idx;
00555 int i;
00556 int info_idx;
00557
00558
00559 TRACE (Func_Entry, "conform_check", NULL);
00560
00561 max_rank = 0;
00562
00563 temp_ir_idx = IR_IDX_R(ir_idx);
00564
00565 if (temp_ir_idx != NULL_IDX) {
00566 which_arg = IL_ARG_DESC_IDX(temp_ir_idx);
00567 }
00568
00569 res_exp_desc->will_fold_later = TRUE;
00570 res_exp_desc->foldable = TRUE;
00571
00572 for (i = 1; i <= IR_LIST_CNT_R(ir_idx); i++) {
00573
00574 if (IL_FLD(temp_ir_idx) == NO_Tbl_Idx) {
00575 temp_ir_idx = IL_NEXT_LIST_IDX(temp_ir_idx);
00576 continue;
00577 }
00578
00579 info_idx = IL_ARG_DESC_IDX(temp_ir_idx);
00580
00581 if (! assumed_size_allowed &&
00582 arg_info_list[info_idx].ed.rank != 0 &&
00583 (IL_FLD(temp_ir_idx) == AT_Tbl_Idx ||
00584 (IL_FLD(temp_ir_idx) == IR_Tbl_Idx &&
00585 IR_OPR(IL_IDX(temp_ir_idx)) == Whole_Substring_Opr &&
00586 IR_FLD_L(IL_IDX(temp_ir_idx)) == AT_Tbl_Idx))) {
00587
00588 PRINTMSG(arg_info_list[info_idx].line, 412, Error,
00589 arg_info_list[info_idx].col);
00590 }
00591
00592 attr_idx = 0;
00593 if ((IL_FLD(temp_ir_idx) == IR_Tbl_Idx) &&
00594 ((IR_OPR(IL_IDX(temp_ir_idx)) == Whole_Subscript_Opr) ||
00595 (IR_OPR(IL_IDX(temp_ir_idx)) == Section_Subscript_Opr))) {
00596 attr_idx = find_base_attr(&IL_OPND(temp_ir_idx), &line, &col);
00597 }
00598
00599 if ((check_args != 0) &&
00600 (i >= check_args) &&
00601 (arg_info_list[info_idx].ed.rank != max_rank) &&
00602 (attr_idx != 0) &&
00603 (!(ATP_INTRIN_ENUM(*spec_idx) == Present_Intrinsic)) &&
00604 (AT_OPTIONAL(attr_idx))) {
00605 PRINTMSG(arg_info_list[info_idx].line, 947, Error,
00606 arg_info_list[info_idx].col);
00607 }
00608
00609 if (!arg_info_list[info_idx].ed.foldable &&
00610 !arg_info_list[info_idx].ed.will_fold_later) {
00611 res_exp_desc->will_fold_later = FALSE;
00612 }
00613
00614 if (! arg_info_list[info_idx].ed.foldable) {
00615 res_exp_desc->foldable = FALSE;
00616 }
00617
00618 if (max_rank != 0 &&
00619 AT_ELEMENTAL_INTRIN(*spec_idx) &&
00620 arg_info_list[info_idx].ed.rank != 0 &&
00621 max_rank != arg_info_list[info_idx].ed.rank) {
00622 PRINTMSG(arg_info_list[info_idx].line, 363, Error,
00623 arg_info_list[info_idx].col);
00624 }
00625
00626 if (arg_info_list[info_idx].ed.rank > max_rank) {
00627 max_rank = arg_info_list[info_idx].ed.rank;
00628 which_arg = info_idx;
00629 }
00630
00631 temp_ir_idx = IL_NEXT_LIST_IDX(temp_ir_idx);
00632 }
00633
00634 if (ATP_PGM_UNIT(*spec_idx) != Subroutine) {
00635 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
00636 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
00637 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
00638 }
00639 res_exp_desc->rank = max_rank;
00640
00641 if (max_rank > 0 && AT_ELEMENTAL_INTRIN(*spec_idx)) {
00642 COPY_SHAPE(res_exp_desc->shape,
00643 arg_info_list[which_arg].ed.shape,
00644 arg_info_list[which_arg].ed.rank);
00645 }
00646
00647 TRACE (Func_Exit, "conform_check", NULL);
00648
00649 }
00650
00651
00652
00653
00654
00655
00656
00657
00658
00659
00660
00661
00662
00663
00664
00665
00666
00667
00668
00669
00670
00671
00672
00673
00674
00675
00676
00677
00678
00679
00680
00681
00682
00683
00684
00685
00686
00687
00688
00689
00690
00691
00692
00693
00694
00695
00696
00697
00698
00699
00700
00701
00702
00703
00704
00705
00706
00707
00708
00709
00710
00711
00712
00713
00714
00715
00716
00717
00718
00719
00720
00721
00722
00723
00724
00725
00726
00727
00728
00729
00730
00731
00732
00733
00734
00735
00736
00737
00738
00739
00740
00741 void sin_intrinsic(opnd_type *result_opnd,
00742 expr_arg_type *res_exp_desc,
00743 int *spec_idx)
00744 {
00745
00746 int info_idx1;
00747 int list_idx1;
00748 int ir_idx;
00749
00750
00751 TRACE (Func_Entry, "sin_intrinsic", NULL);
00752
00753 ir_idx = OPND_IDX((*result_opnd));
00754 list_idx1 = IR_IDX_R(ir_idx);
00755 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
00756 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
00757
00758 conform_check(0,
00759 ir_idx,
00760 res_exp_desc,
00761 spec_idx,
00762 FALSE);
00763
00764 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
00765 IR_RANK(ir_idx) = res_exp_desc->rank;
00766
00767
00768 switch (ATP_INTRIN_ENUM(*spec_idx)) {
00769 case Sin_Intrinsic:
00770 case Dsin_Intrinsic:
00771 case Qsin_Intrinsic:
00772 case Csin_Intrinsic:
00773 case Cdsin_Intrinsic:
00774 case Cqsin_Intrinsic:
00775
00776 break;
00777
00778 case Sind_Intrinsic:
00779 case Dsind_Intrinsic:
00780 case Qsind_Intrinsic:
00781
00782 break;
00783
00784 case Cos_Intrinsic:
00785 case Dcos_Intrinsic:
00786 case Qcos_Intrinsic:
00787 case Ccos_Intrinsic:
00788 case Cdcos_Intrinsic:
00789 case Cqcos_Intrinsic:
00790
00791 break;
00792
00793 case Cosd_Intrinsic:
00794 case Dcosd_Intrinsic:
00795 case Qcosd_Intrinsic:
00796
00797 break;
00798
00799 case Log_Intrinsic:
00800 case Alog_Intrinsic:
00801 case Dlog_Intrinsic:
00802 case Qlog_Intrinsic:
00803 case Clog_Intrinsic:
00804 case Cdlog_Intrinsic:
00805 case Cqlog_Intrinsic:
00806 if ((IL_FLD(list_idx1) == CN_Tbl_Idx) &&
00807 (arg_info_list[info_idx1].ed.type == Real)) {
00808
00809 if (fold_relationals(IL_IDX(list_idx1),
00810 CN_INTEGER_ZERO_IDX,
00811 Le_Opr)) {
00812
00813 PRINTMSG(arg_info_list[info_idx1].line, 1062, Error,
00814 arg_info_list[info_idx1].col);
00815 }
00816 }
00817
00818
00819 break;
00820
00821 case Log10_Intrinsic:
00822 case Alog10_Intrinsic:
00823 case Dlog10_Intrinsic:
00824 case Qlog10_Intrinsic:
00825
00826 break;
00827
00828 case Tan_Intrinsic:
00829 case Dtan_Intrinsic:
00830 case Qtan_Intrinsic:
00831
00832 break;
00833
00834 case Tand_Intrinsic:
00835 case Dtand_Intrinsic:
00836 case Qtand_Intrinsic:
00837
00838 break;
00839
00840 case Tanh_Intrinsic:
00841 case Dtanh_Intrinsic:
00842 case Qtanh_Intrinsic:
00843
00844 break;
00845
00846 case Sinh_Intrinsic:
00847 case Dsinh_Intrinsic:
00848 case Qsinh_Intrinsic:
00849
00850 break;
00851
00852 case Cosh_Intrinsic:
00853 case Dcosh_Intrinsic:
00854 case Qcosh_Intrinsic:
00855
00856 break;
00857
00858 case Acos_Intrinsic:
00859 case Dacos_Intrinsic:
00860 case Qacos_Intrinsic:
00861
00862 break;
00863
00864 case Acosd_Intrinsic:
00865 case Dacosd_Intrinsic:
00866 case Qacosd_Intrinsic:
00867
00868 break;
00869
00870 case Asin_Intrinsic:
00871 case Dasin_Intrinsic:
00872 case Qasin_Intrinsic:
00873
00874 break;
00875
00876 case Asind_Intrinsic:
00877 case Dasind_Intrinsic:
00878 case Qasind_Intrinsic:
00879
00880 break;
00881
00882 case Atan_Intrinsic:
00883 case Datan_Intrinsic:
00884 case Qatan_Intrinsic:
00885
00886 break;
00887
00888 case Atand_Intrinsic:
00889 case Datand_Intrinsic:
00890 case Qatand_Intrinsic:
00891
00892 break;
00893
00894 case Cot_Intrinsic:
00895 case Dcot_Intrinsic:
00896 case Qcot_Intrinsic:
00897
00898 break;
00899
00900 case Exp_Intrinsic:
00901 case Dexp_Intrinsic:
00902 case Qexp_Intrinsic:
00903 case Cexp_Intrinsic:
00904 case Cdexp_Intrinsic:
00905 case Cqexp_Intrinsic:
00906
00907 break;
00908
00909 case Sqrt_Intrinsic:
00910 case Dsqrt_Intrinsic:
00911 case Qsqrt_Intrinsic:
00912 case Csqrt_Intrinsic:
00913 case Cdsqrt_Intrinsic:
00914 case Cqsqrt_Intrinsic:
00915 if ((IL_FLD(list_idx1) == CN_Tbl_Idx) &&
00916 (arg_info_list[info_idx1].ed.type == Real)) {
00917
00918 if (fold_relationals(IL_IDX(list_idx1),
00919 CN_INTEGER_ZERO_IDX,
00920 Lt_Opr)) {
00921
00922 PRINTMSG(arg_info_list[info_idx1].line, 1062, Error,
00923 arg_info_list[info_idx1].col);
00924 }
00925 }
00926
00927
00928 break;
00929
00930 default:
00931 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal, IR_COL_NUM(ir_idx),
00932 "sin_intrinsic");
00933 break;
00934 }
00935
00936 # if 0
00937
00938 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
00939 IR_OPND_R(ir_idx) = null_opnd;
00940
00941
00942
00943
00944 # if defined(_USE_FOLD_DOT_f)
00945 if (IR_OPR(ir_idx) != Sqrt_Opr) {
00946 # endif
00947 res_exp_desc->foldable = FALSE;
00948 res_exp_desc->will_fold_later = FALSE;
00949 # if defined(_USE_FOLD_DOT_f)
00950 }
00951 # endif
00952
00953
00954 io_item_must_flatten = TRUE;
00955
00956 # endif
00957
00958 res_exp_desc->foldable = FALSE;
00959 res_exp_desc->will_fold_later = FALSE;
00960
00961 TRACE (Func_Exit, "sin_intrinsic", NULL);
00962
00963 }
00964
00965
00966
00967
00968
00969
00970
00971
00972
00973
00974
00975
00976
00977
00978
00979
00980
00981
00982 void abs_intrinsic(opnd_type *result_opnd,
00983 expr_arg_type *res_exp_desc,
00984 int *spec_idx)
00985 {
00986 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
00987 int ir_idx;
00988 int info_idx1;
00989 int list_idx1;
00990 int type_idx;
00991
00992
00993 TRACE (Func_Entry, "abs_intrinsic", NULL);
00994
00995 ir_idx = OPND_IDX((*result_opnd));
00996 list_idx1 = IR_IDX_R(ir_idx);
00997 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
00998 type_idx = arg_info_list[info_idx1].ed.type_idx;
00999
01000 if (TYP_TYPE(type_idx) == Complex) {
01001 switch (TYP_LINEAR(type_idx)) {
01002 case Complex_16:
01003 type_idx = Real_16;
01004 break;
01005
01006 case Complex_8:
01007 type_idx = Real_8;
01008 break;
01009
01010 case Complex_4:
01011 type_idx = Real_4;
01012 break;
01013 }
01014 }
01015
01016 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
01017
01018 conform_check(0,
01019 ir_idx,
01020 res_exp_desc,
01021 spec_idx,
01022 FALSE);
01023
01024
01025 IR_TYPE_IDX(ir_idx) = type_idx;
01026 IR_RANK(ir_idx) = res_exp_desc->rank;
01027
01028
01029 res_exp_desc->type_idx = type_idx;
01030 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
01031 res_exp_desc->type = TYP_TYPE(type_idx);
01032 res_exp_desc->shape_known = TRUE;
01033
01034
01035
01036
01037
01038 # if 0
01039
01040 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
01041 arg_info_list[info_idx1].ed.type == Integer &&
01042 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
01043 arg_info_list[info_idx1].ed.type_idx,
01044 NULL,
01045 NULL_IDX,
01046 folded_const,
01047 &type_idx,
01048 IR_LINE_NUM(ir_idx),
01049 IR_COL_NUM(ir_idx),
01050 1,
01051 Abs_Opr)) {
01052
01053 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
01054 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
01055 FALSE,
01056 folded_const);
01057 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
01058 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
01059 res_exp_desc->constant = TRUE;
01060 res_exp_desc->foldable = TRUE;
01061 }
01062 else {
01063 IR_OPR(ir_idx) = Abs_Opr;
01064 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01065 IR_OPND_R(ir_idx) = null_opnd;
01066
01067 if (arg_info_list[info_idx1].ed.type != Integer) {
01068
01069
01070
01071 res_exp_desc->foldable = FALSE;
01072 res_exp_desc->will_fold_later = FALSE;
01073 }
01074 }
01075
01076 # endif
01077 res_exp_desc->foldable = FALSE;
01078 res_exp_desc->will_fold_later = FALSE;
01079
01080
01081 TRACE (Func_Exit, "abs_intrinsic", NULL);
01082
01083 }
01084
01085
01086
01087
01088
01089
01090
01091
01092
01093
01094
01095
01096
01097
01098
01099
01100
01101
01102
01103 void atan2_intrinsic(opnd_type *result_opnd,
01104 expr_arg_type *res_exp_desc,
01105 int *spec_idx)
01106 {
01107 int ir_idx;
01108 int info_idx1;
01109 int info_idx2;
01110 int list_idx1;
01111 int list_idx2;
01112
01113
01114 TRACE (Func_Entry, "atan2_intrinsic", NULL);
01115
01116 ir_idx = OPND_IDX((*result_opnd));
01117 list_idx1 = IR_IDX_R(ir_idx);
01118 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
01119 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
01120 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
01121 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
01122
01123 conform_check(0,
01124 ir_idx,
01125 res_exp_desc,
01126 spec_idx,
01127 FALSE);
01128
01129 if (arg_info_list[info_idx1].ed.linear_type !=
01130 arg_info_list[info_idx2].ed.linear_type) {
01131 PRINTMSG(arg_info_list[info_idx2].line, 774, Error,
01132 arg_info_list[info_idx2].col);
01133 }
01134
01135 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
01136 IR_RANK(ir_idx) = res_exp_desc->rank;
01137
01138 switch (ATP_INTRIN_ENUM(*spec_idx)) {
01139 case Atan2_Intrinsic:
01140 case Datan2_Intrinsic:
01141 case Qatan2_Intrinsic:
01142
01143 break;
01144
01145 case Atan2d_Intrinsic:
01146 case Datan2d_Intrinsic:
01147 case Qatan2d_Intrinsic:
01148
01149 break;
01150
01151 default:
01152 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal, IR_COL_NUM(ir_idx),
01153 "atan2_intrinsic");
01154 break;
01155 }
01156
01157 # if 0
01158
01159 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01160 IR_OPND_R(ir_idx) = null_opnd;
01161
01162
01163
01164
01165 # endif
01166
01167 res_exp_desc->foldable = FALSE;
01168 res_exp_desc->will_fold_later = FALSE;
01169
01170 TRACE (Func_Exit, "atan2_intrinsic", NULL);
01171
01172 }
01173
01174
01175
01176
01177
01178
01179
01180
01181
01182
01183
01184
01185
01186
01187
01188
01189
01190
01191 void aimag_intrinsic(opnd_type *result_opnd,
01192 expr_arg_type *res_exp_desc,
01193 int *spec_idx)
01194 {
01195 int ir_idx;
01196 int type_idx;
01197 int info_idx1;
01198 int list_idx1;
01199
01200
01201 TRACE (Func_Entry, "aimag_intrinsic", NULL);
01202
01203 ir_idx = OPND_IDX((*result_opnd));
01204 list_idx1 = IR_IDX_R(ir_idx);
01205 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
01206
01207 switch (arg_info_list[info_idx1].ed.linear_type) {
01208 case Complex_4: type_idx = Real_4; break;
01209 case Complex_8: type_idx = Real_8; break;
01210 case Complex_16: type_idx = Real_16; break;
01211 }
01212
01213 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
01214
01215 conform_check(0,
01216 ir_idx,
01217 res_exp_desc,
01218 spec_idx,
01219 FALSE);
01220
01221 IR_TYPE_IDX(ir_idx) = type_idx;
01222 IR_RANK(ir_idx) = res_exp_desc->rank;
01223
01224 # if 0
01225
01226 IR_OPR(ir_idx) = Aimag_Opr;
01227 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01228 IR_OPND_R(ir_idx) = null_opnd;
01229
01230
01231
01232
01233 # endif
01234
01235 res_exp_desc->foldable = FALSE;
01236 res_exp_desc->will_fold_later = FALSE;
01237
01238
01239 TRACE (Func_Exit, "aimag_intrinsic", NULL);
01240
01241 }
01242
01243
01244
01245
01246
01247
01248
01249
01250
01251
01252
01253
01254
01255
01256
01257
01258
01259
01260
01261
01262
01263
01264
01265
01266
01267
01268
01269
01270
01271
01272
01273
01274
01275
01276
01277
01278
01279
01280
01281
01282 void int_intrinsic(opnd_type *result_opnd,
01283 expr_arg_type *res_exp_desc,
01284 int *spec_idx)
01285 {
01286 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
01287 int ir_idx;
01288 int list_idx1;
01289 int list_idx2;
01290 int info_idx1;
01291 int info_idx2;
01292 opnd_type opnd;
01293 int type_idx;
01294
01295
01296 TRACE (Func_Entry, "int_intrinsic", NULL);
01297
01298 ir_idx = OPND_IDX((*result_opnd));
01299 list_idx1 = IR_IDX_R(ir_idx);
01300 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
01301 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
01302
01303 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
01304 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
01305 kind_to_linear_type(&((IL_OPND(list_idx2))),
01306 ATP_RSLT_IDX(*spec_idx),
01307 arg_info_list[info_idx2].ed.kind0seen,
01308 arg_info_list[info_idx2].ed.kind0E0seen,
01309 arg_info_list[info_idx2].ed.kind0D0seen,
01310 ! arg_info_list[info_idx2].ed.kindnotconst);
01311 }
01312 else {
01313 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
01314 }
01315
01316 if (ATP_INTRIN_ENUM(*spec_idx) == Int1_Intrinsic) {
01317 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_1;
01318 }
01319 else if (ATP_INTRIN_ENUM(*spec_idx) == Short_Intrinsic ||
01320 ATP_INTRIN_ENUM(*spec_idx) == Int2_Intrinsic ||
01321 ATP_INTRIN_ENUM(*spec_idx) == Iint_Intrinsic ||
01322 ATP_INTRIN_ENUM(*spec_idx) == Iifix_Intrinsic ||
01323 ATP_INTRIN_ENUM(*spec_idx) == Iidint_Intrinsic ||
01324 ATP_INTRIN_ENUM(*spec_idx) == Iiqint_Intrinsic) {
01325 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_2;
01326 }
01327 else if (ATP_INTRIN_ENUM(*spec_idx) == Long_Intrinsic ||
01328 ATP_INTRIN_ENUM(*spec_idx) == Int4_Intrinsic ||
01329 ATP_INTRIN_ENUM(*spec_idx) == Jint_Intrinsic ||
01330 ATP_INTRIN_ENUM(*spec_idx) == Jifix_Intrinsic ||
01331 ATP_INTRIN_ENUM(*spec_idx) == Jidint_Intrinsic ||
01332 ATP_INTRIN_ENUM(*spec_idx) == Jiqint_Intrinsic) {
01333 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_4;
01334 }
01335 else if (ATP_INTRIN_ENUM(*spec_idx) == Kint_Intrinsic ||
01336 ATP_INTRIN_ENUM(*spec_idx) == Int8_Intrinsic ||
01337 ATP_INTRIN_ENUM(*spec_idx) == Kifix_Intrinsic ||
01338 ATP_INTRIN_ENUM(*spec_idx) == Kidint_Intrinsic ||
01339 ATP_INTRIN_ENUM(*spec_idx) == Kiqint_Intrinsic) {
01340 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
01341 }
01342
01343 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
01344
01345 conform_check(0,
01346 ir_idx,
01347 res_exp_desc,
01348 spec_idx,
01349 FALSE);
01350
01351 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
01352
01353 if (arg_info_list[info_idx1].ed.type == Real) {
01354 COPY_OPND(opnd, IL_OPND(list_idx1));
01355 look_for_real_div(&opnd);
01356 COPY_OPND(IL_OPND(list_idx1), opnd);
01357 }
01358
01359
01360 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
01361 IR_RANK(ir_idx) = res_exp_desc->rank;
01362
01363 res_exp_desc->type_idx = type_idx;
01364 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
01365
01366 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
01367 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
01368 arg_info_list[info_idx1].ed.type_idx,
01369 NULL,
01370 NULL_IDX,
01371 folded_const,
01372 &type_idx,
01373 IR_LINE_NUM(ir_idx),
01374 IR_COL_NUM(ir_idx),
01375 1,
01376 Int_Opr)) {
01377
01378 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
01379 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
01380 FALSE,
01381 folded_const);
01382 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
01383 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
01384 res_exp_desc->constant = TRUE;
01385 res_exp_desc->foldable = TRUE;
01386 }
01387 else {
01388 IR_OPR(ir_idx) = Int_Opr;
01389 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01390 IR_OPND_R(ir_idx) = null_opnd;
01391 IR_LIST_CNT_L(ir_idx) = 1;
01392 IL_NEXT_LIST_IDX(IR_IDX_L(ir_idx)) = NULL_IDX;
01393 }
01394
01395
01396 TRACE (Func_Exit, "int_intrinsic", NULL);
01397
01398 }
01399
01400
01401
01402
01403
01404
01405
01406
01407
01408
01409
01410
01411
01412
01413
01414
01415
01416
01417
01418
01419
01420
01421
01422
01423
01424
01425
01426
01427
01428
01429
01430
01431
01432
01433 void iand_intrinsic(opnd_type *result_opnd,
01434 expr_arg_type *res_exp_desc,
01435 int *spec_idx)
01436 {
01437 opnd_type opnd;
01438 int cn_idx;
01439 int cn_idx2;
01440 int typeless_idx;
01441 int minus_idx;
01442 int column;
01443 int info_idx1;
01444 int info_idx2;
01445 int line;
01446 int list_idx1;
01447 int list_idx2;
01448 long num;
01449 int shiftl_idx;
01450 int shiftr_idx;
01451 int first_idx;
01452 int second_idx;
01453 int not_idx;
01454 int ir_idx;
01455 boolean ok = TRUE;
01456 operator_type opr;
01457 int type_idx;
01458
01459
01460 TRACE (Func_Entry, "iand_intrinsic", NULL);
01461
01462 ir_idx = OPND_IDX((*result_opnd));
01463
01464 list_idx1 = IR_IDX_R(ir_idx);
01465 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
01466 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
01467 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
01468
01469 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
01470 (arg_info_list[info_idx1].ed.linear_type == Short_Typeless_Const ||
01471 arg_info_list[info_idx1].ed.linear_type == Short_Char_Const)) {
01472
01473 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx1),
01474 &line,
01475 &column);
01476
01477 if (arg_info_list[info_idx1].ed.type == Character) {
01478 PRINTMSG(line, 161, Ansi, column);
01479 }
01480
01481 type_idx = arg_info_list[info_idx2].ed.type_idx;
01482
01483 if (arg_info_list[info_idx2].ed.type == Character ||
01484 arg_info_list[info_idx2].ed.type == Typeless) {
01485 type_idx = INTEGER_DEFAULT_TYPE;
01486 }
01487
01488 IL_IDX(list_idx1) = cast_typeless_constant(IL_IDX(list_idx1),
01489 type_idx,
01490 line,
01491 column);
01492
01493 arg_info_list[info_idx1].ed.type_idx = type_idx;
01494 arg_info_list[info_idx1].ed.type = TYP_TYPE(type_idx);
01495 arg_info_list[info_idx1].ed.linear_type = TYP_LINEAR(type_idx);
01496 }
01497
01498 if (IL_FLD(list_idx2) == CN_Tbl_Idx &&
01499 (arg_info_list[info_idx2].ed.linear_type == Short_Typeless_Const ||
01500 arg_info_list[info_idx2].ed.linear_type == Short_Char_Const)) {
01501
01502 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx2),
01503 &line,
01504 &column);
01505
01506 if (arg_info_list[info_idx2].ed.type == Character) {
01507 PRINTMSG(line, 161, Ansi, column);
01508 }
01509
01510 type_idx = arg_info_list[info_idx1].ed.type_idx;
01511
01512 if (arg_info_list[info_idx1].ed.type == Character ||
01513 arg_info_list[info_idx1].ed.type == Typeless) {
01514 type_idx = INTEGER_DEFAULT_TYPE;
01515 }
01516
01517 IL_IDX(list_idx2) = cast_typeless_constant(IL_IDX(list_idx2),
01518 type_idx,
01519 line,
01520 column);
01521
01522 arg_info_list[info_idx2].ed.type_idx = type_idx;
01523 arg_info_list[info_idx2].ed.type = TYP_TYPE(type_idx);
01524 arg_info_list[info_idx2].ed.linear_type = TYP_LINEAR(type_idx);
01525 }
01526
01527
01528 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
01529 # if defined(GENERATE_WHIRL)
01530 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
01531 if (arg_info_list[info_idx1].ed.type == Integer) {
01532 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
01533 arg_info_list[info_idx1].ed.linear_type;
01534 }
01535 # endif
01536
01537 # ifdef _TARGET32
01538 if (arg_info_list[info_idx1].ed.linear_type == Integer_8 ||
01539 arg_info_list[info_idx1].ed.linear_type == Typeless_8 ||
01540 arg_info_list[info_idx1].ed.linear_type == Real_8) {
01541 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_8;
01542 # if defined(GENERATE_WHIRL)
01543 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
01544 # endif
01545 }
01546 # endif
01547
01548 # ifdef _TARGET_OS_MAX
01549 if (arg_info_list[info_idx1].ed.linear_type == Integer_1 ||
01550 arg_info_list[info_idx1].ed.linear_type == Integer_2 ||
01551 arg_info_list[info_idx1].ed.linear_type == Integer_4 ||
01552 arg_info_list[info_idx1].ed.linear_type == Typeless_4 ||
01553 arg_info_list[info_idx1].ed.linear_type == Real_4) {
01554 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_4;
01555 }
01556 # endif
01557
01558
01559 if (ATP_INTRIN_ENUM(*spec_idx) == Iand_Intrinsic ||
01560 ATP_INTRIN_ENUM(*spec_idx) == Iiand_Intrinsic ||
01561 ATP_INTRIN_ENUM(*spec_idx) == Jiand_Intrinsic ||
01562 ATP_INTRIN_ENUM(*spec_idx) == Kiand_Intrinsic ||
01563 ATP_INTRIN_ENUM(*spec_idx) == Ior_Intrinsic ||
01564 ATP_INTRIN_ENUM(*spec_idx) == Iior_Intrinsic ||
01565 ATP_INTRIN_ENUM(*spec_idx) == Jior_Intrinsic ||
01566 ATP_INTRIN_ENUM(*spec_idx) == Kior_Intrinsic ||
01567 ATP_INTRIN_ENUM(*spec_idx) == Ieor_Intrinsic ||
01568 ATP_INTRIN_ENUM(*spec_idx) == Iieor_Intrinsic ||
01569 ATP_INTRIN_ENUM(*spec_idx) == Jieor_Intrinsic ||
01570 ATP_INTRIN_ENUM(*spec_idx) == Kieor_Intrinsic) {
01571 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
01572 arg_info_list[info_idx1].ed.type_idx;
01573
01574 if (arg_info_list[info_idx1].ed.type == Typeless ||
01575 arg_info_list[info_idx2].ed.type == Typeless) {
01576 PRINTMSG(arg_info_list[info_idx1].line, 1076, Ansi,
01577 arg_info_list[info_idx1].col);
01578
01579 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
01580 }
01581
01582 # ifdef _TARGET32
01583 if (arg_info_list[info_idx1].ed.linear_type == Integer_8 ||
01584 arg_info_list[info_idx1].ed.linear_type == Typeless_8) {
01585 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
01586 }
01587 # endif
01588
01589 if (arg_info_list[info_idx1].ed.linear_type !=
01590 arg_info_list[info_idx2].ed.linear_type) {
01591 PRINTMSG(arg_info_list[info_idx2].line, 774, Error,
01592 arg_info_list[info_idx2].col);
01593 ok = FALSE;
01594 }
01595 }
01596
01597
01598
01599 switch (ATP_INTRIN_ENUM(*spec_idx)) {
01600 case Iand_Intrinsic:
01601 case Iiand_Intrinsic:
01602 case Jiand_Intrinsic:
01603 case Kiand_Intrinsic:
01604 opr = Band_Opr;
01605 break;
01606
01607 case Ior_Intrinsic:
01608 case Iior_Intrinsic:
01609 case Jior_Intrinsic:
01610 case Kior_Intrinsic:
01611 opr = Bor_Opr;
01612 break;
01613
01614 case Ieor_Intrinsic:
01615 case Iieor_Intrinsic:
01616 case Jieor_Intrinsic:
01617 case Kieor_Intrinsic:
01618 opr = Bneqv_Opr;
01619 break;
01620
01621 case And_Intrinsic:
01622 opr = Band_Opr;
01623 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] !=
01624 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type]) {
01625 PRINTMSG(IR_LINE_NUM(ir_idx), 1188, Error,
01626 IR_COL_NUM(ir_idx));
01627 ok = FALSE;
01628 }
01629 else if (arg_info_list[info_idx1].ed.type == Logical &&
01630 arg_info_list[info_idx2].ed.type == Logical) {
01631 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
01632 opr = And_Opr;
01633
01634 }
01635 break;
01636
01637 case Or_Intrinsic:
01638 opr = Bor_Opr;
01639 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] !=
01640 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type]) {
01641 PRINTMSG(IR_LINE_NUM(ir_idx), 1188, Error,
01642 IR_COL_NUM(ir_idx));
01643 ok = FALSE;
01644 }
01645 else if (arg_info_list[info_idx1].ed.type == Logical &&
01646 arg_info_list[info_idx2].ed.type == Logical) {
01647 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
01648 opr = Or_Opr;
01649 }
01650 break;
01651
01652 case Xor_Intrinsic:
01653 opr = Bneqv_Opr;
01654 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] !=
01655 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type]) {
01656 PRINTMSG(IR_LINE_NUM(ir_idx), 1188, Error,
01657 IR_COL_NUM(ir_idx));
01658 ok = FALSE;
01659 }
01660 else if (arg_info_list[info_idx1].ed.type == Logical &&
01661 arg_info_list[info_idx2].ed.type == Logical) {
01662 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
01663 opr = Neqv_Opr;
01664 }
01665 break;
01666
01667 case Neqv_Intrinsic:
01668 opr = Bneqv_Opr;
01669 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] !=
01670 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type]) {
01671 PRINTMSG(IR_LINE_NUM(ir_idx), 1188, Error,
01672 IR_COL_NUM(ir_idx));
01673 ok = FALSE;
01674 }
01675 else if (arg_info_list[info_idx1].ed.type == Logical &&
01676 arg_info_list[info_idx2].ed.type == Logical) {
01677 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
01678 opr = Neqv_Opr;
01679 }
01680 break;
01681
01682 case Eqv_Intrinsic:
01683 opr = Beqv_Opr;
01684 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] !=
01685 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type]) {
01686 PRINTMSG(IR_LINE_NUM(ir_idx), 1188, Error,
01687 IR_COL_NUM(ir_idx));
01688 ok = FALSE;
01689 }
01690 else if (arg_info_list[info_idx1].ed.type == Logical &&
01691 arg_info_list[info_idx2].ed.type == Logical) {
01692 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
01693 opr = Eqv_Opr;
01694 }
01695 break;
01696
01697 default:
01698 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal, IR_COL_NUM(ir_idx),
01699 "iand_intrinsic");
01700 break;
01701 }
01702
01703 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
01704
01705 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_8 ||
01706 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Typeless_8) {
01707 typeless_idx = Typeless_8;
01708 # if defined(GENERATE_WHIRL)
01709 typeless_idx = Integer_8;
01710 # endif
01711 }
01712 else {
01713 typeless_idx = TYPELESS_DEFAULT_TYPE;
01714 # if defined(GENERATE_WHIRL)
01715 typeless_idx = INTEGER_DEFAULT_TYPE;
01716 if (arg_info_list[info_idx1].ed.type == Integer) {
01717 typeless_idx = arg_info_list[info_idx1].ed.linear_type;
01718 }
01719 # endif
01720 }
01721
01722 # ifdef _TARGET_OS_MAX
01723 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_1 ||
01724 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_2 ||
01725 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Typeless_4 ||
01726 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_4) {
01727 typeless_idx = Typeless_4;
01728 }
01729 # endif
01730
01731 conform_check(0,
01732 ir_idx,
01733 res_exp_desc,
01734 spec_idx,
01735 FALSE);
01736
01737
01738 IR_TYPE_IDX(ir_idx) = type_idx;
01739 IR_RANK(ir_idx) = res_exp_desc->rank;
01740
01741
01742
01743 res_exp_desc->type_idx = type_idx;
01744 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
01745
01746 if (opr == And_Opr ||
01747 opr == Or_Opr ||
01748 opr == Eqv_Opr ||
01749 opr == Neqv_Opr) {
01750 IR_OPR(ir_idx) = opr;
01751 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01752 IR_OPND_R(ir_idx) = null_opnd;
01753 }
01754 else {
01755
01756
01757 line = IR_LINE_NUM(ir_idx);
01758 column = IR_COL_NUM(ir_idx);
01759
01760 not_idx = gen_ir(IL_FLD(list_idx1), IL_IDX(list_idx1),
01761 opr, typeless_idx, line, column,
01762 IL_FLD(list_idx2), IL_IDX(list_idx2));
01763
01764 num=storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
01765
01766 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
01767
01768 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
01769 case Integer_1:
01770 num = BITSIZE_INT1_F90;
01771 break;
01772
01773 case Integer_2:
01774 num = BITSIZE_INT2_F90;
01775 break;
01776
01777 case Integer_4:
01778 case Typeless_4:
01779 num = BITSIZE_INT4_F90;
01780 break;
01781
01782 case Integer_8:
01783 case Typeless_8:
01784 num = BITSIZE_INT8_F90;
01785 break;
01786 }
01787
01788 cn_idx2 = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
01789
01790 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
01791 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, line, column,
01792 CN_Tbl_Idx, cn_idx2);
01793
01794
01795 NTR_IR_LIST_TBL(first_idx);
01796 IL_FLD(first_idx) = IR_Tbl_Idx;
01797 IL_IDX(first_idx) = not_idx;
01798 NTR_IR_LIST_TBL(second_idx);
01799 IL_FLD(second_idx) = IR_Tbl_Idx;
01800 IL_IDX(second_idx) = minus_idx;
01801 IL_NEXT_LIST_IDX(first_idx) = second_idx;
01802
01803 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
01804 Shiftl_Opr, typeless_idx, line, column,
01805 NO_Tbl_Idx, NULL_IDX);
01806
01807 NTR_IR_LIST_TBL(first_idx);
01808 IL_FLD(first_idx) = IR_Tbl_Idx;
01809 IL_IDX(first_idx) = shiftl_idx;
01810 NTR_IR_LIST_TBL(second_idx);
01811 IL_FLD(second_idx) = IR_Tbl_Idx;
01812 IL_IDX(second_idx) = minus_idx;
01813 IL_NEXT_LIST_IDX(first_idx) = second_idx;
01814
01815 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
01816 Shiftr_Opr, typeless_idx, line, column,
01817 NO_Tbl_Idx, NULL_IDX);
01818
01819 if (TYP_TYPE(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer) {
01820 IR_OPR(shiftr_idx) = Shifta_Opr;
01821 }
01822
01823 IR_OPR(ir_idx) = Cvrt_Opr;
01824 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
01825 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
01826 IR_IDX_L(ir_idx) = shiftr_idx;
01827 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
01828 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
01829 IR_FLD_R(ir_idx) = NO_Tbl_Idx;
01830 IR_IDX_R(ir_idx) = NULL_IDX;
01831
01832 if (ok &&
01833 IL_FLD(list_idx1) == CN_Tbl_Idx &&
01834 IL_FLD(list_idx2) == CN_Tbl_Idx) {
01835 COPY_OPND(opnd, (*result_opnd));
01836 ok = fold_aggragate_expression(&opnd, res_exp_desc, FALSE);
01837 COPY_OPND((*result_opnd), opnd);
01838 }
01839
01840 }
01841
01842 #if 0
01843 res_exp_desc->foldable = FALSE;
01844 res_exp_desc->will_fold_later = FALSE;
01845 #endif
01846
01847 TRACE (Func_Exit, "iand_intrinsic", NULL);
01848
01849 }
01850
01851
01852
01853
01854
01855
01856
01857
01858
01859
01860
01861
01862
01863
01864
01865
01866
01867
01868 void mod_intrinsic(opnd_type *result_opnd,
01869 expr_arg_type *res_exp_desc,
01870 int *spec_idx)
01871 {
01872 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
01873 int info_idx1;
01874 int info_idx2;
01875 int list_idx1;
01876 int list_idx2;
01877 int ir_idx;
01878 int type_idx;
01879
01880
01881 TRACE (Func_Entry, "mod_intrinsic", NULL);
01882
01883 ir_idx = OPND_IDX((*result_opnd));
01884
01885 list_idx1 = IR_IDX_R(ir_idx);
01886 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
01887 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
01888 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
01889
01890 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
01891 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
01892
01893 conform_check(0,
01894 ir_idx,
01895 res_exp_desc,
01896 spec_idx,
01897 FALSE);
01898
01899 IR_TYPE_IDX(ir_idx) = type_idx;
01900 IR_RANK(ir_idx) = res_exp_desc->rank;
01901 res_exp_desc->type_idx = type_idx;
01902 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
01903
01904 if (arg_info_list[info_idx1].ed.linear_type !=
01905 arg_info_list[info_idx2].ed.linear_type) {
01906 PRINTMSG(IR_LINE_NUM(ir_idx), 774, Error,
01907 IR_COL_NUM(ir_idx));
01908 }
01909
01910 if (arg_info_list[info_idx1].ed.type == Integer &&
01911 IL_FLD(list_idx1) == CN_Tbl_Idx &&
01912 IL_FLD(list_idx2) == CN_Tbl_Idx &&
01913 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
01914 arg_info_list[info_idx1].ed.type_idx,
01915 (char *)&CN_CONST(IL_IDX(list_idx2)),
01916 arg_info_list[info_idx2].ed.type_idx,
01917 folded_const,
01918 &type_idx,
01919 IR_LINE_NUM(ir_idx),
01920 IR_COL_NUM(ir_idx),
01921 2,
01922 Mod_Opr)) {
01923 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
01924 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
01925 FALSE,
01926 folded_const);
01927 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
01928 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
01929 res_exp_desc->constant = TRUE;
01930 res_exp_desc->foldable = TRUE;
01931 }
01932 else {
01933 IR_OPR(ir_idx) = Mod_Opr;
01934 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01935 IR_OPND_R(ir_idx) = null_opnd;
01936
01937 if (arg_info_list[info_idx1].ed.type != Integer) {
01938
01939
01940
01941 res_exp_desc->foldable = FALSE;
01942 res_exp_desc->will_fold_later = FALSE;
01943 }
01944 }
01945
01946
01947 TRACE (Func_Exit, "mod_intrinsic", NULL);
01948
01949 }
01950
01951
01952
01953
01954
01955
01956
01957
01958
01959
01960
01961
01962
01963
01964
01965
01966
01967
01968 void free_intrinsic(opnd_type *result_opnd,
01969 expr_arg_type *res_exp_desc,
01970 int *spec_idx)
01971 {
01972 int ir_idx;
01973
01974
01975 TRACE (Func_Entry, "free_intrinsic", NULL);
01976
01977 ir_idx = OPND_IDX((*result_opnd));
01978
01979 conform_check(0,
01980 ir_idx,
01981 res_exp_desc,
01982 spec_idx,
01983 FALSE);
01984
01985
01986 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
01987 IR_RANK(ir_idx) = res_exp_desc->rank;
01988
01989 # if 0
01990
01991 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
01992 IR_OPR(ir_idx) = Free_Opr;
01993 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
01994 IR_OPND_R(ir_idx) = null_opnd;
01995 }
01996
01997
01998
01999
02000 # endif
02001
02002 res_exp_desc->foldable = FALSE;
02003 res_exp_desc->will_fold_later = FALSE;
02004
02005 TRACE (Func_Exit, "free_intrinsic", NULL);
02006
02007 }
02008
02009
02010
02011
02012
02013
02014
02015
02016
02017
02018
02019
02020
02021
02022
02023
02024
02025 void malloc_intrinsic(opnd_type *result_opnd,
02026 expr_arg_type *res_exp_desc,
02027 int *spec_idx)
02028 {
02029 int ir_idx;
02030
02031
02032 TRACE (Func_Entry, "malloc_intrinsic", NULL);
02033
02034 ir_idx = OPND_IDX((*result_opnd));
02035
02036 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ptr_8;
02037
02038 conform_check(0,
02039 ir_idx,
02040 res_exp_desc,
02041 spec_idx,
02042 FALSE);
02043
02044
02045 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02046 IR_RANK(ir_idx) = res_exp_desc->rank;
02047
02048 # if 0
02049
02050 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02051 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
02052
02053 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
02054 IR_OPR(ir_idx) = Malloc_Opr;
02055 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02056 IR_OPND_R(ir_idx) = null_opnd;
02057 }
02058
02059
02060
02061
02062 # endif
02063
02064 res_exp_desc->foldable = FALSE;
02065 res_exp_desc->will_fold_later = FALSE;
02066
02067 TRACE (Func_Exit, "malloc_intrinsic", NULL);
02068
02069 }
02070
02071
02072
02073
02074
02075
02076
02077
02078
02079
02080
02081
02082
02083
02084
02085
02086
02087
02088 void null_intrinsic(opnd_type *result_opnd,
02089 expr_arg_type *res_exp_desc,
02090 int *spec_idx)
02091 {
02092 int info_idx1;
02093 int ir_idx;
02094 int line;
02095 int col;
02096 int list_idx1;
02097 int tmp_dv_idx;
02098 int attr_idx;
02099 opnd_type dv_opnd;
02100
02101
02102 TRACE (Func_Entry, "null_intrinsic", NULL);
02103
02104 ir_idx = OPND_IDX((*result_opnd));
02105 list_idx1 = IR_IDX_R(ir_idx);
02106
02107 line = IR_LINE_NUM(ir_idx);
02108 col = IR_COL_NUM(ir_idx);
02109
02110 conform_check(0,
02111 ir_idx,
02112 res_exp_desc,
02113 spec_idx,
02114 FALSE);
02115
02116 if (list_idx1 == NULL_IDX || IL_IDX(list_idx1) == NULL_IDX) {
02117 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
02118
02119 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02120 IR_RANK(ir_idx) = res_exp_desc->rank;
02121
02122 # if 0
02123
02124 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02125 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
02126 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
02127 res_exp_desc->pointer = TRUE;
02128
02129 IR_OPR(ir_idx) = Null_Intrinsic_Opr;
02130 IR_OPND_R(ir_idx) = null_opnd;
02131 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
02132 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);
02133 IR_OPND_R(ir_idx) = null_opnd;
02134 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
02135 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
02136
02137 # endif
02138
02139 res_exp_desc->foldable = FALSE;
02140 res_exp_desc->will_fold_later = FALSE;
02141 }
02142 else {
02143 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02144
02145 if (TYP_TYPE(arg_info_list[info_idx1].ed.type_idx) == Character) {
02146 COPY_OPND((res_exp_desc->char_len),
02147 (arg_info_list[info_idx1].ed.char_len));
02148 }
02149
02150 attr_idx = find_base_attr(&IL_OPND(list_idx1), &line, &col);
02151
02152 if (IL_FLD(list_idx1) == CN_Tbl_Idx || !ATD_POINTER(attr_idx)) {
02153 PRINTMSG(arg_info_list[info_idx1].line, 1574, Error,
02154 arg_info_list[info_idx1].col);
02155 res_exp_desc->foldable = FALSE;
02156 res_exp_desc->will_fold_later = FALSE;
02157 }
02158
02159 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
02160 arg_info_list[info_idx1].ed.type_idx;
02161
02162 # if 0
02163
02164 ATD_POINTER(ATP_RSLT_IDX(*spec_idx)) = TRUE;
02165
02166 tmp_dv_idx = gen_compiler_tmp(line, col, Priv, TRUE);
02167 ATD_TYPE_IDX(tmp_dv_idx) = ATD_TYPE_IDX(attr_idx);
02168 ATD_STOR_BLK_IDX(tmp_dv_idx) = SCP_SB_STACK_IDX(curr_scp_idx);
02169 AT_SEMANTICS_DONE(tmp_dv_idx) = TRUE;
02170 ATD_ARRAY_IDX(tmp_dv_idx) = ATD_ARRAY_IDX(attr_idx);
02171 ATD_POINTER(tmp_dv_idx) = TRUE;
02172 ATD_IM_A_DOPE(tmp_dv_idx) = TRUE;
02173
02174 gen_opnd(&dv_opnd, tmp_dv_idx, AT_Tbl_Idx, line, col);
02175 gen_dv_whole_def_init(&dv_opnd,
02176 tmp_dv_idx,
02177 Before);
02178
02179 # endif
02180
02181 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02182 IR_RANK(ir_idx) = res_exp_desc->rank;
02183
02184 # if 0
02185
02186 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02187 res_exp_desc->type =
02188 TYP_TYPE(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
02189 res_exp_desc->linear_type =
02190 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
02191 res_exp_desc->pointer = TRUE;
02192 res_exp_desc->tmp_reference = TRUE;
02193
02194 gen_opnd(&dv_opnd,
02195 gen_ir(AT_Tbl_Idx,
02196 tmp_dv_idx,
02197 Dv_Deref_Opr,
02198 res_exp_desc->type_idx,
02199 line,
02200 col,
02201 NO_Tbl_Idx,
02202 NULL_IDX),
02203 IR_Tbl_Idx,
02204 line,
02205 col);
02206
02207 if (res_exp_desc->rank > 0) {
02208 gen_whole_subscript(&dv_opnd, res_exp_desc);
02209 }
02210
02211 OPND_IDX((*result_opnd)) = OPND_IDX(dv_opnd);
02212 OPND_FLD((*result_opnd)) = OPND_FLD(dv_opnd);
02213
02214 # endif
02215 res_exp_desc->foldable = FALSE;
02216 res_exp_desc->will_fold_later = FALSE;
02217 }
02218
02219 TRACE (Func_Exit, "null_intrinsic", NULL);
02220
02221 }
02222
02223
02224
02225
02226
02227
02228
02229
02230
02231
02232
02233
02234
02235
02236
02237
02238
02239
02240
02241 void anint_intrinsic(opnd_type *result_opnd,
02242 expr_arg_type *res_exp_desc,
02243 int *spec_idx)
02244 {
02245 int info_idx1;
02246 int info_idx2;
02247 int ir_idx;
02248 int list_idx1;
02249 int list_idx2;
02250
02251
02252 TRACE (Func_Entry, "anint_intrinsic", NULL);
02253
02254 ir_idx = OPND_IDX((*result_opnd));
02255 list_idx1 = IR_IDX_R(ir_idx);
02256 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
02257 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02258
02259 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
02260 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
02261 kind_to_linear_type(&((IL_OPND(list_idx2))),
02262 ATP_RSLT_IDX(*spec_idx),
02263 arg_info_list[info_idx2].ed.kind0seen,
02264 arg_info_list[info_idx2].ed.kind0E0seen,
02265 arg_info_list[info_idx2].ed.kind0D0seen,
02266 ! arg_info_list[info_idx2].ed.kindnotconst);
02267 }
02268 else {
02269 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
02270 arg_info_list[info_idx1].ed.type_idx;
02271 }
02272
02273 conform_check(0,
02274 ir_idx,
02275 res_exp_desc,
02276 spec_idx,
02277 FALSE);
02278
02279 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02280 IR_RANK(ir_idx) = res_exp_desc->rank;
02281
02282 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02283 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
02284
02285 IR_OPR(ir_idx) = Anint_Opr;
02286 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02287 IR_OPND_R(ir_idx) = null_opnd;
02288 IR_LIST_CNT_L(ir_idx) = 1;
02289 IL_NEXT_LIST_IDX(IR_IDX_L(ir_idx)) = NULL_IDX;
02290
02291
02292
02293
02294 res_exp_desc->foldable = FALSE;
02295 res_exp_desc->will_fold_later = FALSE;
02296
02297 TRACE (Func_Exit, "anint_intrinsic", NULL);
02298
02299 }
02300
02301
02302
02303
02304
02305
02306
02307
02308
02309
02310
02311
02312
02313
02314
02315
02316
02317
02318
02319
02320
02321 void nint_intrinsic(opnd_type *result_opnd,
02322 expr_arg_type *res_exp_desc,
02323 int *spec_idx)
02324 {
02325 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
02326 int info_idx1;
02327 int info_idx2;
02328 int ir_idx;
02329 int list_idx1;
02330 int list_idx2;
02331 int type_idx;
02332
02333
02334 TRACE (Func_Entry, "nint_intrinsic", NULL);
02335
02336 ir_idx = OPND_IDX((*result_opnd));
02337 list_idx1 = IR_IDX_R(ir_idx);
02338 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
02339 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02340
02341 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
02342 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
02343 kind_to_linear_type(&((IL_OPND(list_idx2))),
02344 ATP_RSLT_IDX(*spec_idx),
02345 arg_info_list[info_idx2].ed.kind0seen,
02346 arg_info_list[info_idx2].ed.kind0E0seen,
02347 arg_info_list[info_idx2].ed.kind0D0seen,
02348 ! arg_info_list[info_idx2].ed.kindnotconst);
02349 }
02350 else {
02351 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
02352 }
02353
02354 if (ATP_INTRIN_ENUM(*spec_idx) == Inint_Intrinsic) {
02355 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_2;
02356 }
02357 else if (ATP_INTRIN_ENUM(*spec_idx) == Jnint_Intrinsic) {
02358 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_4;
02359 }
02360 else if (ATP_INTRIN_ENUM(*spec_idx) == Knint_Intrinsic) {
02361 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
02362 }
02363
02364 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02365
02366 conform_check(0,
02367 ir_idx,
02368 res_exp_desc,
02369 spec_idx,
02370 FALSE);
02371 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02372 IR_RANK(ir_idx) = res_exp_desc->rank;
02373
02374 # if 0
02375
02376 res_exp_desc->type_idx = type_idx;
02377 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
02378
02379 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
02380 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
02381 arg_info_list[info_idx1].ed.type_idx,
02382 NULL,
02383 NULL_IDX,
02384 folded_const,
02385 &type_idx,
02386 IR_LINE_NUM(ir_idx),
02387 IR_COL_NUM(ir_idx),
02388 1,
02389 Nint_Opr)) {
02390
02391 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
02392 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
02393 FALSE,
02394 folded_const);
02395 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
02396 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
02397 res_exp_desc->constant = TRUE;
02398 res_exp_desc->foldable = TRUE;
02399 }
02400 else {
02401 IR_OPR(ir_idx) = Nint_Opr;
02402 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02403 IR_OPND_R(ir_idx) = null_opnd;
02404 IR_LIST_CNT_L(ir_idx) = 1;
02405 IL_NEXT_LIST_IDX(IR_IDX_L(ir_idx)) = NULL_IDX;
02406 }
02407
02408 # endif
02409 res_exp_desc->foldable = FALSE;
02410 res_exp_desc->will_fold_later = FALSE;
02411
02412
02413 TRACE (Func_Exit, "nint_intrinsic", NULL);
02414
02415 }
02416
02417
02418
02419
02420
02421
02422
02423
02424
02425
02426
02427
02428
02429
02430
02431
02432
02433
02434
02435
02436
02437
02438
02439
02440 void sign_intrinsic(opnd_type *result_opnd,
02441 expr_arg_type *res_exp_desc,
02442 int *spec_idx)
02443 {
02444 int list_idx1;
02445 int list_idx2;
02446 int info_idx1;
02447 int info_idx2;
02448 int ir_idx;
02449 int type_idx;
02450 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
02451
02452
02453 TRACE (Func_Entry, "sign_intrinsic", NULL);
02454
02455 ir_idx = OPND_IDX((*result_opnd));
02456 list_idx1 = IR_IDX_R(ir_idx);
02457 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
02458 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02459 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
02460
02461 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
02462 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02463
02464 # if defined(GENERATE_WHIRL)
02465 if (arg_info_list[info_idx1].ed.linear_type == Real_16) {
02466 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
02467 }
02468 else {
02469 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
02470 }
02471 # endif
02472
02473 conform_check(0,
02474 ir_idx,
02475 res_exp_desc,
02476 spec_idx,
02477 FALSE);
02478
02479 IR_TYPE_IDX(ir_idx) = type_idx;
02480 IR_RANK(ir_idx) = res_exp_desc->rank;
02481
02482 res_exp_desc->type_idx = type_idx;
02483 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
02484
02485 if (arg_info_list[info_idx1].ed.linear_type !=
02486 arg_info_list[info_idx2].ed.linear_type) {
02487 PRINTMSG(IR_LINE_NUM(ir_idx), 774, Error,
02488 IR_COL_NUM(ir_idx));
02489 }
02490
02491 # if 0
02492
02493 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
02494 if (arg_info_list[info_idx1].ed.type == Integer &&
02495 IL_FLD(list_idx1) == CN_Tbl_Idx &&
02496 IL_FLD(list_idx2) == CN_Tbl_Idx &&
02497 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
02498 arg_info_list[info_idx1].ed.type_idx,
02499 (char *)&CN_CONST(IL_IDX(list_idx2)),
02500 arg_info_list[info_idx2].ed.type_idx,
02501 folded_const,
02502 &type_idx,
02503 IR_LINE_NUM(ir_idx),
02504 IR_COL_NUM(ir_idx),
02505 2,
02506 Sign_Opr)) {
02507
02508 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
02509 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
02510 FALSE,
02511 folded_const);
02512 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
02513 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
02514 res_exp_desc->constant = TRUE;
02515 res_exp_desc->foldable = TRUE;
02516 }
02517 else {
02518 IR_OPR(ir_idx) = Sign_Opr;
02519 # if defined(GENERATE_WHIRL)
02520 if (on_off_flags.recognize_minus_zero &&
02521 arg_info_list[info_idx1].ed.type == Real) {
02522 IR_OPR(ir_idx) = Ieee_Copy_Sign_Opr;
02523 }
02524 # endif
02525 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02526 IR_OPND_R(ir_idx) = null_opnd;
02527
02528 if (arg_info_list[info_idx1].ed.type != Integer) {
02529
02530
02531
02532 res_exp_desc->foldable = FALSE;
02533 res_exp_desc->will_fold_later = FALSE;
02534 }
02535 }
02536 }
02537 else {
02538
02539
02540
02541 res_exp_desc->foldable = FALSE;
02542 res_exp_desc->will_fold_later = FALSE;
02543 }
02544
02545 # endif
02546 res_exp_desc->foldable = FALSE;
02547 res_exp_desc->will_fold_later = FALSE;
02548
02549
02550 TRACE (Func_Exit, "sign_intrinsic", NULL);
02551
02552 }
02553
02554
02555
02556
02557
02558
02559
02560
02561
02562
02563
02564
02565
02566
02567
02568
02569
02570
02571 void modulo_intrinsic(opnd_type *result_opnd,
02572 expr_arg_type *res_exp_desc,
02573 int *spec_idx)
02574 {
02575 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
02576 int ir_idx;
02577 int info_idx1;
02578 int info_idx2;
02579 int list_idx1;
02580 int list_idx2;
02581 int type_idx;
02582
02583
02584 TRACE (Func_Entry, "modulo_intrinsic", NULL);
02585
02586 ir_idx = OPND_IDX((*result_opnd));
02587 list_idx1 = IR_IDX_R(ir_idx);
02588 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
02589 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02590 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
02591
02592 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
02593 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02594
02595 conform_check(0,
02596 ir_idx,
02597 res_exp_desc,
02598 spec_idx,
02599 FALSE);
02600
02601
02602 IR_TYPE_IDX(ir_idx) = type_idx;
02603 IR_RANK(ir_idx) = res_exp_desc->rank;
02604 res_exp_desc->type_idx = type_idx;
02605 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
02606
02607 if (arg_info_list[info_idx1].ed.linear_type !=
02608 arg_info_list[info_idx2].ed.linear_type) {
02609 PRINTMSG(IR_LINE_NUM(ir_idx), 774, Error,
02610 IR_COL_NUM(ir_idx));
02611 }
02612
02613 # if 0
02614
02615 if (arg_info_list[info_idx1].ed.type == Integer &&
02616 IL_FLD(list_idx1) == CN_Tbl_Idx &&
02617 IL_FLD(list_idx2) == CN_Tbl_Idx &&
02618 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
02619 arg_info_list[info_idx1].ed.type_idx,
02620 (char *)&CN_CONST(IL_IDX(list_idx2)),
02621 arg_info_list[info_idx2].ed.type_idx,
02622 folded_const,
02623 &type_idx,
02624 IR_LINE_NUM(ir_idx),
02625 IR_COL_NUM(ir_idx),
02626 2,
02627 Modulo_Opr)) {
02628 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
02629 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
02630 FALSE,
02631 folded_const);
02632 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
02633 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
02634 res_exp_desc->constant = TRUE;
02635 res_exp_desc->foldable = TRUE;
02636 }
02637 else {
02638 IR_OPR(ir_idx) = Modulo_Opr;
02639 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02640 IR_OPND_R(ir_idx) = null_opnd;
02641
02642 if (arg_info_list[info_idx1].ed.type != Integer) {
02643
02644
02645
02646 res_exp_desc->foldable = FALSE;
02647 res_exp_desc->will_fold_later = FALSE;
02648 }
02649 }
02650
02651 # endif
02652 res_exp_desc->foldable = FALSE;
02653 res_exp_desc->will_fold_later = FALSE;
02654
02655 TRACE (Func_Exit, "modulo_intrinsic", NULL);
02656
02657 }
02658
02659
02660
02661
02662
02663
02664
02665
02666
02667
02668
02669
02670
02671
02672
02673
02674
02675
02676
02677
02678
02679
02680
02681 void shift_intrinsic(opnd_type *result_opnd,
02682 expr_arg_type *res_exp_desc,
02683 int *spec_idx)
02684 {
02685 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
02686 int list_idx1;
02687 int list_idx2;
02688 long num;
02689 int info_idx1;
02690 int info_idx2;
02691 int ir_idx;
02692 operator_type opr;
02693 int type_idx;
02694 int cn_idx;
02695 int line;
02696 int column;
02697
02698
02699 TRACE (Func_Entry, "shift_intrinsic", NULL);
02700
02701 ir_idx = OPND_IDX((*result_opnd));
02702 list_idx1 = IR_IDX_R(ir_idx);
02703 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
02704 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
02705 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
02706
02707 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
02708 (arg_info_list[info_idx1].ed.linear_type == Short_Typeless_Const ||
02709 arg_info_list[info_idx1].ed.linear_type == Short_Char_Const)) {
02710
02711 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx1),
02712 &line,
02713 &column);
02714
02715 if (arg_info_list[info_idx1].ed.type == Character) {
02716 PRINTMSG(line, 161, Ansi, column);
02717 }
02718
02719 type_idx = INTEGER_DEFAULT_TYPE;
02720
02721 IL_IDX(list_idx1) = cast_typeless_constant(IL_IDX(list_idx1),
02722 type_idx,
02723 line,
02724 column);
02725
02726 arg_info_list[info_idx1].ed.type_idx = type_idx;
02727 arg_info_list[info_idx1].ed.type = TYP_TYPE(type_idx);
02728 arg_info_list[info_idx1].ed.linear_type = TYP_LINEAR(type_idx);
02729 }
02730
02731
02732 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
02733 # if defined(GENERATE_WHIRL)
02734 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
02735 if (arg_info_list[info_idx1].ed.type == Integer) {
02736 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
02737 arg_info_list[info_idx1].ed.linear_type;
02738 }
02739 # endif
02740
02741
02742 # ifdef _TARGET32
02743 if (arg_info_list[info_idx1].ed.linear_type == Integer_8 ||
02744 arg_info_list[info_idx1].ed.linear_type == Typeless_8 ||
02745 arg_info_list[info_idx1].ed.linear_type == Real_8) {
02746 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_8;
02747 # if defined(GENERATE_WHIRL)
02748 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
02749 # endif
02750 }
02751 # endif
02752
02753
02754 # ifdef _TARGET_OS_MAX
02755 if (arg_info_list[info_idx1].ed.linear_type == Integer_1 ||
02756 arg_info_list[info_idx1].ed.linear_type == Integer_2 ||
02757 arg_info_list[info_idx1].ed.linear_type == Integer_4 ||
02758 arg_info_list[info_idx1].ed.linear_type == Typeless_4 ||
02759 arg_info_list[info_idx1].ed.linear_type == Real_4) {
02760 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_4;
02761 }
02762 # endif
02763
02764 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02765
02766 switch (ATP_INTRIN_ENUM(*spec_idx)) {
02767 case Shift_Intrinsic:
02768 opr = Shift_Opr;
02769 break;
02770
02771 case Shifta_Intrinsic:
02772 opr = Shifta_Opr;
02773 break;
02774
02775 case Lshift_Intrinsic:
02776 case Shiftl_Intrinsic:
02777 opr = Shiftl_Opr;
02778 break;
02779
02780 case Rshift_Intrinsic:
02781 case Shiftr_Intrinsic:
02782 opr = Shiftr_Opr;
02783 break;
02784
02785 default:
02786 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal,
02787 IR_COL_NUM(ir_idx),
02788 "shift_intrinsic");
02789 break;
02790 }
02791
02792 conform_check(0,
02793 ir_idx,
02794 res_exp_desc,
02795 spec_idx,
02796 FALSE);
02797
02798 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
02799 case Integer_1:
02800 case Typeless_1:
02801 num = BITSIZE_INT1_F90;
02802 break;
02803
02804 case Integer_2:
02805 case Typeless_2:
02806 num = BITSIZE_INT2_F90;
02807 break;
02808
02809 case Integer_4:
02810 case Typeless_4:
02811 case Real_4:
02812 num = BITSIZE_INT4_F90;
02813 break;
02814
02815 case Integer_8:
02816 case Typeless_8:
02817 case Real_8:
02818 num = BITSIZE_INT8_F90;
02819 break;
02820
02821 default:
02822 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal,
02823 IR_COL_NUM(ir_idx),
02824 "shift_intrinsic");
02825 break;
02826 }
02827
02828 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
02829 if (compare_cn_and_value(IL_IDX(list_idx2), num, Gt_Opr) ||
02830 compare_cn_and_value(IL_IDX(list_idx2), 0, Lt_Opr)) {
02831 PRINTMSG(arg_info_list[info_idx2].line, 1062, Error,
02832 arg_info_list[info_idx2].col);
02833 }
02834 }
02835
02836
02837 IR_RANK(ir_idx) = res_exp_desc->rank;
02838 IR_TYPE_IDX(ir_idx) = type_idx;
02839
02840 # if 0
02841
02842 res_exp_desc->type_idx = type_idx;
02843 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
02844
02845 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
02846 IL_FLD(list_idx2) == CN_Tbl_Idx &&
02847 arg_info_list[info_idx1].ed.type != Real) {
02848
02849 if (opr == Shifta_Opr) {
02850 if (CN_INT_TO_C(IL_IDX(list_idx2)) == 8 &&
02851 (arg_info_list[info_idx1].ed.linear_type == Integer_1 ||
02852 (arg_info_list[info_idx1].ed.type == Typeless &&
02853 TYP_BIT_LEN(arg_info_list[info_idx1].ed.type_idx) == 8) ||
02854 arg_info_list[info_idx1].ed.linear_type == Typeless_1)) {
02855
02856 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, 7);
02857 IL_IDX(list_idx2) = cn_idx;
02858 }
02859
02860 else if (CN_INT_TO_C(IL_IDX(list_idx2)) == 16 &&
02861 (arg_info_list[info_idx1].ed.linear_type == Integer_2 ||
02862 (arg_info_list[info_idx1].ed.type == Typeless &&
02863 TYP_BIT_LEN(arg_info_list[info_idx1].ed.type_idx) == 16) ||
02864 arg_info_list[info_idx1].ed.linear_type == Typeless_2)) {
02865
02866 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, 15);
02867
02868 IL_IDX(list_idx2) = cn_idx;
02869 }
02870
02871 else if (CN_INT_TO_C(IL_IDX(list_idx2)) == 32 &&
02872 (arg_info_list[info_idx1].ed.linear_type == Integer_4 ||
02873 (arg_info_list[info_idx1].ed.type == Typeless &&
02874 TYP_BIT_LEN(arg_info_list[info_idx1].ed.type_idx) == 32) ||
02875 arg_info_list[info_idx1].ed.linear_type == Typeless_4)) {
02876
02877 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, 31);
02878
02879 IL_IDX(list_idx2) = cn_idx;
02880 }
02881
02882 else if (CN_INT_TO_C(IL_IDX(list_idx2)) == 64 &&
02883 (arg_info_list[info_idx1].ed.linear_type == Integer_8 ||
02884 (arg_info_list[info_idx1].ed.type == Typeless &&
02885 TYP_BIT_LEN(arg_info_list[info_idx1].ed.type_idx) == 64) ||
02886 arg_info_list[info_idx1].ed.linear_type == Typeless_8)) {
02887
02888 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, 63);
02889
02890 IL_IDX(list_idx2) = cn_idx;
02891 }
02892 }
02893
02894 if (folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
02895 arg_info_list[info_idx1].ed.type_idx,
02896 (char *)&CN_CONST(IL_IDX(list_idx2)),
02897 arg_info_list[info_idx2].ed.type_idx,
02898 folded_const,
02899 &type_idx,
02900 IR_LINE_NUM(ir_idx),
02901 IR_COL_NUM(ir_idx),
02902 2,
02903 opr)) {
02904
02905 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
02906 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
02907 FALSE,
02908 folded_const);
02909 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
02910 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
02911 res_exp_desc->constant = TRUE;
02912 res_exp_desc->foldable = TRUE;
02913 }
02914 }
02915 else {
02916 IR_OPR(ir_idx) = opr;
02917 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
02918 IR_OPND_R(ir_idx) = null_opnd;
02919
02920 if (arg_info_list[info_idx1].ed.type == Real) {
02921
02922
02923
02924 res_exp_desc->foldable = FALSE;
02925 res_exp_desc->will_fold_later = FALSE;
02926 }
02927 }
02928
02929 # endif
02930 res_exp_desc->foldable = FALSE;
02931 res_exp_desc->will_fold_later = FALSE;
02932
02933 TRACE (Func_Exit, "shift_intrinsic", NULL);
02934
02935 }
02936
02937
02938
02939
02940
02941
02942
02943
02944
02945
02946
02947
02948
02949
02950
02951
02952
02953
02954
02955
02956
02957 void num_images_intrinsic(opnd_type *result_opnd,
02958 expr_arg_type *res_exp_desc,
02959 int *spec_idx)
02960 {
02961 int line;
02962 int column;
02963 int ir_idx;
02964 int cn_idx;
02965 int plus_idx;
02966 int power_idx;
02967 int div_idx;
02968 int info_idx1;
02969 int int_idx;
02970 int mod_idx;
02971 int list_idx1;
02972 int list_idx2;
02973 opnd_type opnd;
02974 int opnd_line;
02975 int opnd_col;
02976 int l_log10_idx;
02977 int r_log10_idx;
02978 float point_five;
02979 float f_two;
02980 int sn_idx;
02981 int attr_idx;
02982 expr_arg_type loc_exp_desc;
02983
02984
02985 TRACE (Func_Entry, "num_images_intrinsic", NULL);
02986
02987 ir_idx = OPND_IDX((*result_opnd));
02988 line = IR_LINE_NUM(ir_idx);
02989 column = IR_COL_NUM(ir_idx);
02990
02991 if (ATP_INTRIN_ENUM(*spec_idx) != Sync_Images_Intrinsic) {
02992 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
02993 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
02994 }
02995 else {
02996 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
02997 }
02998
02999 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
03000
03001 conform_check(0,
03002 ir_idx,
03003 res_exp_desc,
03004 spec_idx,
03005 FALSE);
03006
03007 IR_RANK(ir_idx) = res_exp_desc->rank;
03008
03009
03010 if (ATP_INTRIN_ENUM(*spec_idx) == Rem_Images_Intrinsic) {
03011 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
03012 #if 0
03013 point_five = 0.5;
03014
03015
03016
03017
03018
03019
03020 cn_idx = ntr_const_tbl(REAL_DEFAULT_TYPE, FALSE,(long_type *)&point_five);
03021 OPND_FLD(opnd) = IR_Tbl_Idx;
03022 OPND_IDX(opnd) = ir_idx;
03023 copy_subtree(&opnd, &opnd);
03024 plus_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
03025 Plus_Opr, REAL_DEFAULT_TYPE, line, column,
03026 CN_Tbl_Idx, cn_idx);
03027
03028 f_two = 2.0;
03029 cn_idx = ntr_const_tbl(REAL_DEFAULT_TYPE, FALSE, (long_type *)&f_two);
03030
03031 r_log10_idx = gen_ir(CN_Tbl_Idx, cn_idx,
03032 Log_10_Opr, REAL_DEFAULT_TYPE, line, column,
03033 NO_Tbl_Idx, NULL_IDX);
03034
03035 l_log10_idx = gen_ir(IR_Tbl_Idx, plus_idx,
03036 Log_10_Opr, REAL_DEFAULT_TYPE, line, column,
03037 NO_Tbl_Idx, NULL_IDX);
03038
03039
03040 div_idx = gen_ir(IR_Tbl_Idx, l_log10_idx,
03041 Div_Opr, REAL_DEFAULT_TYPE, line, column,
03042 IR_Tbl_Idx, r_log10_idx);
03043
03044 int_idx = gen_ir(IR_Tbl_Idx, div_idx,
03045 Int_Opr, INTEGER_DEFAULT_TYPE, line, column,
03046 NO_Tbl_Idx, NULL_IDX);
03047
03048 cn_idx = CN_INTEGER_TWO_IDX;
03049
03050 power_idx = gen_ir(CN_Tbl_Idx, cn_idx,
03051 Power_Opr, INTEGER_DEFAULT_TYPE, line, column,
03052 IR_Tbl_Idx, int_idx);
03053
03054 OPND_FLD(opnd) = IR_Tbl_Idx;
03055 OPND_IDX(opnd) = ir_idx;
03056 copy_subtree(&opnd, &opnd);
03057 mod_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
03058 Mod_Opr, INTEGER_DEFAULT_TYPE, line, column,
03059 IR_Tbl_Idx, power_idx);
03060
03061 IR_IDX_L(ir_idx) = mod_idx;
03062 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
03063 IR_OPND_R(ir_idx) = null_opnd;
03064 IR_OPR(ir_idx) = Int_Opr;
03065 #endif
03066
03067 }
03068 else if (ATP_INTRIN_ENUM(*spec_idx) == Log2_Images_Intrinsic) {
03069 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
03070 #if 0
03071 point_five = 0.5;
03072 cn_idx = ntr_const_tbl(REAL_DEFAULT_TYPE, FALSE,(long_type *)&point_five);
03073
03074 OPND_FLD(opnd) = IR_Tbl_Idx;
03075 OPND_IDX(opnd) = ir_idx;
03076 copy_subtree(&opnd, &opnd);
03077 plus_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
03078 Plus_Opr, REAL_DEFAULT_TYPE, line, column,
03079 CN_Tbl_Idx, cn_idx);
03080
03081 f_two = 2.0;
03082 cn_idx = ntr_const_tbl(REAL_DEFAULT_TYPE, FALSE, (long_type *)&f_two);
03083
03084 r_log10_idx = gen_ir(CN_Tbl_Idx, cn_idx,
03085 Log_10_Opr, REAL_DEFAULT_TYPE, line, column,
03086 NO_Tbl_Idx, NULL_IDX);
03087
03088 l_log10_idx = gen_ir(IR_Tbl_Idx, plus_idx,
03089 Log_10_Opr, REAL_DEFAULT_TYPE, line, column,
03090 NO_Tbl_Idx, NULL_IDX);
03091
03092 div_idx = gen_ir(IR_Tbl_Idx, l_log10_idx,
03093 Div_Opr, REAL_DEFAULT_TYPE, line, column,
03094 IR_Tbl_Idx, r_log10_idx);
03095
03096 IR_IDX_L(ir_idx) = div_idx;
03097 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
03098 IR_OPND_R(ir_idx) = null_opnd;
03099 IR_OPR(ir_idx) = Int_Opr;
03100 #endif
03101 }
03102 else if (ATP_INTRIN_ENUM(*spec_idx) == This_Image_Intrinsic) {
03103
03104 if (IR_LIST_CNT_R(ir_idx) > 0) {
03105
03106 list_idx1 = IR_IDX_R(ir_idx);
03107 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
03108
03109 if (IR_LIST_CNT_R(ir_idx) == 2) {
03110 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
03111 }
03112
03113 if (arg_info_list[info_idx1].ed.reference) {
03114 attr_idx = find_base_attr(&IL_OPND(list_idx1),
03115 &opnd_line, &opnd_col);
03116
03117 if (AT_DCL_ERR(attr_idx)) {
03118 goto EXIT;
03119 }
03120
03121 if (AT_OBJ_CLASS(attr_idx) == Data_Obj &&
03122 ATD_PE_ARRAY_IDX(attr_idx) != NULL_IDX &&
03123 IR_LIST_CNT_R(ir_idx) == 1 &&
03124 BD_RANK(ATD_PE_ARRAY_IDX(attr_idx)) == 1) {
03125
03126
03127
03128 sn_idx = ATI_FIRST_SPECIFIC_IDX(ATP_INTERFACE_IDX(*spec_idx));
03129
03130 while (sn_idx) {
03131 if (ATP_NUM_DARGS(SN_ATTR_IDX(sn_idx)) == 2) {
03132 break;
03133 }
03134 sn_idx = SN_SIBLING_LINK(sn_idx);
03135 }
03136
03137 if (sn_idx != NULL_IDX) {
03138 IR_IDX_L(ir_idx) = SN_ATTR_IDX(sn_idx);
03139 *spec_idx = SN_ATTR_IDX(sn_idx);
03140 ATP_EXTERNAL_INTRIN((*spec_idx)) = TRUE;
03141 ATD_TYPE_IDX(ATP_RSLT_IDX((*spec_idx))) =
03142 INTEGER_DEFAULT_TYPE;
03143
03144 NTR_IR_LIST_TBL(list_idx2);
03145 IL_NEXT_LIST_IDX(list_idx1) = list_idx2;
03146 IL_ARG_DESC_VARIANT(list_idx2) = TRUE;
03147 IR_LIST_CNT_R(ir_idx) += 1;
03148
03149 IL_FLD(list_idx2) = CN_Tbl_Idx;
03150 IL_IDX(list_idx2) = CN_INTEGER_ONE_IDX;
03151 IL_LINE_NUM(list_idx2) = line;
03152 IL_COL_NUM(list_idx2) = column;
03153
03154 arg_info_list_base = arg_info_list_top;
03155 arg_info_list_top = arg_info_list_base + 1;
03156
03157 if (arg_info_list_top >= arg_info_list_size) {
03158 enlarge_info_list_table();
03159 }
03160
03161 IL_ARG_DESC_IDX(list_idx2) = arg_info_list_top;
03162 arg_info_list[arg_info_list_top] = init_arg_info;
03163 arg_info_list[arg_info_list_top].ed.constant = TRUE;
03164 arg_info_list[arg_info_list_top].ed.foldable = TRUE;
03165 arg_info_list[arg_info_list_top].ed.type = Integer;
03166 arg_info_list[arg_info_list_top].ed.type_idx =
03167 CG_INTEGER_DEFAULT_TYPE;
03168 arg_info_list[arg_info_list_top].ed.linear_type =
03169 CG_INTEGER_DEFAULT_TYPE;
03170 arg_info_list[arg_info_list_top].line = line;
03171 arg_info_list[arg_info_list_top].col = column;
03172 }
03173 }
03174 }
03175
03176 if (! arg_info_list[info_idx1].ed.reference) {
03177
03178 find_opnd_line_and_column(&IL_OPND(list_idx1),
03179 &opnd_line, &opnd_col);
03180 PRINTMSG(opnd_line, 1575, Error, opnd_col);
03181 }
03182 else {
03183 attr_idx = find_base_attr(&IL_OPND(list_idx1),
03184 &opnd_line, &opnd_col);
03185
03186 if (AT_OBJ_CLASS(attr_idx) != Data_Obj ||
03187 ATD_PE_ARRAY_IDX(attr_idx) == NULL_IDX) {
03188
03189 PRINTMSG(opnd_line, 1575, Error, opnd_col);
03190 }
03191 else {
03192
03193 if (ATD_ALLOCATABLE(attr_idx)) {
03194 attr_idx = ATD_VARIABLE_TMP_IDX(attr_idx);
03195 }
03196 #if 0
03197 COPY_OPND(opnd, IL_OPND(list_idx1));
03198 generate_bounds_list(ATD_PE_ARRAY_IDX(attr_idx),
03199 &opnd,
03200 &loc_exp_desc);
03201 COPY_OPND(IL_OPND(list_idx1), opnd);
03202 #endif
03203 arg_info_list[info_idx1].ed = loc_exp_desc;
03204
03205 }
03206 }
03207 }
03208 }
03209
03210
03211 EXIT:
03212
03213
03214
03215
03216
03217 res_exp_desc->foldable = FALSE;
03218 res_exp_desc->will_fold_later = FALSE;
03219
03220 TRACE (Func_Exit, "num_images_intrinsic", NULL);
03221
03222 }
03223
03224
03225
03226
03227
03228
03229
03230
03231
03232
03233
03234
03235
03236
03237
03238
03239
03240
03241
03242
03243 void leadz_intrinsic(opnd_type *result_opnd,
03244 expr_arg_type *res_exp_desc,
03245 int *spec_idx)
03246 {
03247 int ir_idx;
03248 int list_idx1;
03249 int info_idx1;
03250
03251
03252 TRACE (Func_Entry, "leadz_intrinsic", NULL);
03253
03254 ir_idx = OPND_IDX((*result_opnd));
03255 list_idx1 = IR_IDX_R(ir_idx);
03256 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
03257
03258 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
03259
03260 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] > 64) {
03261 PRINTMSG(arg_info_list[info_idx1].line, 774, Error,
03262 arg_info_list[info_idx1].col);
03263 }
03264
03265 conform_check(0,
03266 ir_idx,
03267 res_exp_desc,
03268 spec_idx,
03269 FALSE);
03270
03271 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03272 IR_RANK(ir_idx) = res_exp_desc->rank;
03273
03274 # if 0
03275
03276 if (ATP_INTRIN_ENUM(*spec_idx) == Popcnt_Intrinsic) {
03277 IR_OPR(ir_idx) = Popcnt_Opr;
03278 }
03279 else if (ATP_INTRIN_ENUM(*spec_idx) == Poppar_Intrinsic) {
03280 IR_OPR(ir_idx) = Poppar_Opr;
03281 }
03282 else {
03283 IR_OPR(ir_idx) = Leadz_Opr;
03284 }
03285
03286 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
03287 IR_OPND_R(ir_idx) = null_opnd;
03288
03289
03290
03291
03292 # endif
03293
03294 res_exp_desc->foldable = FALSE;
03295 res_exp_desc->will_fold_later = FALSE;
03296
03297 TRACE (Func_Exit, "leadz_intrinsic", NULL);
03298
03299 }
03300
03301
03302
03303
03304
03305
03306
03307
03308
03309
03310
03311
03312
03313
03314
03315
03316
03317
03318
03319
03320
03321
03322 void not_intrinsic(opnd_type *result_opnd,
03323 expr_arg_type *res_exp_desc,
03324 int *spec_idx)
03325 {
03326 opnd_type opnd;
03327 int info_idx1;
03328 int ir_idx;
03329 int list_idx1;
03330 long num;
03331 operator_type opr;
03332 int first_idx;
03333 int cn_idx;
03334 int cn_idx2;
03335 int typeless_idx;
03336 int second_idx;
03337 int minus_idx;
03338 int type_idx;
03339 int not_idx;
03340 int shiftl_idx;
03341 int shiftr_idx;
03342 int line;
03343 int column;
03344
03345
03346 TRACE (Func_Entry, "not_intrinsic", NULL);
03347
03348 ir_idx = OPND_IDX((*result_opnd));
03349 list_idx1 = IR_IDX_R(ir_idx);
03350 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
03351
03352 if (arg_info_list[info_idx1].ed.type == Logical) {
03353 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
03354 opr = Not_Opr;
03355 }
03356 else {
03357 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
03358 (arg_info_list[info_idx1].ed.linear_type ==
03359 Short_Typeless_Const ||
03360 arg_info_list[info_idx1].ed.linear_type ==
03361 Short_Char_Const)) {
03362
03363 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx1),
03364 &line,
03365 &column);
03366
03367 if (arg_info_list[info_idx1].ed.type == Character) {
03368 PRINTMSG(line, 161, Ansi, column);
03369 }
03370
03371 type_idx = INTEGER_DEFAULT_TYPE;
03372
03373 IL_IDX(list_idx1) = cast_typeless_constant(IL_IDX(list_idx1),
03374 type_idx,
03375 line,
03376 column);
03377
03378 arg_info_list[info_idx1].ed.type_idx = type_idx;
03379 arg_info_list[info_idx1].ed.type = TYP_TYPE(type_idx);
03380 arg_info_list[info_idx1].ed.linear_type = TYP_LINEAR(type_idx);
03381 }
03382
03383 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
03384 arg_info_list[info_idx1].ed.type_idx;
03385
03386 if (ATP_INTRIN_ENUM(*spec_idx) == Compl_Intrinsic) {
03387 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
03388 # if defined(GENERATE_WHIRL)
03389 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
03390 if (arg_info_list[info_idx1].ed.type == Integer) {
03391 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
03392 arg_info_list[info_idx1].ed.linear_type;
03393 }
03394 # endif
03395
03396
03397 # ifdef _TARGET32
03398 if ((arg_info_list[info_idx1].ed.linear_type == Integer_8) ||
03399 (arg_info_list[info_idx1].ed.linear_type == Typeless_8) ||
03400 (arg_info_list[info_idx1].ed.linear_type == Real_8)) {
03401 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_8;
03402 # if defined(GENERATE_WHIRL)
03403 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
03404 # endif
03405 }
03406 # endif
03407
03408 # ifdef _TARGET_OS_MAX
03409 if (arg_info_list[info_idx1].ed.linear_type == Integer_1 ||
03410 arg_info_list[info_idx1].ed.linear_type == Integer_2 ||
03411 arg_info_list[info_idx1].ed.linear_type == Integer_4 ||
03412 arg_info_list[info_idx1].ed.linear_type == Typeless_4 ||
03413 arg_info_list[info_idx1].ed.linear_type == Real_4) {
03414 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_4;
03415 }
03416 # endif
03417 }
03418 opr = Bnot_Opr;
03419 }
03420
03421 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_8 ||
03422 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Typeless_8) {
03423 typeless_idx = Typeless_8;
03424 }
03425 else {
03426 typeless_idx = TYPELESS_DEFAULT_TYPE;
03427 }
03428
03429 # ifdef _TARGET_OS_MAX
03430 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_1 ||
03431 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_2 ||
03432 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Typeless_4 ||
03433 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_4) {
03434 typeless_idx = Typeless_4;
03435 }
03436 # endif
03437
03438 conform_check(0,
03439 ir_idx,
03440 res_exp_desc,
03441 spec_idx,
03442 FALSE);
03443
03444 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03445 IR_RANK(ir_idx) = res_exp_desc->rank;
03446
03447 # if 0
03448
03449 res_exp_desc->type_idx = IR_TYPE_IDX(ir_idx);
03450 res_exp_desc->linear_type = TYP_LINEAR(IR_TYPE_IDX(ir_idx));
03451
03452 if (opr == Not_Opr) {
03453 IR_OPR(ir_idx) = opr;
03454 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
03455 IR_OPND_R(ir_idx) = null_opnd;
03456 }
03457 else {
03458
03459 line = IR_LINE_NUM(ir_idx);
03460 column = IR_COL_NUM(ir_idx);
03461
03462 not_idx = gen_ir(IL_FLD(list_idx1), IL_IDX(list_idx1),
03463 opr, typeless_idx, line, column,
03464 NO_Tbl_Idx, NULL_IDX);
03465 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
03466 ATP_RSLT_IDX(*spec_idx)))];
03467
03468 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
03469
03470 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
03471 case Integer_1:
03472 num = BITSIZE_INT1_F90;
03473 break;
03474
03475 case Integer_2:
03476 num = BITSIZE_INT2_F90;
03477 break;
03478
03479 case Integer_4:
03480 case Typeless_4:
03481 num = BITSIZE_INT4_F90;
03482 break;
03483
03484 case Integer_8:
03485 case Typeless_8:
03486 num = BITSIZE_INT8_F90;
03487 break;
03488 }
03489
03490 cn_idx2 = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
03491
03492 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
03493 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, line, column,
03494 CN_Tbl_Idx, cn_idx2);
03495
03496 NTR_IR_LIST_TBL(first_idx);
03497 IL_FLD(first_idx) = IR_Tbl_Idx;
03498 IL_IDX(first_idx) = not_idx;
03499 NTR_IR_LIST_TBL(second_idx);
03500 IL_FLD(second_idx) = IR_Tbl_Idx;
03501 IL_IDX(second_idx) = minus_idx;
03502 IL_NEXT_LIST_IDX(first_idx) = second_idx;
03503
03504 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
03505 Shiftl_Opr, typeless_idx, line, column,
03506 NO_Tbl_Idx, NULL_IDX);
03507
03508 NTR_IR_LIST_TBL(first_idx);
03509 IL_FLD(first_idx) = IR_Tbl_Idx;
03510 IL_IDX(first_idx) = shiftl_idx;
03511 NTR_IR_LIST_TBL(second_idx);
03512 IL_FLD(second_idx) = IR_Tbl_Idx;
03513 IL_IDX(second_idx) = minus_idx;
03514 IL_NEXT_LIST_IDX(first_idx) = second_idx;
03515
03516 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
03517 Shiftr_Opr, typeless_idx, line, column,
03518 NO_Tbl_Idx, NULL_IDX);
03519
03520 if (TYP_TYPE(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer) {
03521 IR_OPR(shiftr_idx) = Shifta_Opr;
03522 }
03523
03524 IR_OPR(ir_idx) = Cvrt_Opr;
03525 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03526 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
03527 IR_IDX_L(ir_idx) = shiftr_idx;
03528 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
03529 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
03530 IR_OPND_R(ir_idx) = null_opnd;
03531
03532 if (IL_FLD(list_idx1) == CN_Tbl_Idx) {
03533 COPY_OPND(opnd, (*result_opnd));
03534 fold_aggragate_expression(&opnd, res_exp_desc, FALSE);
03535 COPY_OPND((*result_opnd), opnd);
03536 }
03537 }
03538
03539 # endif
03540 res_exp_desc->foldable = FALSE;
03541 res_exp_desc->will_fold_later = FALSE;
03542
03543 TRACE (Func_Exit, "not_intrinsic", NULL);
03544
03545 }
03546
03547
03548
03549
03550
03551
03552
03553
03554
03555
03556
03557
03558
03559
03560
03561
03562
03563
03564 void aint_intrinsic(opnd_type *result_opnd,
03565 expr_arg_type *res_exp_desc,
03566 int *spec_idx)
03567 {
03568 int info_idx1;
03569 int info_idx2;
03570 int list_idx1;
03571 int list_idx2;
03572 int ir_idx;
03573
03574
03575 TRACE (Func_Entry, "aint_intrinsic", NULL);
03576
03577 ir_idx = OPND_IDX((*result_opnd));
03578 list_idx1 = IR_IDX_R(ir_idx);
03579 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
03580 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
03581
03582 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
03583 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
03584 kind_to_linear_type(&((IL_OPND(list_idx2))),
03585 ATP_RSLT_IDX(*spec_idx),
03586 arg_info_list[info_idx2].ed.kind0seen,
03587 arg_info_list[info_idx2].ed.kind0E0seen,
03588 arg_info_list[info_idx2].ed.kind0D0seen,
03589 ! arg_info_list[info_idx2].ed.kindnotconst);
03590 }
03591 else {
03592 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
03593 arg_info_list[info_idx1].ed.type_idx;
03594 }
03595
03596 conform_check(0,
03597 ir_idx,
03598 res_exp_desc,
03599 spec_idx,
03600 FALSE);
03601
03602 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03603 IR_RANK(ir_idx) = res_exp_desc->rank;
03604
03605 # if 0
03606
03607 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03608 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
03609
03610 IR_OPR(ir_idx) = Aint_Opr;
03611 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
03612 IR_OPND_R(ir_idx) = null_opnd;
03613 IR_LIST_CNT_L(ir_idx) = 1;
03614 IL_NEXT_LIST_IDX(IR_IDX_L(ir_idx)) = NULL_IDX;
03615
03616
03617
03618
03619 res_exp_desc->foldable = FALSE;
03620 res_exp_desc->will_fold_later = FALSE;
03621
03622 # endif
03623 res_exp_desc->foldable = FALSE;
03624 res_exp_desc->will_fold_later = FALSE;
03625
03626 TRACE (Func_Exit, "aint_intrinsic", NULL);
03627
03628 }
03629
03630
03631
03632
03633
03634
03635
03636
03637
03638
03639
03640
03641
03642
03643
03644
03645
03646
03647
03648 void ilen_intrinsic(opnd_type *result_opnd,
03649 expr_arg_type *res_exp_desc,
03650 int *spec_idx)
03651 {
03652 int info_idx1;
03653 int ir_idx;
03654 int list_idx1;
03655
03656
03657 TRACE (Func_Entry, "ilen_intrinsic", NULL);
03658
03659 ir_idx = OPND_IDX((*result_opnd));
03660 list_idx1 = IR_IDX_R(ir_idx);
03661 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
03662 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
03663
03664 conform_check(0,
03665 ir_idx,
03666 res_exp_desc,
03667 spec_idx,
03668 FALSE);
03669
03670 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03671 IR_RANK(ir_idx) = res_exp_desc->rank;
03672
03673 # if 0
03674
03675 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03676 res_exp_desc->linear_type =
03677 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
03678
03679 res_exp_desc->foldable = FALSE;
03680 res_exp_desc->will_fold_later = FALSE;
03681
03682
03683 io_item_must_flatten = TRUE;
03684
03685 # endif
03686 res_exp_desc->foldable = FALSE;
03687 res_exp_desc->will_fold_later = FALSE;
03688
03689 TRACE (Func_Exit, "ilen_intrinsic", NULL);
03690
03691 }
03692
03693
03694
03695
03696
03697
03698
03699
03700
03701
03702
03703
03704
03705
03706
03707
03708
03709
03710
03711
03712 void dim_intrinsic(opnd_type *result_opnd,
03713 expr_arg_type *res_exp_desc,
03714 int *spec_idx)
03715 {
03716 int info_idx1;
03717 int info_idx2;
03718 int arg1;
03719 int arg2;
03720 int arg3;
03721 int ir_idx;
03722 int gt_idx;
03723 int type_idx;
03724 int zero_idx;
03725 int minus_idx;
03726 int select_idx;
03727 int list_idx1;
03728 int list_idx2;
03729 int line;
03730 int column;
03731 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
03732
03733
03734 TRACE (Func_Entry, "dim_intrinsic", NULL);
03735
03736 ir_idx = OPND_IDX((*result_opnd));
03737 list_idx1 = IR_IDX_R(ir_idx);
03738 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
03739 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
03740 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
03741 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
03742 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03743
03744 conform_check(0,
03745 ir_idx,
03746 res_exp_desc,
03747 spec_idx,
03748 FALSE);
03749
03750 IR_TYPE_IDX(ir_idx) = type_idx;
03751 IR_RANK(ir_idx) = res_exp_desc->rank;
03752 res_exp_desc->type_idx = type_idx;
03753 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
03754
03755 if (arg_info_list[info_idx1].ed.linear_type !=
03756 arg_info_list[info_idx2].ed.linear_type) {
03757 PRINTMSG(IR_LINE_NUM(ir_idx), 774, Error,
03758 IR_COL_NUM(ir_idx));
03759 }
03760
03761 # if 0
03762
03763 if (arg_info_list[info_idx1].ed.type == Integer &&
03764 IL_FLD(list_idx1) == CN_Tbl_Idx &&
03765 IL_FLD(list_idx2) == CN_Tbl_Idx &&
03766 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
03767 arg_info_list[info_idx1].ed.type_idx,
03768 (char *)&CN_CONST(IL_IDX(list_idx2)),
03769 arg_info_list[info_idx2].ed.type_idx,
03770 folded_const,
03771 &type_idx,
03772 IR_LINE_NUM(ir_idx),
03773 IR_COL_NUM(ir_idx),
03774 2,
03775 Dim_Opr)) {
03776 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
03777 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
03778 FALSE,
03779 folded_const);
03780 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
03781 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
03782 res_exp_desc->constant = TRUE;
03783 res_exp_desc->foldable = TRUE;
03784 }
03785 else {
03786 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
03787 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx1),
03788 &line,
03789 &column);
03790
03791 gt_idx = gen_ir(IL_FLD(list_idx1), IL_IDX(list_idx1),
03792 Gt_Opr, LOGICAL_DEFAULT_TYPE, line, column,
03793 IL_FLD(list_idx2), IL_IDX(list_idx2));
03794
03795 minus_idx = gen_ir(IL_FLD(list_idx1), IL_IDX(list_idx1),
03796 Minus_Opr, arg_info_list[info_idx1].ed.type_idx,
03797 line, column,
03798 IL_FLD(list_idx2), IL_IDX(list_idx2));
03799
03800 zero_idx = (TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx) ==
03801 CG_INTEGER_DEFAULT_TYPE) ? CN_INTEGER_ZERO_IDX :
03802 C_INT_TO_CN(arg_info_list[info_idx1].ed.type_idx, 0);
03803
03804 NTR_IR_LIST_TBL(arg1);
03805 IL_ARG_DESC_VARIANT(arg1) = TRUE;
03806 NTR_IR_LIST_TBL(arg2);
03807 IL_ARG_DESC_VARIANT(arg2) = TRUE;
03808 NTR_IR_LIST_TBL(arg3);
03809 IL_ARG_DESC_VARIANT(arg3) = TRUE;
03810
03811
03812 IL_NEXT_LIST_IDX(arg1) = arg2;
03813 IL_NEXT_LIST_IDX(arg2) = arg3;
03814
03815 IL_IDX(arg1) = minus_idx;
03816 IL_FLD(arg1) = IR_Tbl_Idx;
03817 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
03818 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
03819 IL_IDX(arg2) = zero_idx;
03820 IL_FLD(arg2) = CN_Tbl_Idx;
03821 IL_LINE_NUM(arg2) = IR_LINE_NUM(ir_idx);
03822 IL_COL_NUM(arg2) = IR_COL_NUM(ir_idx);
03823 IL_IDX(arg3) = gt_idx;
03824 IL_FLD(arg3) = IR_Tbl_Idx;
03825 IL_LINE_NUM(arg3) = IR_LINE_NUM(ir_idx);
03826 IL_COL_NUM(arg3) = IR_COL_NUM(ir_idx);
03827
03828 select_idx = gen_ir(IL_Tbl_Idx, arg1,
03829 Cvmgt_Opr,
03830 arg_info_list[info_idx1].ed.type_idx,
03831 IR_LINE_NUM(ir_idx),
03832 IR_COL_NUM(ir_idx),
03833 NO_Tbl_Idx, NULL_IDX);
03834
03835
03836 io_item_must_flatten = TRUE;
03837
03838 IR_LIST_CNT_L(select_idx) = 3;
03839
03840 IR_OPR(ir_idx) = Cvrt_Opr;
03841 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
03842 IR_IDX_L(ir_idx) = select_idx;
03843 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
03844 IR_OPND_R(ir_idx) = null_opnd;
03845 }
03846
03847 if (arg_info_list[info_idx1].ed.type != Integer) {
03848
03849
03850
03851 res_exp_desc->foldable = FALSE;
03852 res_exp_desc->will_fold_later = FALSE;
03853 }
03854 }
03855
03856 # endif
03857 res_exp_desc->foldable = FALSE;
03858 res_exp_desc->will_fold_later = FALSE;
03859
03860 TRACE (Func_Exit, "dim_intrinsic", NULL);
03861
03862 }
03863
03864
03865
03866
03867
03868
03869
03870
03871
03872
03873
03874
03875
03876
03877
03878
03879
03880
03881
03882 void max_intrinsic(opnd_type *result_opnd,
03883 expr_arg_type *res_exp_desc,
03884 int *spec_idx)
03885 {
03886 int col = 0;
03887 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
03888 boolean fold_it;
03889 boolean casting_needed= FALSE;
03890 int info_idx1;
03891 int largest_linear_type;
03892 int ir_idx;
03893 int line = 0;
03894 int n_idx;
03895 operator_type opr;
03896 opnd_type opnd;
03897 int t_idx;
03898 int tmp_idx;
03899 int type_idx;
03900
03901
03902 TRACE (Func_Entry, "max_intrinsic", NULL);
03903
03904 ir_idx = OPND_IDX((*result_opnd));
03905 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
03906
03907 conform_check(3,
03908 ir_idx,
03909 res_exp_desc,
03910 spec_idx,
03911 FALSE);
03912
03913
03914 t_idx = IR_IDX_R(ir_idx);
03915 n_idx = IL_NEXT_LIST_IDX(t_idx);
03916
03917 largest_linear_type = arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed.linear_type;
03918
03919 fold_it = (IL_FLD(t_idx) == CN_Tbl_Idx);
03920
03921 while ((n_idx != NULL_IDX) && (IL_IDX(n_idx) != NULL_IDX)) {
03922 if (arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed.type !=
03923 arg_info_list[IL_ARG_DESC_IDX(n_idx)].ed.type) {
03924 PRINTMSG(IR_LINE_NUM(ir_idx), 774, Error,
03925 IR_COL_NUM(ir_idx));
03926 fold_it = FALSE;
03927 break;
03928 }
03929
03930 if ((opt_flags.set_fastint_option ||
03931 opt_flags.set_allfastint_option) &&
03932 (arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed.type == Integer)) {
03933 if (opt_flags.set_allfastint_option ||
03934 (TYP_DESC(arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed.type_idx) ==
03935 Default_Typed)) {
03936 casting_needed = TRUE;
03937 }
03938
03939 if (opt_flags.set_allfastint_option ||
03940 (TYP_DESC(arg_info_list[IL_ARG_DESC_IDX(n_idx)].ed.type_idx) ==
03941 Default_Typed)) {
03942 casting_needed = TRUE;
03943 }
03944 }
03945
03946 if (arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed.linear_type !=
03947 arg_info_list[IL_ARG_DESC_IDX(n_idx)].ed.linear_type) {
03948 PRINTMSG(arg_info_list[IL_ARG_DESC_IDX(n_idx)].line, 1323, Ansi,
03949 arg_info_list[IL_ARG_DESC_IDX(n_idx)].col);
03950
03951 casting_needed = TRUE;
03952 if (largest_linear_type <
03953 arg_info_list[IL_ARG_DESC_IDX(n_idx)].ed.linear_type) {
03954 largest_linear_type =
03955 arg_info_list[IL_ARG_DESC_IDX(n_idx)].ed.linear_type;
03956 }
03957 }
03958
03959 fold_it = fold_it && (IL_FLD(n_idx) == CN_Tbl_Idx);
03960
03961 t_idx = n_idx;
03962 n_idx = IL_NEXT_LIST_IDX(n_idx);
03963 }
03964
03965
03966 if (casting_needed) {
03967 t_idx = IR_IDX_R(ir_idx);
03968
03969 while ((t_idx != NULL_IDX) && (IL_IDX(t_idx) != NULL_IDX)) {
03970 COPY_OPND(opnd, IL_OPND(t_idx));
03971 cast_to_type_idx(&opnd,
03972 &arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed,
03973 largest_linear_type);
03974 COPY_OPND(IL_OPND(t_idx), opnd);
03975
03976 t_idx = IL_NEXT_LIST_IDX(t_idx);
03977 }
03978 }
03979
03980 if ((ATP_INTRIN_ENUM(*spec_idx) == Amax0_Intrinsic) ||
03981 (ATP_INTRIN_ENUM(*spec_idx) == Amin0_Intrinsic)) {
03982 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = REAL_DEFAULT_TYPE;
03983 }
03984 else if ((ATP_INTRIN_ENUM(*spec_idx) == Max1_Intrinsic) ||
03985 (ATP_INTRIN_ENUM(*spec_idx) == Min1_Intrinsic)) {
03986 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
03987 }
03988 else {
03989 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = largest_linear_type;
03990 }
03991
03992 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03993 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
03994 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
03995 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
03996 IR_RANK(ir_idx) = res_exp_desc->rank;
03997 type_idx = res_exp_desc->type_idx;
03998
03999 if (ATP_INTRIN_ENUM(*spec_idx) == Max_Intrinsic ||
04000 ATP_INTRIN_ENUM(*spec_idx) == Amax0_Intrinsic ||
04001 ATP_INTRIN_ENUM(*spec_idx) == Amax1_Intrinsic ||
04002 ATP_INTRIN_ENUM(*spec_idx) == Dmax1_Intrinsic ||
04003 ATP_INTRIN_ENUM(*spec_idx) == Max0_Intrinsic ||
04004 ATP_INTRIN_ENUM(*spec_idx) == Max1_Intrinsic) {
04005 IR_OPR(ir_idx) = Lt_Opr;
04006 opr = Max_Opr;
04007 }
04008 else {
04009 IR_OPR(ir_idx) = Gt_Opr;
04010 opr = Min_Opr;
04011 }
04012
04013
04014 if (fold_it &&
04015 res_exp_desc->type == Integer &&
04016 arg_info_list[info_idx1].ed.type == Integer) {
04017 t_idx = IR_IDX_R(ir_idx);
04018 n_idx = IL_NEXT_LIST_IDX(t_idx);
04019
04020 while ((n_idx != NULL_IDX) && (IL_IDX(n_idx) != NULL_IDX)) {
04021 fold_it = folder_driver((char *)&CN_CONST(IL_IDX(t_idx)),
04022 arg_info_list[IL_ARG_DESC_IDX(t_idx)].ed.type_idx,
04023 (char *)&CN_CONST(IL_IDX(n_idx)),
04024 arg_info_list[IL_ARG_DESC_IDX(n_idx)].ed.type_idx,
04025 folded_const,
04026 &type_idx,
04027 line,
04028 col,
04029 2,
04030 IR_OPR(ir_idx));
04031
04032 if (THIS_IS_TRUE(folded_const, type_idx)) {
04033 t_idx = n_idx;
04034 }
04035
04036
04037 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
04038 OPND_IDX((*result_opnd)) = ntr_const_tbl(res_exp_desc->type_idx,
04039 FALSE,
04040 &CN_CONST(IL_IDX(t_idx)));
04041 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
04042 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
04043 res_exp_desc->constant = TRUE;
04044 res_exp_desc->foldable = TRUE;
04045
04046 n_idx = IL_NEXT_LIST_IDX(n_idx);
04047 }
04048 }
04049 else {
04050 tmp_idx = gen_ir(IR_FLD_R(ir_idx), IR_IDX_R(ir_idx),
04051 opr, IR_TYPE_IDX(ir_idx), IR_LINE_NUM(ir_idx),
04052 IR_COL_NUM(ir_idx),
04053 NO_Tbl_Idx, NULL_IDX);
04054
04055 IR_OPR(ir_idx) = Cvrt_Opr;
04056 IR_IDX_L(ir_idx) = tmp_idx;
04057 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
04058 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
04059 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
04060 IR_OPND_R(ir_idx) = null_opnd;
04061
04062 if (res_exp_desc->type != Integer) {
04063
04064
04065
04066 res_exp_desc->foldable = FALSE;
04067 res_exp_desc->will_fold_later = FALSE;
04068 }
04069 }
04070
04071
04072 res_exp_desc->foldable = FALSE;
04073 res_exp_desc->will_fold_later = FALSE;
04074
04075 TRACE (Func_Exit, "max_intrinsic", NULL);
04076
04077 }
04078
04079
04080
04081
04082
04083
04084
04085
04086
04087
04088
04089
04090
04091
04092
04093
04094
04095
04096
04097
04098 void ranget_intrinsic(opnd_type *result_opnd,
04099 expr_arg_type *res_exp_desc,
04100 int *spec_idx)
04101 {
04102 int info_idx1;
04103 int ir_idx;
04104 int list_idx1;
04105 int tmp_attr;
04106 int unused1 = NULL_IDX;
04107 int unused2 = NULL_IDX;
04108 opnd_type old_opnd;
04109 opnd_type base_opnd;
04110
04111
04112 TRACE (Func_Entry, "ranget_intrinsic", NULL);
04113
04114 ir_idx = OPND_IDX((*result_opnd));
04115 list_idx1 = IR_IDX_R(ir_idx);
04116 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
04117 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
04118
04119 # if defined(GENERATE_WHIRL)
04120 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
04121 # endif
04122
04123 conform_check(0,
04124 ir_idx,
04125 res_exp_desc,
04126 spec_idx,
04127 FALSE);
04128
04129
04130 if (IL_IDX(list_idx1) == NULL_IDX) {
04131
04132 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04133 IR_RANK(ir_idx) = res_exp_desc->rank;
04134
04135 tmp_attr = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
04136 IR_COL_NUM(ir_idx),
04137 Priv, TRUE);
04138 ATD_STOR_BLK_IDX(tmp_attr) = SCP_SB_STACK_IDX(curr_scp_idx);
04139 ATD_TYPE_IDX(tmp_attr) = INTEGER_DEFAULT_TYPE;
04140 # if defined(GENERATE_WHIRL)
04141 ATD_TYPE_IDX(tmp_attr) = Integer_8;
04142 # endif
04143 AT_SEMANTICS_DONE(tmp_attr) = TRUE;
04144
04145 IL_FLD(list_idx1) = AT_Tbl_Idx;
04146 IL_IDX(list_idx1) = tmp_attr;
04147 IL_LINE_NUM(list_idx1) = IR_LINE_NUM(ir_idx);
04148 IL_COL_NUM(list_idx1) = IR_COL_NUM(ir_idx);
04149 }
04150 else {
04151 COPY_OPND(old_opnd, IL_OPND(list_idx1));
04152
04153 if (! arg_info_list[info_idx1].ed.reference &&
04154 ! arg_info_list[info_idx1].ed.tmp_reference) {
04155
04156 tmp_attr = create_tmp_asg(&old_opnd,
04157 (expr_arg_type *)&(arg_info_list[info_idx1].ed),
04158 &base_opnd,
04159 Intent_In,
04160 TRUE,
04161 FALSE);
04162
04163 COPY_OPND(old_opnd, base_opnd);
04164 }
04165
04166 if (arg_info_list[info_idx1].ed.rank > 0) {
04167 make_base_subtree(&old_opnd, &base_opnd, &unused1, &unused2);
04168 COPY_OPND(IL_OPND(list_idx1), base_opnd);
04169 }
04170 else {
04171 COPY_OPND(IL_OPND(list_idx1), old_opnd);
04172 }
04173 }
04174
04175 # if defined(GENERATE_WHIRL)
04176 COPY_OPND(old_opnd, IL_OPND(list_idx1));
04177 cast_to_type_idx(&old_opnd, &arg_info_list[info_idx1].ed, Integer_8);
04178 COPY_OPND(IL_OPND(list_idx1), old_opnd);
04179 # else
04180 COPY_OPND(old_opnd, IL_OPND(list_idx1));
04181 cast_to_cg_default(&old_opnd, &(arg_info_list[info_idx1].ed));
04182 COPY_OPND(IL_OPND(list_idx1), old_opnd);
04183 # endif
04184
04185 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04186 IR_RANK(ir_idx) = res_exp_desc->rank;
04187 if (ATP_INTRIN_ENUM(*spec_idx) == Ranget_Intrinsic) {
04188
04189 }
04190 else {
04191
04192 }
04193 #if 0
04194 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04195 IR_OPND_R(ir_idx) = null_opnd;
04196 #endif
04197
04198
04199
04200
04201 res_exp_desc->foldable = FALSE;
04202 res_exp_desc->will_fold_later = FALSE;
04203
04204
04205 TRACE (Func_Exit, "ranget_intrinsic", NULL);
04206
04207 }
04208
04209
04210
04211
04212
04213
04214
04215
04216
04217
04218
04219
04220
04221
04222
04223
04224
04225
04226 void ranf_intrinsic(opnd_type *result_opnd,
04227 expr_arg_type *res_exp_desc,
04228 int *spec_idx)
04229 {
04230 int ir_idx;
04231
04232
04233 TRACE (Func_Entry, "ranf_intrinsic", NULL);
04234
04235 ir_idx = OPND_IDX((*result_opnd));
04236 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_8;
04237
04238 conform_check(0,
04239 ir_idx,
04240 res_exp_desc,
04241 spec_idx,
04242 FALSE);
04243
04244 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04245 IR_RANK(ir_idx) = res_exp_desc->rank;
04246
04247 # if 0
04248
04249 IR_OPR(ir_idx) = Ranf_Opr;
04250
04251 IR_OPND_L(ir_idx) = null_opnd;
04252 IR_OPND_R(ir_idx) = null_opnd;
04253
04254
04255
04256
04257 # endif
04258
04259 res_exp_desc->foldable = FALSE;
04260 res_exp_desc->will_fold_later = FALSE;
04261
04262
04263
04264 TRACE (Func_Exit, "ranf_intrinsic", NULL);
04265
04266 }
04267
04268
04269
04270
04271
04272
04273
04274
04275
04276
04277
04278
04279
04280
04281
04282
04283
04284
04285
04286
04287
04288
04289
04290
04291
04292
04293
04294
04295
04296
04297
04298
04299
04300
04301
04302
04303 void real_intrinsic(opnd_type *result_opnd,
04304 expr_arg_type *res_exp_desc,
04305 int *spec_idx)
04306 {
04307 int list_idx1;
04308 int list_idx2;
04309 int ir_idx;
04310 int info_idx1;
04311 int info_idx2;
04312
04313
04314 TRACE (Func_Entry, "real_intrinsic", NULL);
04315
04316 ir_idx = OPND_IDX((*result_opnd));
04317 list_idx1 = IR_IDX_R(ir_idx);
04318 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
04319 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
04320
04321 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
04322 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
04323 kind_to_linear_type(&((IL_OPND(list_idx2))),
04324 ATP_RSLT_IDX(*spec_idx),
04325 arg_info_list[info_idx2].ed.kind0seen,
04326 arg_info_list[info_idx2].ed.kind0E0seen,
04327 arg_info_list[info_idx2].ed.kind0D0seen,
04328 ! arg_info_list[info_idx2].ed.kindnotconst);
04329 }
04330 else {
04331 switch (arg_info_list[info_idx1].ed.type) {
04332 case Integer:
04333 case Typeless:
04334 case Real:
04335 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = REAL_DEFAULT_TYPE;
04336 break;
04337
04338 case Complex:
04339 switch (arg_info_list[info_idx1].ed.linear_type) {
04340 case Complex_4:
04341 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_4;
04342 break;
04343 case Complex_8:
04344 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_8;
04345 break;
04346 case Complex_16:
04347 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_16;
04348 break;
04349 }
04350 break;
04351 }
04352 }
04353
04354 if (ATP_INTRIN_ENUM(*spec_idx) == Dfloat_Intrinsic ||
04355 ATP_INTRIN_ENUM(*spec_idx) == Dreal_Intrinsic ||
04356 ATP_INTRIN_ENUM(*spec_idx) == Dble_Intrinsic ||
04357 ATP_INTRIN_ENUM(*spec_idx) == Dbleq_Intrinsic ||
04358 ATP_INTRIN_ENUM(*spec_idx) == Dfloati_Intrinsic ||
04359 ATP_INTRIN_ENUM(*spec_idx) == Dfloatj_Intrinsic ||
04360 ATP_INTRIN_ENUM(*spec_idx) == Dfloatk_Intrinsic) {
04361 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = DOUBLE_DEFAULT_TYPE;
04362 }
04363
04364 if (ATP_INTRIN_ENUM(*spec_idx) == Qfloat_Intrinsic ||
04365 ATP_INTRIN_ENUM(*spec_idx) == Qext_Intrinsic ||
04366 ATP_INTRIN_ENUM(*spec_idx) == Qreal_Intrinsic ||
04367 ATP_INTRIN_ENUM(*spec_idx) == Qfloati_Intrinsic ||
04368 ATP_INTRIN_ENUM(*spec_idx) == Qfloatj_Intrinsic ||
04369 ATP_INTRIN_ENUM(*spec_idx) == Qfloatk_Intrinsic) {
04370 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_16;
04371 }
04372
04373 conform_check(0,
04374 ir_idx,
04375 res_exp_desc,
04376 spec_idx,
04377 FALSE);
04378
04379
04380 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04381 IR_RANK(ir_idx) = res_exp_desc->rank;
04382
04383 # if 0
04384
04385 IR_OPR(ir_idx) = Real_Opr;
04386
04387 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04388 IR_OPND_R(ir_idx) = null_opnd;
04389 IR_LIST_CNT_L(ir_idx) = 1;
04390 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
04391
04392
04393
04394
04395 # endif
04396
04397 res_exp_desc->foldable = FALSE;
04398 res_exp_desc->will_fold_later = FALSE;
04399
04400 TRACE (Func_Exit, "real_intrinsic", NULL);
04401
04402 }
04403
04404
04405
04406
04407
04408
04409
04410
04411
04412
04413
04414
04415
04416
04417
04418
04419
04420
04421 void mask_intrinsic(opnd_type *result_opnd,
04422 expr_arg_type *res_exp_desc,
04423 int *spec_idx)
04424 {
04425 int info_idx1;
04426 int ir_idx;
04427 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
04428 int list_idx1;
04429 int type_idx;
04430
04431
04432 TRACE (Func_Entry, "mask_intrinsic", NULL);
04433
04434 ir_idx = OPND_IDX((*result_opnd));
04435
04436
04437 list_idx1 = IR_IDX_R(ir_idx);
04438 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
04439 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
04440 # if defined(GENERATE_WHIRL)
04441 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
04442 if (arg_info_list[info_idx1].ed.type == Integer) {
04443 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
04444 arg_info_list[info_idx1].ed.linear_type;
04445 }
04446 # endif
04447
04448 IR_RANK(ir_idx) = res_exp_desc->rank;
04449
04450 # ifdef _TARGET32
04451 if (arg_info_list[info_idx1].ed.linear_type == Integer_8) {
04452 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_8;
04453 # if defined(GENERATE_WHIRL)
04454 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
04455 # endif
04456 }
04457 # endif
04458
04459 # ifdef _TARGET_OS_MAX
04460 if (arg_info_list[info_idx1].ed.linear_type == Integer_1 ||
04461 arg_info_list[info_idx1].ed.linear_type == Integer_2 ||
04462 arg_info_list[info_idx1].ed.linear_type == Integer_4) {
04463 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_4;
04464 }
04465 # endif
04466
04467 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04468
04469
04470 conform_check(0,
04471 ir_idx,
04472 res_exp_desc,
04473 spec_idx,
04474 FALSE);
04475
04476
04477 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04478 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
04479 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
04480 arg_info_list[info_idx1].ed.type_idx,
04481 NULL,
04482 NULL_IDX,
04483 folded_const,
04484 &type_idx,
04485 IR_LINE_NUM(ir_idx),
04486 IR_COL_NUM(ir_idx),
04487 1,
04488 Mask_Opr)) {
04489 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
04490 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
04491 FALSE,
04492 folded_const);
04493 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
04494 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
04495 res_exp_desc->constant = TRUE;
04496 res_exp_desc->foldable = TRUE;
04497 }
04498 else {
04499 IR_OPR(ir_idx) = Mask_Opr;
04500 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04501 IR_OPND_R(ir_idx) = null_opnd;
04502 }
04503
04504 TRACE (Func_Exit, "mask_intrinsic", NULL);
04505
04506 }
04507
04508
04509
04510
04511
04512
04513
04514
04515
04516
04517
04518
04519
04520
04521
04522
04523
04524
04525 void conjg_intrinsic(opnd_type *result_opnd,
04526 expr_arg_type *res_exp_desc,
04527 int *spec_idx)
04528 {
04529 int ir_idx;
04530 int list_idx1;
04531 int info_idx1;
04532
04533
04534 TRACE (Func_Entry, "conjg_intrinsic", NULL);
04535
04536 ir_idx = OPND_IDX((*result_opnd));
04537 list_idx1 = IR_IDX_R(ir_idx);
04538 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
04539 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
04540
04541 conform_check(0,
04542 ir_idx,
04543 res_exp_desc,
04544 spec_idx,
04545 FALSE);
04546
04547
04548 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04549 IR_RANK(ir_idx) = res_exp_desc->rank;
04550
04551
04552
04553 IR_OPR(ir_idx) = Conjg_Opr;
04554
04555 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04556 IR_OPND_R(ir_idx) = null_opnd;
04557
04558
04559
04560
04561
04562
04563 res_exp_desc->foldable = FALSE;
04564 res_exp_desc->will_fold_later = FALSE;
04565
04566 TRACE (Func_Exit, "conjg_intrinsic", NULL);
04567
04568 }
04569
04570
04571
04572
04573
04574
04575
04576
04577
04578
04579
04580
04581
04582
04583
04584
04585
04586
04587 void dprod_intrinsic(opnd_type *result_opnd,
04588 expr_arg_type *res_exp_desc,
04589 int *spec_idx)
04590 {
04591 int ir_idx;
04592 int list_idx1;
04593 int list_idx2;
04594 int info_idx1;
04595 int info_idx2;
04596 opnd_type opnd;
04597
04598
04599 TRACE (Func_Entry, "dprod_intrinsic", NULL);
04600
04601 ir_idx = OPND_IDX((*result_opnd));
04602 list_idx1 = IR_IDX_R(ir_idx);
04603 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
04604 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
04605 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
04606 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = DOUBLE_DEFAULT_TYPE;
04607
04608 if (ATP_INTRIN_ENUM(*spec_idx) == Qprod_Intrinsic) {
04609 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_16;
04610 }
04611
04612 if ((TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx) != REAL_DEFAULT_TYPE) ||
04613 (TYP_LINEAR(arg_info_list[info_idx2].ed.type_idx) != REAL_DEFAULT_TYPE)) {
04614 PRINTMSG(IR_LINE_NUM(ir_idx), 361, Error,
04615 IR_COL_NUM(ir_idx));
04616 }
04617
04618 conform_check(0,
04619 ir_idx,
04620 res_exp_desc,
04621 spec_idx,
04622 FALSE);
04623
04624
04625 COPY_OPND(opnd, IL_OPND(list_idx1));
04626 cast_to_type_idx(&opnd,
04627 &arg_info_list[info_idx1].ed,
04628 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
04629
04630 COPY_OPND(IL_OPND(list_idx1), opnd);
04631
04632 COPY_OPND(opnd, IL_OPND(list_idx2));
04633 cast_to_type_idx(&opnd,
04634 &arg_info_list[info_idx2].ed,
04635 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
04636 COPY_OPND(IL_OPND(list_idx2), opnd);
04637
04638
04639 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04640 IR_RANK(ir_idx) = res_exp_desc->rank;
04641
04642 # if 0
04643
04644 IR_OPR(ir_idx) = Dprod_Opr;
04645
04646 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04647 IR_OPND_R(ir_idx) = null_opnd;
04648
04649
04650
04651
04652 # endif
04653
04654 res_exp_desc->foldable = FALSE;
04655 res_exp_desc->will_fold_later = FALSE;
04656
04657 TRACE (Func_Exit, "dprod_intrinsic", NULL);
04658
04659 }
04660
04661
04662
04663
04664
04665
04666
04667
04668
04669
04670
04671
04672
04673
04674
04675
04676
04677
04678 void length_intrinsic(opnd_type *result_opnd,
04679 expr_arg_type *res_exp_desc,
04680 int *spec_idx)
04681 {
04682 int ir_idx;
04683
04684 # if defined(GENERATE_WHIRL)
04685 opnd_type opnd;
04686 # endif
04687
04688
04689 TRACE (Func_Entry, "length_intrinsic", NULL);
04690
04691 ir_idx = OPND_IDX((*result_opnd));
04692 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
04693
04694 conform_check(0,
04695 ir_idx,
04696 res_exp_desc,
04697 spec_idx,
04698 FALSE);
04699
04700 # if defined(GENERATE_WHIRL)
04701
04702
04703 #if 0
04704 COPY_OPND(opnd, IR_OPND_R(ir_idx));
04705 final_arg_work(&opnd, IR_IDX_L(ir_idx), IR_LIST_CNT_R(ir_idx), NULL);
04706 COPY_OPND(IR_OPND_R(ir_idx), opnd);
04707 #endif
04708
04709 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04710 IR_RANK(ir_idx) = res_exp_desc->rank;
04711 #if 0
04712 IR_OPR(ir_idx) = Length_Opr;
04713
04714 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04715 IR_OPND_R(ir_idx) = null_opnd;
04716 #endif
04717 # else
04718 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04719 IR_RANK(ir_idx) = res_exp_desc->rank;
04720 #if 0
04721 IR_OPR(ir_idx) = Length_Opr;
04722
04723 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04724 IR_OPND_R(ir_idx) = null_opnd;
04725 #endif
04726 # endif
04727
04728
04729
04730
04731 res_exp_desc->foldable = FALSE;
04732 res_exp_desc->will_fold_later = FALSE;
04733
04734 TRACE (Func_Exit, "length_intrinsic", NULL);
04735
04736 }
04737
04738
04739
04740
04741
04742
04743
04744
04745
04746
04747
04748
04749
04750
04751
04752
04753
04754
04755 void getpos_intrinsic(opnd_type *result_opnd,
04756 expr_arg_type *res_exp_desc,
04757 int *spec_idx)
04758 {
04759 int ir_idx;
04760
04761
04762 TRACE (Func_Entry, "getpos_intrinsic", NULL);
04763
04764 ir_idx = OPND_IDX((*result_opnd));
04765 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
04766
04767 conform_check(0,
04768 ir_idx,
04769 res_exp_desc,
04770 spec_idx,
04771 FALSE);
04772
04773
04774 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04775 IR_RANK(ir_idx) = res_exp_desc->rank;
04776
04777 # if 0
04778
04779 IR_OPR(ir_idx) = Getpos_Opr;
04780
04781 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04782 IR_OPND_R(ir_idx) = null_opnd;
04783
04784
04785
04786
04787 # endif
04788
04789 res_exp_desc->foldable = FALSE;
04790 res_exp_desc->will_fold_later = FALSE;
04791
04792 TRACE (Func_Exit, "getpos_intrinsic", NULL);
04793
04794 }
04795
04796
04797
04798
04799
04800
04801
04802
04803
04804
04805
04806
04807
04808
04809
04810
04811
04812
04813 void unit_intrinsic(opnd_type *result_opnd,
04814 expr_arg_type *res_exp_desc,
04815 int *spec_idx)
04816 {
04817 int ir_idx;
04818
04819 # if defined(GENERATE_WHIRL)
04820 opnd_type opnd;
04821 # endif
04822
04823
04824 TRACE (Func_Entry, "unit_intrinsic", NULL);
04825
04826 ir_idx = OPND_IDX((*result_opnd));
04827 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = REAL_DEFAULT_TYPE;
04828
04829 conform_check(0,
04830 ir_idx,
04831 res_exp_desc,
04832 spec_idx,
04833 FALSE);
04834
04835 # if defined(GENERATE_WHIRL)
04836 COPY_OPND(opnd, IR_OPND_R(ir_idx));
04837 final_arg_work(&opnd, IR_IDX_L(ir_idx), IR_LIST_CNT_R(ir_idx), NULL);
04838 COPY_OPND(IR_OPND_R(ir_idx), opnd);
04839
04840 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04841 IR_RANK(ir_idx) = res_exp_desc->rank;
04842 #if 0
04843 IR_OPR(ir_idx) = Unit_Opr;
04844
04845 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04846 IR_OPND_R(ir_idx) = null_opnd;
04847 #endif
04848 # else
04849 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04850 IR_RANK(ir_idx) = res_exp_desc->rank;
04851 #if 0
04852 IR_OPR(ir_idx) = Unit_Opr;
04853
04854 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04855 IR_OPND_R(ir_idx) = null_opnd;
04856 #endif
04857 # endif
04858
04859
04860
04861
04862 res_exp_desc->foldable = FALSE;
04863 res_exp_desc->will_fold_later = FALSE;
04864
04865 TRACE (Func_Exit, "unit_intrinsic", NULL);
04866
04867 }
04868
04869
04870
04871
04872
04873
04874
04875
04876
04877
04878
04879
04880
04881
04882
04883
04884
04885
04886 void cmplx_intrinsic(opnd_type *result_opnd,
04887 expr_arg_type *res_exp_desc,
04888 int *spec_idx)
04889 {
04890 int column;
04891 int line;
04892 int list_idx1;
04893 int list_idx2;
04894 int list_idx3;
04895 int info_idx1;
04896 int info_idx2;
04897 int info_idx3;
04898 int ir_idx;
04899 int list_idx;
04900 operator_type opr;
04901 int type_idx;
04902 opnd_type opnd;
04903
04904
04905 TRACE (Func_Entry, "cmplx_intrinsic", NULL);
04906
04907 ir_idx = OPND_IDX((*result_opnd));
04908 list_idx1 = IR_IDX_R(ir_idx);
04909 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
04910 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
04911 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
04912 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
04913 opr = Cmplx_Opr;
04914
04915 if ((list_idx3 != NULL_IDX) && (IL_IDX(list_idx3) != NULL_IDX)) {
04916 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
04917 kind_to_linear_type(&((IL_OPND(list_idx3))),
04918 ATP_RSLT_IDX(*spec_idx),
04919 arg_info_list[info_idx3].ed.kind0seen,
04920 arg_info_list[info_idx3].ed.kind0E0seen,
04921 arg_info_list[info_idx3].ed.kind0D0seen,
04922 ! arg_info_list[info_idx3].ed.kindnotconst);
04923 }
04924 else {
04925 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = COMPLEX_DEFAULT_TYPE;
04926 }
04927
04928 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
04929 case Complex_4:
04930 type_idx = Real_4;
04931 break;
04932
04933 case Complex_8:
04934 type_idx = Real_8;
04935 break;
04936
04937 case Complex_16:
04938 type_idx = Real_16;
04939 break;
04940 }
04941
04942 if ((ATP_INTRIN_ENUM(*spec_idx) == Dcmplx_Intrinsic) &&
04943 (on_off_flags.enable_double_precision)) {
04944 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = DOUBLE_COMPLEX_DEFAULT_TYPE;
04945 }
04946
04947 if (ATP_INTRIN_ENUM(*spec_idx) == Qcmplx_Intrinsic) {
04948 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Complex_16;
04949 }
04950
04951 conform_check(2,
04952 ir_idx,
04953 res_exp_desc,
04954 spec_idx,
04955 FALSE);
04956
04957 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
04958 IR_RANK(ir_idx) = res_exp_desc->rank;
04959
04960
04961 if (arg_info_list[info_idx1].ed.type == Integer) {
04962 COPY_OPND(opnd, IL_OPND(list_idx1));
04963 cast_to_type_idx(&opnd, &arg_info_list[info_idx1].ed, type_idx);
04964 COPY_OPND(IL_OPND(list_idx1), opnd);
04965 }
04966
04967 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
04968 if (arg_info_list[info_idx2].ed.type == Integer) {
04969 COPY_OPND(opnd, IL_OPND(list_idx2));
04970 cast_to_type_idx(&opnd, &arg_info_list[info_idx2].ed, type_idx);
04971 COPY_OPND(IL_OPND(list_idx2), opnd);
04972 }
04973
04974 if (arg_info_list[info_idx1].ed.type == Complex) {
04975 find_opnd_line_and_column((opnd_type *) &IL_OPND(list_idx2),
04976 &line,
04977 &column);
04978 PRINTMSG(line, 738, Error, column);
04979 }
04980 }
04981 else {
04982
04983 if (arg_info_list[info_idx1].ed.type == Complex) {
04984 opr = Cvrt_Opr;
04985 }
04986 else {
04987 IL_FLD(list_idx2) = CN_Tbl_Idx;
04988 IL_IDX(list_idx2) = cvrt_str_to_cn("0.0",
04989 REAL_DEFAULT_TYPE);
04990 IL_LINE_NUM(list_idx2) = IR_LINE_NUM(ir_idx);
04991 IL_COL_NUM(list_idx2) = IR_COL_NUM(ir_idx);
04992 }
04993 }
04994
04995 IR_OPR(ir_idx) = opr;
04996 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
04997 IR_OPND_R(ir_idx) = null_opnd;
04998
04999 if (opr == Cvrt_Opr) {
05000 IR_LIST_CNT_L(ir_idx) = 1;
05001 list_idx = IR_IDX_L(ir_idx);
05002 IL_NEXT_LIST_IDX(list_idx) = NULL_IDX;
05003 }
05004 else {
05005 IR_LIST_CNT_L(ir_idx) = 2;
05006 list_idx = IR_IDX_L(ir_idx);
05007 list_idx = IL_NEXT_LIST_IDX(list_idx);
05008 IL_NEXT_LIST_IDX(list_idx) = NULL_IDX;
05009 }
05010
05011
05012
05013
05014
05015 res_exp_desc->foldable = FALSE;
05016 res_exp_desc->will_fold_later = FALSE;
05017
05018 TRACE (Func_Exit, "cmplx_intrinsic", NULL);
05019
05020 }
05021
05022
05023
05024
05025
05026
05027
05028
05029
05030
05031
05032
05033
05034
05035
05036
05037
05038
05039 void len_intrinsic(opnd_type *result_opnd,
05040 expr_arg_type *res_exp_desc,
05041 int *spec_idx)
05042 {
05043 int unused_idx;
05044 int ir_idx;
05045 int line;
05046 int col;
05047 int keep;
05048
05049 TRACE (Func_Entry, "len_intrinsic", NULL);
05050
05051 ir_idx = OPND_IDX((*result_opnd));
05052 keep = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) ;
05053 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
05054
05055 conform_check(0,
05056 ir_idx,
05057 res_exp_desc,
05058 spec_idx,
05059 TRUE);
05060
05061
05062 if (cmd_line_flags.runtime_substring &&
05063 IR_OPR(IL_IDX(IR_IDX_R(ir_idx))) == Substring_Opr) {
05064
05065 }
05066
05067
05068
05069
05070 IR_TYPE_IDX(ir_idx) = keep;
05071
05072
05073 #if 0
05074
05075 IR_OPR(ir_idx) = Clen_Opr;
05076
05077 unused_idx = find_base_attr(&IL_OPND(IR_IDX_R(ir_idx)), &line, &col);
05078
05079 COPY_OPND(IR_OPND_L(ir_idx), IL_OPND(IR_IDX_R(ir_idx)));
05080 IR_OPND_R(ir_idx) = null_opnd;
05081
05082 fold_clen_opr(result_opnd, res_exp_desc);
05083
05084 # endif
05085
05086
05087 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05088 res_exp_desc->linear_type =
05089 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
05090
05091
05092
05093
05094
05095 res_exp_desc->will_fold_later = FALSE;
05096 res_exp_desc->foldable = FALSE;
05097
05098
05099 TRACE (Func_Exit, "len_intrinsic", NULL);
05100
05101 }
05102
05103
05104
05105
05106
05107
05108
05109
05110
05111
05112
05113
05114
05115
05116
05117
05118
05119
05120 void ichar_intrinsic(opnd_type *result_opnd,
05121 expr_arg_type *res_exp_desc,
05122 int *spec_idx)
05123 {
05124 int ir_idx;
05125 int info_idx1;
05126 int list_idx1;
05127 long_type cnst[MAX_WORDS_FOR_NUMERIC];
05128 int type_idx;
05129
05130
05131 TRACE (Func_Entry, "ichar_intrinsic", NULL);
05132
05133 ir_idx = OPND_IDX((*result_opnd));
05134 list_idx1 = IR_IDX_R(ir_idx);
05135 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
05136 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
05137 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05138
05139 conform_check(0,
05140 ir_idx,
05141 res_exp_desc,
05142 spec_idx,
05143 FALSE);
05144
05145 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05146 IR_RANK(ir_idx) = res_exp_desc->rank;
05147
05148 res_exp_desc->type_idx = type_idx;
05149 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
05150
05151 if ((OPND_FLD(arg_info_list[info_idx1].ed.char_len) == CN_Tbl_Idx) &&
05152 (CN_INT_TO_C(OPND_IDX(arg_info_list[info_idx1].ed.char_len)) != 1)) {
05153 PRINTMSG(IR_LINE_NUM(ir_idx), 327, Ansi,
05154 IR_COL_NUM(ir_idx));
05155 }
05156
05157
05158 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
05159 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
05160 arg_info_list[info_idx1].ed.type_idx,
05161 NULL,
05162 NULL_IDX,
05163 cnst,
05164 &type_idx,
05165 IR_LINE_NUM(ir_idx),
05166 IR_COL_NUM(ir_idx),
05167 1,
05168 Ichar_Opr)) {
05169 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
05170 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
05171 FALSE,
05172 cnst);
05173 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
05174 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
05175 res_exp_desc->constant = TRUE;
05176 res_exp_desc->foldable = TRUE;
05177 }
05178 else {
05179 IR_OPR(ir_idx) = Ichar_Opr;
05180 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05181 IR_OPND_R(ir_idx) = null_opnd;
05182 }
05183
05184 TRACE (Func_Exit, "ichar_intrinsic", NULL);
05185
05186 }
05187
05188
05189
05190
05191
05192
05193
05194
05195
05196
05197
05198
05199
05200
05201
05202
05203
05204
05205 void char_intrinsic(opnd_type *result_opnd,
05206 expr_arg_type *res_exp_desc,
05207 int *spec_idx)
05208 {
05209 int list_idx1;
05210 int list_idx2;
05211 long_type cnst[MAX_WORDS_FOR_NUMERIC];
05212 int ir_idx;
05213 int info_idx1;
05214 int info_idx2;
05215 int type_idx;
05216
05217
05218 TRACE (Func_Entry, "char_intrinsic", NULL);
05219
05220 ir_idx = OPND_IDX((*result_opnd));
05221 list_idx1 = IR_IDX_R(ir_idx);
05222 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
05223 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
05224
05225 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
05226 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
05227 kind_to_linear_type(&((IL_OPND(list_idx2))),
05228 ATP_RSLT_IDX(*spec_idx),
05229 arg_info_list[info_idx2].ed.kind0seen,
05230 arg_info_list[info_idx2].ed.kind0E0seen,
05231 arg_info_list[info_idx2].ed.kind0D0seen,
05232 ! arg_info_list[info_idx2].ed.kindnotconst);
05233 }
05234 else {
05235 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Character_1;
05236 }
05237
05238 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05239
05240 conform_check(0,
05241 ir_idx,
05242 res_exp_desc,
05243 spec_idx,
05244 FALSE);
05245
05246 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05247 IR_RANK(ir_idx) = res_exp_desc->rank;
05248
05249 res_exp_desc->char_len.fld = CN_Tbl_Idx;
05250 res_exp_desc->char_len.idx = CN_INTEGER_ONE_IDX;
05251 res_exp_desc->type_idx = type_idx;
05252 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
05253 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
05254 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
05255 arg_info_list[info_idx1].ed.type_idx,
05256 NULL,
05257 NULL_IDX,
05258 cnst,
05259 &type_idx,
05260 IR_LINE_NUM(ir_idx),
05261 IR_COL_NUM(ir_idx),
05262 1,
05263 Char_Opr)) {
05264 if (compare_cn_and_value(IL_IDX(list_idx1), 255, Gt_Opr) ||
05265 compare_cn_and_value(IL_IDX(list_idx1), 0, Lt_Opr)) {
05266 PRINTMSG(arg_info_list[info_idx1].line, 999, Error,
05267 arg_info_list[info_idx1].col);
05268 }
05269
05270 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
05271 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
05272 FALSE,
05273 cnst);
05274 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
05275 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
05276 res_exp_desc->constant = TRUE;
05277 res_exp_desc->foldable = TRUE;
05278 }
05279 else {
05280 IR_OPR(ir_idx) = Char_Opr;
05281 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05282 IR_OPND_R(ir_idx) = null_opnd;
05283
05284 IR_LIST_CNT_L(ir_idx) = 1;
05285 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
05286
05287
05288 io_item_must_flatten = TRUE;
05289 }
05290
05291
05292 TRACE (Func_Exit, "char_intrinsic", NULL);
05293
05294 }
05295
05296
05297
05298
05299
05300
05301
05302
05303
05304
05305
05306
05307
05308
05309
05310
05311
05312
05313
05314
05315 void index_intrinsic(opnd_type *result_opnd,
05316 expr_arg_type *res_exp_desc,
05317 int *spec_idx)
05318 {
05319 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
05320 int cn_idx;
05321 long_type cnst[MAX_WORDS_FOR_NUMERIC];
05322 int ir_idx;
05323 int info_idx1;
05324 int info_idx2;
05325 int info_idx3;
05326 int list_idx1;
05327 int list_idx2;
05328 int list_idx3;
05329 int type_idx;
05330 operator_type opr;
05331 opnd_type opnd;
05332
05333
05334 TRACE (Func_Entry, "index_intrinsic", NULL);
05335
05336 ir_idx = OPND_IDX((*result_opnd));
05337 list_idx1 = IR_IDX_R(ir_idx);
05338 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
05339 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
05340 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
05341 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
05342 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
05343
05344 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05345
05346 conform_check(3,
05347 ir_idx,
05348 res_exp_desc,
05349 spec_idx,
05350 FALSE);
05351
05352 IR_TYPE_IDX(ir_idx) = type_idx;
05353 IR_RANK(ir_idx) = res_exp_desc->rank;
05354
05355
05356 res_exp_desc->type_idx = type_idx;
05357 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
05358
05359 if (IL_IDX(list_idx3) == NULL_IDX) {
05360 cn_idx = set_up_logical_constant(cnst,
05361 CG_LOGICAL_DEFAULT_TYPE,
05362 FALSE_VALUE,
05363 TRUE);
05364
05365 IL_FLD(list_idx3) = CN_Tbl_Idx;
05366 IL_IDX(list_idx3) = cn_idx;
05367 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
05368 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
05369
05370 arg_info_list_base = arg_info_list_top;
05371 arg_info_list_top = arg_info_list_base + 1;
05372
05373 if (arg_info_list_top >= arg_info_list_size) {
05374 enlarge_info_list_table();
05375 }
05376
05377 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
05378 arg_info_list[arg_info_list_top] = init_arg_info;
05379 arg_info_list[arg_info_list_top].ed.type_idx = CG_LOGICAL_DEFAULT_TYPE;
05380 arg_info_list[arg_info_list_top].ed.type = Logical;
05381 arg_info_list[arg_info_list_top].ed.linear_type= CG_LOGICAL_DEFAULT_TYPE;
05382 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
05383 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
05384 }
05385
05386 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
05387
05388 if (ATP_INTRIN_ENUM(*spec_idx) == Index_Intrinsic) {
05389 opr = Index_Opr;
05390 }
05391 else if (ATP_INTRIN_ENUM(*spec_idx) == Verify_Intrinsic) {
05392 opr = Verify_Opr;
05393 }
05394 else {
05395 opr = Scan_Opr;
05396 # ifdef _TARGET_OS_MAX
05397 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
05398 # endif
05399 }
05400
05401 if ((list_idx3 != NULL_IDX) && (IL_IDX(list_idx3) != NULL_IDX)) {
05402 COPY_OPND(opnd, IL_OPND(list_idx3));
05403 cast_to_cg_default(&opnd, &(arg_info_list[info_idx3].ed));
05404 COPY_OPND(IL_OPND(list_idx3), opnd);
05405 }
05406
05407 # if 0
05408 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
05409 IL_FLD(list_idx2) == CN_Tbl_Idx &&
05410 IL_FLD(list_idx3) == CN_Tbl_Idx &&
05411 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
05412 arg_info_list[info_idx1].ed.type_idx,
05413 (char *)&CN_CONST(IL_IDX(list_idx2)),
05414 arg_info_list[info_idx2].ed.type_idx,
05415 folded_const,
05416 &type_idx,
05417 IR_LINE_NUM(ir_idx),
05418 IR_COL_NUM(ir_idx),
05419 3,
05420 opr,
05421 (char *)&CN_CONST(IL_IDX(list_idx3)),
05422 (long)arg_info_list[info_idx3].ed.type_idx)) {
05423 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
05424 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
05425 FALSE,
05426 folded_const);
05427 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
05428 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
05429 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
05430 res_exp_desc->constant = TRUE;
05431 res_exp_desc->foldable = TRUE;
05432 }
05433 else {
05434 #endif
05435
05436 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
05437 IR_OPR(ir_idx) = opr;
05438 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05439 IR_OPND_R(ir_idx) = null_opnd;
05440 }
05441
05442
05443
05444
05445 TRACE (Func_Exit, "index_intrinsic", NULL);
05446
05447 }
05448
05449
05450
05451
05452
05453
05454
05455
05456
05457
05458
05459
05460
05461
05462
05463
05464
05465
05466
05467
05468
05469 void lge_intrinsic(opnd_type *result_opnd,
05470 expr_arg_type *res_exp_desc,
05471 int *spec_idx)
05472 {
05473 int ir_idx;
05474 int list_idx1;
05475 int list_idx2;
05476 int info_idx1;
05477 int info_idx2;
05478 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
05479 int type_idx;
05480
05481
05482 TRACE (Func_Entry, "lge_intrinsic", NULL);
05483
05484 ir_idx = OPND_IDX((*result_opnd));
05485 list_idx1 = IR_IDX_R(ir_idx);
05486 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
05487 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
05488 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
05489
05490 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
05491 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05492
05493 conform_check(0,
05494 ir_idx,
05495 res_exp_desc,
05496 spec_idx,
05497 FALSE);
05498
05499 IR_TYPE_IDX(ir_idx) = type_idx;
05500 IR_RANK(ir_idx) = res_exp_desc->rank;
05501
05502
05503
05504 res_exp_desc->type_idx = type_idx;
05505 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
05506
05507 if (ATP_INTRIN_ENUM(*spec_idx) == Lge_Intrinsic) {
05508 IR_OPR(ir_idx) = Ge_Opr;
05509 }
05510 else if (ATP_INTRIN_ENUM(*spec_idx) == Llt_Intrinsic) {
05511 IR_OPR(ir_idx) = Lt_Opr;
05512 }
05513 else if (ATP_INTRIN_ENUM(*spec_idx) == Lle_Intrinsic) {
05514 IR_OPR(ir_idx) = Le_Opr;
05515 }
05516 else {
05517 IR_OPR(ir_idx) = Gt_Opr;
05518 }
05519
05520 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
05521 IL_FLD(list_idx2) == CN_Tbl_Idx &&
05522 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
05523 arg_info_list[info_idx1].ed.type_idx,
05524 (char *)&CN_CONST(IL_IDX(list_idx2)),
05525 arg_info_list[info_idx2].ed.type_idx,
05526 folded_const,
05527 &type_idx,
05528 IR_LINE_NUM(ir_idx),
05529 IR_COL_NUM(ir_idx),
05530 2,
05531 IR_OPR(ir_idx))) {
05532 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
05533 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
05534 FALSE,
05535 folded_const);
05536 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
05537 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
05538 res_exp_desc->constant = TRUE;
05539 res_exp_desc->foldable = TRUE;
05540 }
05541 else {
05542 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05543 IR_OPND_R(ir_idx) = null_opnd;
05544 }
05545
05546
05547 #if 0
05548 res_exp_desc->foldable = FALSE;
05549 res_exp_desc->will_fold_later = FALSE;
05550 # endif
05551
05552 TRACE (Func_Exit, "lge_intrinsic", NULL);
05553
05554 }
05555
05556
05557
05558
05559
05560
05561
05562
05563
05564
05565
05566
05567
05568
05569
05570
05571
05572
05573
05574
05575 void loc_intrinsic(opnd_type *result_opnd,
05576 expr_arg_type *res_exp_desc,
05577 int *spec_idx)
05578 {
05579 opnd_type base_opnd;
05580 int ir_idx;
05581 int attr_idx;
05582 int info_idx1;
05583 int list_idx1;
05584 opnd_type old_opnd;
05585 int unused1 = NULL_IDX;
05586 int unused2 = NULL_IDX;
05587
05588
05589 TRACE (Func_Entry, "loc_intrinsic", NULL);
05590
05591 ir_idx = OPND_IDX((*result_opnd));
05592 list_idx1 = IR_IDX_R(ir_idx);
05593 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
05594 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ptr_8;
05595
05596 if (ATP_INTRIN_ENUM(*spec_idx) == Cloc_Intrinsic) {
05597 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ch_Ptr_8;
05598 }
05599
05600 if (ATP_INTRIN_ENUM(*spec_idx) == C_Loc_Intrinsic &&
05601 arg_info_list[info_idx1].ed.type == Character) {
05602 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ch_Ptr_8;
05603 }
05604
05605 if ((strcmp(AT_OBJ_NAME_PTR(*spec_idx), "LOC@") == 0) &&
05606 arg_info_list[info_idx1].ed.type == Character) {
05607 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ch_Ptr_8;
05608 }
05609
05610 conform_check(0,
05611 ir_idx,
05612 res_exp_desc,
05613 spec_idx,
05614 TRUE);
05615
05616 res_exp_desc->rank = 0;
05617 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05618 IR_RANK(ir_idx) = res_exp_desc->rank;
05619
05620 # ifdef _TARGET32
05621 if (arg_info_list[info_idx1].ed.linear_type == Integer_8 ||
05622 arg_info_list[info_idx1].ed.linear_type == Real_8 ||
05623 arg_info_list[info_idx1].ed.linear_type == Logical_8) {
05624
05625 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
05626 TYP_TYPE(TYP_WORK_IDX) = CRI_Ptr;
05627 TYP_LINEAR(TYP_WORK_IDX) = CRI_Ptr_8;
05628 TYP_PTR_INCREMENT(TYP_WORK_IDX) = 64;
05629 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = ntr_type_tbl();
05630 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05631 }
05632 # endif
05633
05634 # ifdef _TARGET_OS_MAX
05635 if (arg_info_list[info_idx1].ed.linear_type == Integer_4 ||
05636 arg_info_list[info_idx1].ed.linear_type == Real_4 ||
05637 arg_info_list[info_idx1].ed.linear_type == Logical_4) {
05638
05639 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
05640 TYP_TYPE(TYP_WORK_IDX) = CRI_Ptr;
05641 TYP_LINEAR(TYP_WORK_IDX) = CRI_Ptr_8;
05642 TYP_PTR_INCREMENT(TYP_WORK_IDX) = 32;
05643 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = ntr_type_tbl();
05644 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05645 }
05646 # endif
05647
05648
05649 res_exp_desc->type_idx = IR_TYPE_IDX(ir_idx);
05650 res_exp_desc->type = TYP_TYPE(IR_TYPE_IDX(ir_idx));
05651 res_exp_desc->linear_type = TYP_LINEAR(IR_TYPE_IDX(ir_idx));
05652
05653 if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
05654 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
05655 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
05656 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr ||
05657 IR_OPR(IL_IDX(list_idx1)) == Struct_Opr ||
05658 IR_OPR(IL_IDX(list_idx1)) == Dv_Deref_Opr ||
05659 IR_OPR(IL_IDX(list_idx1)) == Subscript_Opr ||
05660 IR_OPR(IL_IDX(list_idx1)) == Substring_Opr ||
05661 IR_OPR(IL_IDX(list_idx1)) == Section_Subscript_Opr))) {
05662 attr_idx = find_base_attr(&IL_OPND(list_idx1), &unused1, &unused2);
05663
05664 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) {
05665 PRINTMSG(arg_info_list[info_idx1].line, 779, Error,
05666 arg_info_list[info_idx1].col);
05667 goto EXIT;
05668 }
05669
05670 if ((AT_OBJ_CLASS(attr_idx) == Data_Obj) && ATD_AUXILIARY(attr_idx)) {
05671 PRINTMSG(arg_info_list[info_idx1].line, 990, Error,
05672 arg_info_list[info_idx1].col);
05673 goto EXIT;
05674 }
05675 }
05676 else {
05677 PRINTMSG(arg_info_list[info_idx1].line, 779, Error,
05678 arg_info_list[info_idx1].col);
05679 goto EXIT;
05680 }
05681
05682 # if 0
05683
05684 IR_OPR(ir_idx) = Loc_Opr;
05685
05686 COPY_OPND(old_opnd, IL_OPND(IR_IDX_R(ir_idx)));
05687
05688 unused1 = 0;
05689 unused2 = 0;
05690
05691 make_base_subtree(&old_opnd, &base_opnd, &unused1, &unused2);
05692
05693 COPY_OPND(IR_OPND_L(ir_idx), base_opnd);
05694
05695 IR_OPND_R(ir_idx) = null_opnd;
05696
05697 # endif
05698
05699 EXIT:
05700
05701
05702
05703
05704
05705 res_exp_desc->foldable = FALSE;
05706 res_exp_desc->will_fold_later = FALSE;
05707
05708 TRACE (Func_Exit, "loc_intrinsic", NULL);
05709
05710 }
05711
05712
05713
05714
05715
05716
05717
05718
05719
05720
05721
05722
05723
05724
05725
05726
05727
05728
05729 void fcd_intrinsic(opnd_type *result_opnd,
05730 expr_arg_type *res_exp_desc,
05731 int *spec_idx)
05732 {
05733 int ir_idx;
05734
05735
05736 TRACE (Func_Entry, "fcd_intrinsic", NULL);
05737
05738 ir_idx = OPND_IDX((*result_opnd));
05739 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = CRI_Ch_Ptr_8;
05740
05741 conform_check(0,
05742 ir_idx,
05743 res_exp_desc,
05744 spec_idx,
05745 FALSE);
05746 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05747 IR_RANK(ir_idx) = res_exp_desc->rank;
05748
05749 # if 0
05750
05751 IR_OPR(ir_idx) = Fcd_Opr;
05752
05753 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05754 IR_OPND_R(ir_idx) = null_opnd;
05755
05756 # endif
05757
05758
05759
05760
05761 res_exp_desc->foldable = FALSE;
05762 res_exp_desc->will_fold_later = FALSE;
05763
05764
05765 TRACE (Func_Exit, "fcd_intrinsic", NULL);
05766
05767 }
05768
05769
05770
05771
05772
05773
05774
05775
05776
05777
05778
05779
05780
05781
05782
05783
05784
05785
05786
05787
05788
05789
05790
05791
05792
05793
05794
05795
05796
05797
05798
05799 void fetch_and_add_intrinsic(opnd_type *result_opnd,
05800 expr_arg_type *res_exp_desc,
05801 int *spec_idx)
05802 {
05803 int ir_idx;
05804 int list_idx1;
05805 int info_idx1;
05806
05807
05808 TRACE (Func_Entry, "fetch_and_add_intrinsic", NULL);
05809
05810 ir_idx = OPND_IDX((*result_opnd));
05811
05812 list_idx1 = IR_IDX_R(ir_idx);
05813 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
05814
05815 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
05816
05817 conform_check(0,
05818 ir_idx,
05819 res_exp_desc,
05820 spec_idx,
05821 FALSE);
05822
05823 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05824 IR_RANK(ir_idx) = res_exp_desc->rank;
05825
05826 # if 0
05827 io_item_must_flatten = TRUE;
05828
05829 if (ATP_INTRIN_ENUM(*spec_idx) == Fetch_And_Add_Intrinsic) {
05830 IR_OPR(ir_idx) = Fetch_And_Add_Opr;
05831 }
05832 else if (ATP_INTRIN_ENUM(*spec_idx) == Fetch_And_And_Intrinsic) {
05833 IR_OPR(ir_idx) = Fetch_And_And_Opr;
05834 }
05835 else if (ATP_INTRIN_ENUM(*spec_idx) == Fetch_And_Nand_Intrinsic) {
05836 IR_OPR(ir_idx) = Fetch_And_Nand_Opr;
05837 }
05838 else if (ATP_INTRIN_ENUM(*spec_idx) == Fetch_And_Or_Intrinsic) {
05839 IR_OPR(ir_idx) = Fetch_And_Or_Opr;
05840 }
05841 else if (ATP_INTRIN_ENUM(*spec_idx) == Fetch_And_Xor_Intrinsic) {
05842 IR_OPR(ir_idx) = Fetch_And_Xor_Opr;
05843 }
05844 else if (ATP_INTRIN_ENUM(*spec_idx) == Fetch_And_Sub_Intrinsic) {
05845 IR_OPR(ir_idx) = Fetch_And_Sub_Opr;
05846 }
05847 else if (ATP_INTRIN_ENUM(*spec_idx) == Add_And_Fetch_Intrinsic) {
05848 IR_OPR(ir_idx) = Add_And_Fetch_Opr;
05849 }
05850 else if (ATP_INTRIN_ENUM(*spec_idx) == And_And_Fetch_Intrinsic) {
05851 IR_OPR(ir_idx) = And_And_Fetch_Opr;
05852 }
05853 else if (ATP_INTRIN_ENUM(*spec_idx) == Nand_And_Fetch_Intrinsic) {
05854 IR_OPR(ir_idx) = Nand_And_Fetch_Opr;
05855 }
05856 else if (ATP_INTRIN_ENUM(*spec_idx) == Or_And_Fetch_Intrinsic) {
05857 IR_OPR(ir_idx) = Or_And_Fetch_Opr;
05858 }
05859 else if (ATP_INTRIN_ENUM(*spec_idx) == Sub_And_Fetch_Intrinsic) {
05860 IR_OPR(ir_idx) = Sub_And_Fetch_Opr;
05861 }
05862 else if (ATP_INTRIN_ENUM(*spec_idx) == Xor_And_Fetch_Intrinsic) {
05863 IR_OPR(ir_idx) = Xor_And_Fetch_Opr;
05864 }
05865 else if (ATP_INTRIN_ENUM(*spec_idx) == Lock_Test_And_Set_Intrinsic) {
05866 IR_OPR(ir_idx) = Lock_Test_And_Set_Opr;
05867 }
05868
05869 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05870 IR_OPND_R(ir_idx) = null_opnd;
05871
05872
05873
05874 # endif
05875
05876 res_exp_desc->foldable = FALSE;
05877 res_exp_desc->will_fold_later = FALSE;
05878
05879 TRACE (Func_Exit, "fetch_and_add_intrinsic", NULL);
05880
05881 }
05882
05883
05884
05885
05886
05887
05888
05889
05890
05891
05892
05893
05894
05895
05896
05897
05898
05899
05900
05901 void numarg_intrinsic(opnd_type *result_opnd,
05902 expr_arg_type *res_exp_desc,
05903 int *spec_idx)
05904 {
05905 int ir_idx;
05906
05907
05908 TRACE (Func_Entry, "numarg_intrinsic", NULL);
05909
05910 ir_idx = OPND_IDX((*result_opnd));
05911 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
05912
05913 conform_check(0,
05914 ir_idx,
05915 res_exp_desc,
05916 spec_idx,
05917 FALSE);
05918
05919 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05920 IR_RANK(ir_idx) = res_exp_desc->rank;
05921
05922 # if 0
05923
05924 IR_OPR(ir_idx) = Numarg_Opr;
05925
05926 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
05927 IR_OPND_R(ir_idx) = null_opnd;
05928
05929 # endif
05930
05931
05932
05933
05934 res_exp_desc->foldable = FALSE;
05935 res_exp_desc->will_fold_later = FALSE;
05936
05937 TRACE (Func_Exit, "numarg_intrinsic", NULL);
05938
05939 }
05940
05941
05942
05943
05944
05945
05946
05947
05948
05949
05950
05951
05952
05953
05954
05955
05956
05957
05958
05959 void readsm_intrinsic(opnd_type *result_opnd,
05960 expr_arg_type *res_exp_desc,
05961 int *spec_idx)
05962 {
05963 int ir_idx;
05964
05965 TRACE (Func_Entry, "readsm_intrinsic", NULL);
05966
05967 ir_idx = OPND_IDX((*result_opnd));
05968 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
05969
05970 conform_check(0,
05971 ir_idx,
05972 res_exp_desc,
05973 spec_idx,
05974 FALSE);
05975
05976 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
05977 IR_RANK(ir_idx) = res_exp_desc->rank;
05978
05979 # if 0
05980
05981 IR_OPR(ir_idx) = Readsm_Opr;
05982
05983 IR_OPND_L(ir_idx) = null_opnd;
05984 IR_OPND_R(ir_idx) = null_opnd;
05985
05986 # endif
05987
05988
05989
05990
05991 res_exp_desc->foldable = FALSE;
05992 res_exp_desc->will_fold_later = FALSE;
05993
05994
05995 TRACE (Func_Exit, "readsm_intrinsic", NULL);
05996
05997 }
05998
05999
06000
06001
06002
06003
06004
06005
06006
06007
06008
06009
06010
06011
06012
06013
06014
06015
06016
06017 void memory_barrier_intrinsic(opnd_type *result_opnd,
06018 expr_arg_type *res_exp_desc,
06019 int *spec_idx)
06020 {
06021 int ir_idx;
06022
06023
06024 TRACE (Func_Entry, "memory_barrier_intrinsic", NULL);
06025
06026 ir_idx = OPND_IDX((*result_opnd));
06027
06028 conform_check(0,
06029 ir_idx,
06030 res_exp_desc,
06031 spec_idx,
06032 FALSE);
06033
06034 IR_RANK(ir_idx) = res_exp_desc->rank;
06035 IR_OPR(ir_idx) = Memory_Barrier_Opr;
06036
06037 # if 0
06038
06039 IR_OPND_L(ir_idx) = null_opnd;
06040 IR_OPND_R(ir_idx) = null_opnd;
06041
06042
06043
06044
06045 #endif
06046
06047 res_exp_desc->foldable = FALSE;
06048 res_exp_desc->will_fold_later = FALSE;
06049
06050 TRACE (Func_Exit, "memory_barrier_intrinsic", NULL);
06051
06052 }
06053
06054
06055
06056
06057
06058
06059
06060
06061
06062
06063
06064
06065
06066
06067
06068
06069
06070
06071
06072 void remote_write_barrier_intrinsic(opnd_type *result_opnd,
06073 expr_arg_type *res_exp_desc,
06074 int *spec_idx)
06075 {
06076 int ir_idx;
06077
06078
06079 TRACE (Func_Entry, "remote_write_barrier_intrinsic", NULL);
06080
06081 ir_idx = OPND_IDX((*result_opnd));
06082
06083 conform_check(0,
06084 ir_idx,
06085 res_exp_desc,
06086 spec_idx,
06087 FALSE);
06088
06089 IR_RANK(ir_idx) = res_exp_desc->rank;
06090
06091 # if 0
06092
06093 IR_OPR(ir_idx) = Remote_Write_Barrier_Opr;
06094
06095 IR_OPND_L(ir_idx) = null_opnd;
06096 IR_OPND_R(ir_idx) = null_opnd;
06097
06098
06099
06100
06101 # endif
06102
06103 res_exp_desc->foldable = FALSE;
06104 res_exp_desc->will_fold_later = FALSE;
06105
06106
06107 TRACE (Func_Exit, "remote_write_barrier_intrinsic", NULL);
06108
06109 }
06110
06111
06112
06113
06114
06115
06116
06117
06118
06119
06120
06121
06122
06123
06124
06125
06126
06127 void write_memory_barrier_intrinsic(opnd_type *result_opnd,
06128 expr_arg_type *res_exp_desc,
06129 int *spec_idx)
06130 {
06131 int ir_idx;
06132
06133
06134 TRACE (Func_Entry, "write_memory_barrier_intrinsic", NULL);
06135
06136 ir_idx = OPND_IDX((*result_opnd));
06137
06138 conform_check(0,
06139 ir_idx,
06140 res_exp_desc,
06141 spec_idx,
06142 FALSE);
06143
06144 IR_RANK(ir_idx) = res_exp_desc->rank;
06145
06146 # if 0
06147
06148 IR_OPR(ir_idx) = Write_Memory_Barrier_Opr;
06149
06150 IR_OPND_L(ir_idx) = null_opnd;
06151 IR_OPND_R(ir_idx) = null_opnd;
06152
06153
06154
06155
06156 # endif
06157
06158 res_exp_desc->foldable = FALSE;
06159 res_exp_desc->will_fold_later = FALSE;
06160
06161 TRACE (Func_Exit, "write_memory_barrier_intrinsic", NULL);
06162
06163 }
06164
06165
06166
06167
06168
06169
06170
06171
06172
06173
06174
06175
06176
06177
06178
06179
06180 void synchronize_intrinsic(opnd_type *result_opnd,
06181 expr_arg_type *res_exp_desc,
06182 int *spec_idx)
06183 {
06184 int ir_idx;
06185
06186
06187 TRACE (Func_Entry, "synchronize_intrinsic", NULL);
06188
06189 ir_idx = OPND_IDX((*result_opnd));
06190
06191 conform_check(0,
06192 ir_idx,
06193 res_exp_desc,
06194 spec_idx,
06195 FALSE);
06196
06197 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
06198 IR_RANK(ir_idx) = res_exp_desc->rank;
06199
06200 # if 0
06201
06202 IR_OPR(ir_idx) = Synchronize_Opr;
06203
06204 IR_OPND_L(ir_idx) = null_opnd;
06205 IR_OPND_R(ir_idx) = null_opnd;
06206
06207 io_item_must_flatten = TRUE;
06208
06209
06210
06211
06212 # endif
06213
06214 res_exp_desc->foldable = FALSE;
06215 res_exp_desc->will_fold_later = FALSE;
06216
06217 TRACE (Func_Exit, "synchronize_intrinsic", NULL);
06218
06219 }
06220
06221
06222
06223
06224
06225
06226
06227
06228
06229
06230
06231
06232
06233
06234
06235
06236
06237
06238
06239
06240
06241 void rtc_intrinsic(opnd_type *result_opnd,
06242 expr_arg_type *res_exp_desc,
06243 int *spec_idx)
06244 {
06245 int ir_idx;
06246
06247
06248 TRACE (Func_Entry, "rtc_intrinsic", NULL);
06249
06250 ir_idx = OPND_IDX((*result_opnd));
06251 if (ATP_INTRIN_ENUM(*spec_idx) == Irtc_Intrinsic) {
06252 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
06253 }
06254 else {
06255 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Real_8;
06256 }
06257
06258 conform_check(0,
06259 ir_idx,
06260 res_exp_desc,
06261 spec_idx,
06262 FALSE);
06263
06264 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06265 IR_RANK(ir_idx) = res_exp_desc->rank;
06266
06267 # if 0
06268
06269 IR_OPR(ir_idx) = Rtc_Opr;
06270
06271 IR_OPND_L(ir_idx) = null_opnd;
06272 IR_OPND_R(ir_idx) = null_opnd;
06273
06274 # endif
06275
06276
06277
06278
06279 res_exp_desc->foldable = FALSE;
06280 res_exp_desc->will_fold_later = FALSE;
06281
06282 TRACE (Func_Exit, "rtc_intrinsic", NULL);
06283
06284 }
06285
06286
06287
06288
06289
06290
06291
06292
06293
06294
06295
06296
06297
06298
06299
06300
06301
06302
06303 void my_pe_intrinsic(opnd_type *result_opnd,
06304 expr_arg_type *res_exp_desc,
06305 int *spec_idx)
06306 {
06307 int ir_idx;
06308
06309
06310 TRACE (Func_Entry, "my_pe_intrinsic", NULL);
06311
06312 ir_idx = OPND_IDX((*result_opnd));
06313 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
06314
06315 conform_check(0,
06316 ir_idx,
06317 res_exp_desc,
06318 spec_idx,
06319 FALSE);
06320
06321 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06322 IR_RANK(ir_idx) = res_exp_desc->rank;
06323
06324 # if 0
06325
06326 IR_OPR(ir_idx) = My_Pe_Opr;
06327
06328 IR_OPND_L(ir_idx) = null_opnd;
06329 IR_OPND_R(ir_idx) = null_opnd;
06330
06331 # endif
06332
06333
06334
06335
06336 res_exp_desc->foldable = FALSE;
06337 res_exp_desc->will_fold_later = FALSE;
06338
06339
06340
06341
06342
06343
06344
06345
06346 TRACE (Func_Exit, "my_pe_intrinsic", NULL);
06347
06348 }
06349
06350
06351
06352
06353
06354
06355
06356
06357
06358
06359
06360
06361
06362
06363
06364
06365
06366
06367
06368
06369
06370 void cvmgp_intrinsic(opnd_type *result_opnd,
06371 expr_arg_type *res_exp_desc,
06372 int *spec_idx)
06373 {
06374 int column;
06375 int info_idx1;
06376 int info_idx2;
06377 int info_idx3;
06378 int ir_idx;
06379 int line;
06380 int list_idx1;
06381 int list_idx2;
06382 int list_idx3;
06383 int new_idx;
06384 operator_type opr1;
06385 int type_idx;
06386
06387
06388 TRACE (Func_Entry, "cvmgp_intrinsic", NULL);
06389
06390 ir_idx = OPND_IDX((*result_opnd));
06391 list_idx1 = IR_IDX_R(ir_idx);
06392 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
06393 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
06394 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
06395 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
06396 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
06397
06398 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
06399 (arg_info_list[info_idx1].ed.linear_type == Short_Typeless_Const ||
06400 arg_info_list[info_idx1].ed.linear_type == Short_Char_Const)) {
06401
06402 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx1),
06403 &line,
06404 &column);
06405
06406 type_idx = arg_info_list[info_idx2].ed.type_idx;
06407
06408 if (arg_info_list[info_idx2].ed.type == Character ||
06409 arg_info_list[info_idx2].ed.type == Typeless) {
06410 type_idx = INTEGER_DEFAULT_TYPE;
06411 }
06412
06413 IL_IDX(list_idx1) = cast_typeless_constant(IL_IDX(list_idx1),
06414 type_idx,
06415 line,
06416 column);
06417
06418 arg_info_list[info_idx1].ed.type_idx = type_idx;
06419 arg_info_list[info_idx1].ed.type = TYP_TYPE(type_idx);
06420 arg_info_list[info_idx1].ed.linear_type = TYP_LINEAR(type_idx);
06421 }
06422
06423
06424 if (IL_FLD(list_idx2) == CN_Tbl_Idx &&
06425 (arg_info_list[info_idx2].ed.linear_type == Short_Typeless_Const ||
06426 arg_info_list[info_idx2].ed.linear_type == Short_Char_Const)) {
06427
06428 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx2),
06429 &line,
06430 &column);
06431
06432 type_idx = arg_info_list[info_idx1].ed.type_idx;
06433
06434 if (arg_info_list[info_idx1].ed.type == Character ||
06435 arg_info_list[info_idx1].ed.type == Typeless) {
06436 type_idx = INTEGER_DEFAULT_TYPE;
06437 }
06438
06439 IL_IDX(list_idx2) = cast_typeless_constant(IL_IDX(list_idx2),
06440 type_idx,
06441 line,
06442 column);
06443
06444 arg_info_list[info_idx2].ed.type_idx = type_idx;
06445 arg_info_list[info_idx2].ed.type = TYP_TYPE(type_idx);
06446 arg_info_list[info_idx2].ed.linear_type = TYP_LINEAR(type_idx);
06447 }
06448
06449 if (IL_FLD(list_idx3) == CN_Tbl_Idx &&
06450 (arg_info_list[info_idx3].ed.linear_type == Short_Typeless_Const ||
06451 arg_info_list[info_idx3].ed.linear_type == Short_Char_Const)) {
06452
06453 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx3),
06454 &line,
06455 &column);
06456
06457 type_idx = INTEGER_DEFAULT_TYPE;
06458
06459 IL_IDX(list_idx3) = cast_typeless_constant(IL_IDX(list_idx3),
06460 type_idx,
06461 line,
06462 column);
06463
06464 arg_info_list[info_idx3].ed.type_idx = type_idx;
06465 arg_info_list[info_idx3].ed.type = TYP_TYPE(type_idx);
06466 arg_info_list[info_idx3].ed.linear_type = TYP_LINEAR(type_idx);
06467 }
06468
06469
06470
06471 if (arg_info_list[info_idx1].ed.type == Logical) {
06472 type_idx = LOGICAL_DEFAULT_TYPE;
06473 # if defined(GENERATE_WHIRL)
06474 if (arg_info_list[info_idx1].ed.type == Logical) {
06475 type_idx = arg_info_list[info_idx1].ed.linear_type;
06476 }
06477 # endif
06478 }
06479 else {
06480 type_idx = TYPELESS_DEFAULT_TYPE;
06481 # if defined(GENERATE_WHIRL)
06482 type_idx = INTEGER_DEFAULT_TYPE;
06483 if (arg_info_list[info_idx1].ed.type == Integer) {
06484 type_idx = arg_info_list[info_idx1].ed.linear_type;
06485 }
06486 # endif
06487
06488
06489 # ifdef _TARGET32
06490 if ((arg_info_list[info_idx1].ed.linear_type == Integer_8) ||
06491 (arg_info_list[info_idx1].ed.linear_type == Typeless_8) ||
06492 (arg_info_list[info_idx1].ed.linear_type == Real_8) ||
06493 (arg_info_list[info_idx2].ed.linear_type == Integer_8) ||
06494 (arg_info_list[info_idx2].ed.linear_type == Typeless_8) ||
06495 (arg_info_list[info_idx2].ed.linear_type == Real_8)) {
06496 type_idx = Typeless_8;
06497 # if defined(GENERATE_WHIRL)
06498 type_idx = Integer_8;
06499 # endif
06500 }
06501
06502 if (arg_info_list[info_idx1].ed.type == Real &&
06503 arg_info_list[info_idx2].ed.type == Real) {
06504 # if defined(GENERATE_WHIRL)
06505 type_idx = arg_info_list[info_idx1].ed.linear_type;
06506 # endif
06507 }
06508
06509 # endif
06510 }
06511
06512 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
06513
06514 conform_check(0,
06515 ir_idx,
06516 res_exp_desc,
06517 spec_idx,
06518 FALSE);
06519
06520
06521 switch (ATP_INTRIN_ENUM(*spec_idx)) {
06522 case Cvmgp_Intrinsic:
06523 opr1 = Ge_Opr;
06524 break;
06525
06526 case Cvmgm_Intrinsic:
06527 opr1 = Lt_Opr;
06528 break;
06529
06530 case Cvmgz_Intrinsic:
06531 opr1 = Eq_Opr;
06532 break;
06533
06534 case Cvmgn_Intrinsic:
06535 opr1 = Ne_Opr;
06536 break;
06537 }
06538
06539 # if 0
06540
06541 if (ATP_INTRIN_ENUM(*spec_idx) != Cvmgt_Intrinsic) {
06542
06543 new_idx = gen_ir(IL_FLD(list_idx3), IL_IDX(list_idx3),
06544 opr1, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
06545 IR_COL_NUM(ir_idx),
06546 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
06547
06548 IL_FLD(list_idx3) = IR_Tbl_Idx;
06549 IL_IDX(list_idx3) = new_idx;
06550 }
06551
06552 # endif
06553
06554 IR_TYPE_IDX(ir_idx) = type_idx;
06555 IR_RANK(ir_idx) = res_exp_desc->rank;
06556
06557
06558
06559
06560
06561
06562 if (storage_bit_size_tbl[arg_info_list[info_idx1].ed.linear_type] !=
06563 storage_bit_size_tbl[arg_info_list[info_idx2].ed.linear_type]) {
06564 PRINTMSG(IR_LINE_NUM(ir_idx), 1188, Error,
06565 IR_COL_NUM(ir_idx));
06566 }
06567
06568
06569
06570
06571 res_exp_desc->foldable = FALSE;
06572 res_exp_desc->will_fold_later = FALSE;
06573
06574 TRACE (Func_Exit, "cvmgp_intrinsic", NULL);
06575
06576 }
06577
06578
06579
06580
06581
06582
06583
06584
06585
06586
06587
06588
06589
06590
06591
06592
06593
06594
06595 void compare_and_swap_intrinsic(opnd_type *result_opnd,
06596 expr_arg_type *res_exp_desc,
06597 int *spec_idx)
06598 {
06599 int ir_idx;
06600
06601
06602 TRACE (Func_Entry, "compare_and_swap_intrinsic", NULL);
06603
06604 ir_idx = OPND_IDX((*result_opnd));
06605
06606 conform_check(0, ir_idx,
06607 res_exp_desc,
06608 spec_idx,
06609 FALSE);
06610
06611 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06612 IR_RANK(ir_idx) = res_exp_desc->rank;
06613
06614 # if 0
06615
06616 IR_OPR(ir_idx) = Compare_And_Swap_Opr;
06617 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
06618 IR_OPND_R(ir_idx) = null_opnd;
06619
06620 io_item_must_flatten = TRUE;
06621
06622 # endif
06623
06624
06625
06626
06627 res_exp_desc->foldable = FALSE;
06628 res_exp_desc->will_fold_later = FALSE;
06629
06630 TRACE (Func_Exit, "compare_and_swap_intrinsic", NULL);
06631
06632 }
06633
06634
06635
06636
06637
06638
06639
06640
06641
06642
06643
06644
06645
06646
06647
06648
06649
06650
06651 void csmg_intrinsic(opnd_type *result_opnd,
06652 expr_arg_type *res_exp_desc,
06653 int *spec_idx)
06654 {
06655 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
06656 int info_idx1;
06657 int info_idx2;
06658 int info_idx3;
06659 int ir_idx;
06660 int line;
06661 int column;
06662 int list_idx1;
06663 int list_idx2;
06664 int list_idx3;
06665 int type_idx;
06666
06667
06668 TRACE (Func_Entry, "csmg_intrinsic", NULL);
06669
06670 ir_idx = OPND_IDX((*result_opnd));
06671
06672 list_idx1 = IR_IDX_R(ir_idx);
06673 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
06674 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
06675 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
06676 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
06677 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
06678
06679 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
06680 (arg_info_list[info_idx1].ed.linear_type == Short_Typeless_Const ||
06681 arg_info_list[info_idx1].ed.linear_type == Short_Char_Const)) {
06682
06683 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx1),
06684 &line,
06685 &column);
06686
06687 type_idx = arg_info_list[info_idx2].ed.type_idx;
06688
06689 if (arg_info_list[info_idx2].ed.type == Character ||
06690 arg_info_list[info_idx2].ed.type == Typeless) {
06691 type_idx = INTEGER_DEFAULT_TYPE;
06692 }
06693
06694 IL_IDX(list_idx1) = cast_typeless_constant(IL_IDX(list_idx1),
06695 type_idx,
06696 line,
06697 column);
06698
06699 arg_info_list[info_idx1].ed.type_idx = type_idx;
06700 arg_info_list[info_idx1].ed.type = TYP_TYPE(type_idx);
06701 arg_info_list[info_idx1].ed.linear_type = TYP_LINEAR(type_idx);
06702 }
06703
06704 if (IL_FLD(list_idx2) == CN_Tbl_Idx &&
06705 (arg_info_list[info_idx2].ed.linear_type == Short_Typeless_Const ||
06706 arg_info_list[info_idx2].ed.linear_type == Short_Char_Const)) {
06707
06708 find_opnd_line_and_column((opnd_type *)&IL_OPND(list_idx2),
06709 &line,
06710 &column);
06711
06712 type_idx = arg_info_list[info_idx1].ed.type_idx;
06713
06714 if (arg_info_list[info_idx1].ed.type == Character ||
06715 arg_info_list[info_idx1].ed.type == Typeless) {
06716 type_idx = INTEGER_DEFAULT_TYPE;
06717 }
06718
06719 IL_IDX(list_idx2) = cast_typeless_constant(IL_IDX(list_idx2),
06720 type_idx,
06721 line,
06722 column);
06723
06724 arg_info_list[info_idx2].ed.type_idx = type_idx;
06725 arg_info_list[info_idx2].ed.type = TYP_TYPE(type_idx);
06726 arg_info_list[info_idx2].ed.linear_type = TYP_LINEAR(type_idx);
06727 }
06728
06729
06730
06731 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = TYPELESS_DEFAULT_TYPE;
06732 # if defined(GENERATE_WHIRL)
06733 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
06734 if (arg_info_list[info_idx1].ed.type == Integer) {
06735 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
06736 arg_info_list[info_idx1].ed.linear_type;
06737 }
06738 # endif
06739
06740
06741 # ifdef _TARGET32
06742 if ((arg_info_list[info_idx1].ed.linear_type == Integer_8) ||
06743 (arg_info_list[info_idx1].ed.linear_type == Typeless_8) ||
06744 (arg_info_list[info_idx1].ed.linear_type == Real_8) ||
06745 (arg_info_list[info_idx2].ed.linear_type == Integer_8) ||
06746 (arg_info_list[info_idx2].ed.linear_type == Typeless_8) ||
06747 (arg_info_list[info_idx2].ed.linear_type == Real_8) ||
06748 (arg_info_list[info_idx3].ed.linear_type == Integer_8) ||
06749 (arg_info_list[info_idx3].ed.linear_type == Typeless_8) ||
06750 (arg_info_list[info_idx3].ed.linear_type == Real_8)) {
06751 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Typeless_8;
06752 # if defined(GENERATE_WHIRL)
06753 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
06754 # endif
06755 }
06756 # endif
06757
06758 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06759
06760 conform_check(0,
06761 ir_idx,
06762 res_exp_desc,
06763 spec_idx,
06764 FALSE);
06765
06766 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
06767 IR_RANK(ir_idx) = res_exp_desc->rank;
06768
06769 # if 0
06770
06771 res_exp_desc->type_idx = type_idx;
06772 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
06773
06774 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
06775 IL_FLD(list_idx2) == CN_Tbl_Idx &&
06776 IL_FLD(list_idx3) == CN_Tbl_Idx &&
06777 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
06778 arg_info_list[info_idx1].ed.type_idx,
06779 (char *)&CN_CONST(IL_IDX(list_idx2)),
06780 arg_info_list[info_idx2].ed.type_idx,
06781 folded_const,
06782 &type_idx,
06783 IR_LINE_NUM(ir_idx),
06784 IR_COL_NUM(ir_idx),
06785 3,
06786 Csmg_Opr,
06787 (char *)&CN_CONST(IL_IDX(list_idx3)),
06788 (long)arg_info_list[info_idx3].ed.type_idx)) {
06789 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
06790 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
06791 FALSE,
06792 folded_const);
06793 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
06794 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
06795 res_exp_desc->constant = TRUE;
06796 res_exp_desc->foldable = TRUE;
06797 }
06798 else {
06799 IR_OPR(ir_idx) = Csmg_Opr;
06800 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
06801 IR_OPND_R(ir_idx) = null_opnd;
06802 }
06803 # endif
06804
06805 res_exp_desc->foldable = FALSE;
06806 res_exp_desc->will_fold_later = FALSE;
06807
06808 TRACE (Func_Exit, "csmg_intrinsic", NULL);
06809
06810 }
06811
06812
06813
06814
06815
06816
06817
06818
06819
06820
06821
06822
06823
06824
06825
06826
06827
06828 void mergee_intrinsic(opnd_type *result_opnd,
06829 expr_arg_type *res_exp_desc,
06830 int *spec_idx)
06831 {
06832 int list_idx1;
06833 int list_idx2;
06834 int info_idx1;
06835 int info_idx2;
06836 int ir_idx;
06837 int type_idx;
06838 int type_idx2;
06839 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
06840
06841
06842 TRACE (Func_Entry, "mergee_intrinsic", NULL);
06843
06844 ir_idx = OPND_IDX((*result_opnd));
06845 list_idx1 = IR_IDX_R(ir_idx);
06846 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
06847 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
06848 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
06849 type_idx = arg_info_list[info_idx1].ed.type_idx;
06850 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
06851
06852 if (arg_info_list[info_idx1].ed.linear_type !=
06853 arg_info_list[info_idx2].ed.linear_type) {
06854
06855 if (arg_info_list[info_idx1].ed.type == Character &&
06856 arg_info_list[info_idx2].ed.type == Character) {
06857
06858 }
06859 else {
06860 PRINTMSG(arg_info_list[info_idx2].line, 774, Error,
06861 arg_info_list[info_idx2].col);
06862 }
06863 }
06864
06865 type_idx2 = CG_LOGICAL_DEFAULT_TYPE;
06866
06867
06868 if (arg_info_list[info_idx1].ed.type == Character &&
06869 arg_info_list[info_idx2].ed.type == Character &&
06870 arg_info_list[info_idx2].ed.char_len.fld == CN_Tbl_Idx &&
06871 arg_info_list[info_idx1].ed.char_len.fld == CN_Tbl_Idx &&
06872 folder_driver(
06873 (char *)&CN_CONST(arg_info_list[info_idx2].ed.char_len.idx),
06874 arg_info_list[info_idx2].ed.type_idx,
06875 (char *)&CN_CONST(arg_info_list[info_idx1].ed.char_len.idx),
06876 arg_info_list[info_idx1].ed.type_idx,
06877 folded_const,
06878 &type_idx2,
06879 IR_LINE_NUM(ir_idx),
06880 IR_COL_NUM(ir_idx),
06881 2,
06882 Ne_Opr)) {
06883
06884 if (THIS_IS_TRUE(folded_const, type_idx2)) {
06885 PRINTMSG(arg_info_list[info_idx2].line, 774, Error,
06886 arg_info_list[info_idx2].col);
06887 }
06888 }
06889
06890 conform_check(0,
06891 ir_idx,
06892 res_exp_desc,
06893 spec_idx,
06894 FALSE);
06895
06896
06897 IR_TYPE_IDX(ir_idx) = type_idx;
06898 IR_RANK(ir_idx) = res_exp_desc->rank;
06899
06900 # if 0
06901
06902 if (TYP_TYPE(type_idx) == Character) {
06903 COPY_OPND((res_exp_desc->char_len),
06904 (arg_info_list[info_idx1].ed.char_len));
06905 }
06906
06907 IR_OPR(ir_idx) = Cvmgt_Opr;
06908 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
06909 IR_OPND_R(ir_idx) = null_opnd;
06910
06911
06912 io_item_must_flatten = TRUE;
06913
06914 # endif
06915
06916 res_exp_desc->foldable = FALSE;
06917 res_exp_desc->will_fold_later = FALSE;
06918
06919
06920
06921 TRACE (Func_Exit, "mergee_intrinsic", NULL);
06922
06923 }
06924
06925
06926
06927
06928
06929
06930
06931
06932
06933
06934
06935
06936
06937
06938
06939
06940
06941
06942
06943 void adjustl_intrinsic(opnd_type *result_opnd,
06944 expr_arg_type *res_exp_desc,
06945 int *spec_idx)
06946 {
06947 expr_arg_type exp_desc;
06948 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
06949 int info_idx1;
06950 int ir_idx;
06951 opnd_type l_opnd;
06952 int list_idx1;
06953 int new_idx;
06954 boolean ok;
06955 operator_type opr;
06956 opnd_type opnd;
06957 opnd_type opnd2;
06958 int unused;
06959 int type_idx;
06960
06961
06962 TRACE (Func_Entry, "adjustl_intrinsic", NULL);
06963
06964 ir_idx = OPND_IDX((*result_opnd));
06965 list_idx1 = IR_IDX_R(ir_idx);
06966 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
06967 type_idx = arg_info_list[info_idx1].ed.type_idx;
06968 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
06969
06970 conform_check(0,
06971 ir_idx,
06972 res_exp_desc,
06973 spec_idx,
06974 FALSE);
06975
06976
06977 COPY_OPND(res_exp_desc->char_len, arg_info_list[info_idx1].ed.char_len);
06978 res_exp_desc->type_idx = type_idx;
06979 # if 0
06980 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
06981 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
06982 if (ATP_INTRIN_ENUM(*spec_idx) == Adjustl_Intrinsic) {
06983 opr = Adjustl_Opr;
06984 }
06985 else {
06986 opr = Adjustr_Opr;
06987 }
06988
06989 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
06990 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
06991 arg_info_list[info_idx1].ed.type_idx,
06992 NULL,
06993 NULL_IDX,
06994 folded_const,
06995 &type_idx,
06996 IR_LINE_NUM(ir_idx),
06997 IR_COL_NUM(ir_idx),
06998 1,
06999 opr)) {
07000 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
07001 OPND_IDX((*result_opnd)) = folded_const[0];
07002 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
07003 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
07004 IR_TYPE_IDX(ir_idx) = type_idx;
07005 res_exp_desc->constant = TRUE;
07006 res_exp_desc->foldable = TRUE;
07007 }
07008 else {
07009 io_item_must_flatten = TRUE;
07010 COPY_OPND(opnd2, IR_OPND_R(ir_idx));
07011 ok = final_arg_work(&opnd2,
07012 IR_IDX_L(ir_idx),
07013 IR_LIST_CNT_R(ir_idx),
07014 NULL);
07015 COPY_OPND(IR_OPND_R(ir_idx), opnd2);
07016
07017 new_idx = gen_ir(IR_FLD_R(ir_idx), IR_IDX_R(ir_idx),
07018 opr, res_exp_desc->type_idx,
07019 IR_LINE_NUM(ir_idx), IR_COL_NUM(ir_idx),
07020 NO_Tbl_Idx, NULL_IDX);
07021
07022 OPND_FLD(opnd) = IR_Tbl_Idx;
07023 OPND_IDX(opnd) = new_idx;
07024
07025 if (IL_FLD(list_idx1) == IR_Tbl_Idx &&
07026 IR_OPR(IL_IDX(list_idx1)) == Aloc_Opr) {
07027 COPY_OPND(IL_OPND(list_idx1), IR_OPND_L(IL_IDX(list_idx1)));
07028 }
07029
07030 if (IL_FLD(list_idx1) == AT_Tbl_Idx &&
07031 AT_OBJ_CLASS(IL_IDX(list_idx1)) == Data_Obj &&
07032 ATD_ARRAY_IDX(IL_IDX(list_idx1)) != NULL_IDX) {
07033 COPY_OPND(opnd2, IL_OPND(list_idx1));
07034 ok = gen_whole_subscript(&opnd2, &exp_desc);
07035 COPY_OPND(IL_OPND(list_idx1), opnd2);
07036 }
07037
07038 unused = create_tmp_asg(&opnd,
07039 res_exp_desc,
07040 &l_opnd,
07041 Intent_In,
07042 TRUE,
07043 FALSE);
07044
07045 COPY_OPND((*result_opnd), l_opnd);
07046
07047
07048
07049
07050 res_exp_desc->foldable = FALSE;
07051 res_exp_desc->will_fold_later = FALSE;
07052 }
07053 # endif
07054
07055 res_exp_desc->foldable = FALSE;
07056 res_exp_desc->will_fold_later = FALSE;
07057
07058
07059 TRACE (Func_Exit, "adjustl_intrinsic", NULL);
07060
07061 }
07062
07063
07064
07065
07066
07067
07068
07069
07070
07071
07072
07073
07074
07075
07076
07077
07078
07079
07080 void ceiling_intrinsic(opnd_type *result_opnd,
07081 expr_arg_type *res_exp_desc,
07082 int *spec_idx)
07083 {
07084 int info_idx2;
07085 int ir_idx;
07086 int list_idx1;
07087 int list_idx2;
07088
07089
07090 TRACE (Func_Entry, "ceiling_intrinsic", NULL);
07091
07092 ir_idx = OPND_IDX((*result_opnd));
07093 list_idx1 = IR_IDX_R(ir_idx);
07094 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
07095 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
07096
07097 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
07098 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
07099 kind_to_linear_type(&((IL_OPND(list_idx2))),
07100 ATP_RSLT_IDX(*spec_idx),
07101 arg_info_list[info_idx2].ed.kind0seen,
07102 arg_info_list[info_idx2].ed.kind0E0seen,
07103 arg_info_list[info_idx2].ed.kind0D0seen,
07104 ! arg_info_list[info_idx2].ed.kindnotconst);
07105 }
07106
07107 conform_check(0,
07108 ir_idx,
07109 res_exp_desc,
07110 spec_idx,
07111 FALSE);
07112
07113
07114 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07115 IR_RANK(ir_idx) = res_exp_desc->rank;
07116
07117 IR_OPR(ir_idx) = Ceiling_Opr;
07118
07119 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
07120 IR_OPND_R(ir_idx) = null_opnd;
07121 IR_LIST_CNT_L(ir_idx) = 1;
07122 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
07123
07124
07125
07126
07127
07128 res_exp_desc->foldable = FALSE;
07129 res_exp_desc->will_fold_later = FALSE;
07130
07131 TRACE (Func_Exit, "ceiling_intrinsic", NULL);
07132
07133 }
07134
07135
07136
07137
07138
07139
07140
07141
07142
07143
07144
07145
07146
07147
07148
07149
07150
07151
07152 void digits_intrinsic(opnd_type *result_opnd,
07153 expr_arg_type *res_exp_desc,
07154 int *spec_idx)
07155 {
07156 int cn_idx;
07157 long num;
07158 int info_idx1;
07159 int ir_idx;
07160
07161
07162 TRACE (Func_Entry, "digits_intrinsic", NULL);
07163
07164 ir_idx = OPND_IDX((*result_opnd));
07165 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
07166 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
07167
07168 conform_check(0,
07169 ir_idx,
07170 res_exp_desc,
07171 spec_idx,
07172 TRUE);
07173
07174 res_exp_desc->rank = 0;
07175 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07176 IR_RANK(ir_idx) = res_exp_desc->rank;
07177
07178 # if 0
07179
07180 switch (arg_info_list[info_idx1].ed.linear_type) {
07181 case Real_4:
07182 num = DIGITS_REAL4_F90;
07183 break;
07184
07185 case Real_8:
07186 num = DIGITS_REAL8_F90;
07187 break;
07188
07189 case Real_16:
07190 num = DIGITS_REAL16_F90;
07191 break;
07192
07193 case Integer_1:
07194 num = DIGITS_INT1_F90;
07195 break;
07196
07197 case Integer_2:
07198 num = DIGITS_INT2_F90;
07199 break;
07200
07201 case Integer_4:
07202 num = DIGITS_INT4_F90;
07203 break;
07204
07205 case Integer_8:
07206 num = DIGITS_INT8_F90;
07207
07208 # ifdef _TARGET_HAS_FAST_INTEGER
07209 if (opt_flags.set_allfastint_option ||
07210 (opt_flags.set_fastint_option &&
07211 (TYP_DESC(arg_info_list[info_idx1].ed.type_idx) ==
07212 Default_Typed))) {
07213 num = 46;
07214 }
07215 # endif
07216
07217 break;
07218 }
07219
07220 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
07221
07222 OPND_IDX((*result_opnd)) = cn_idx;
07223 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
07224 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
07225 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
07226 res_exp_desc->constant = TRUE;
07227 res_exp_desc->foldable = TRUE;
07228
07229 # endif
07230
07231 res_exp_desc->foldable = FALSE;
07232 res_exp_desc->will_fold_later = FALSE;
07233
07234 TRACE (Func_Exit, "digits_intrinsic", NULL);
07235
07236 }
07237
07238
07239
07240
07241
07242
07243
07244
07245
07246
07247
07248
07249
07250
07251
07252
07253
07254
07255 void epsilon_intrinsic(opnd_type *result_opnd,
07256 expr_arg_type *res_exp_desc,
07257 int *spec_idx)
07258 {
07259 int cn_idx;
07260 int info_idx1;
07261 int ir_idx;
07262
07263
07264 TRACE (Func_Entry, "epsilon_intrinsic", NULL);
07265
07266 ir_idx = OPND_IDX((*result_opnd));
07267 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
07268 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
07269
07270 conform_check(0,
07271 ir_idx,
07272 res_exp_desc,
07273 spec_idx,
07274 TRUE);
07275
07276 res_exp_desc->rank = 0;
07277 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
07278 IR_RANK(ir_idx) = res_exp_desc->rank;
07279
07280 # if 0
07281
07282 switch (arg_info_list[info_idx1].ed.linear_type) {
07283 case Real_4:
07284 cn_idx = cvrt_str_to_cn(EPSILON_REAL4_F90,
07285 arg_info_list[info_idx1].ed.linear_type);
07286 break;
07287
07288 case Real_8:
07289 cn_idx = cvrt_str_to_cn(EPSILON_REAL8_F90,
07290 arg_info_list[info_idx1].ed.linear_type);
07291 break;
07292
07293 case Real_16:
07294 cn_idx = cvrt_str_to_cn(EPSILON_REAL16_F90,
07295 arg_info_list[info_idx1].ed.linear_type);
07296 break;
07297 }
07298
07299
07300 OPND_IDX((*result_opnd)) = cn_idx;
07301 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
07302 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
07303 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
07304 res_exp_desc->constant = TRUE;
07305 res_exp_desc->foldable = TRUE;
07306
07307 # endif
07308 res_exp_desc->foldable = FALSE;
07309 res_exp_desc->will_fold_later = FALSE;
07310
07311 TRACE (Func_Exit, "epsilon_intrinsic", NULL);
07312
07313 }
07314
07315
07316
07317
07318
07319
07320
07321
07322
07323
07324
07325
07326
07327
07328
07329
07330
07331
07332 void exponent_intrinsic(opnd_type *result_opnd,
07333 expr_arg_type *res_exp_desc,
07334 int *spec_idx)
07335 {
07336 int ir_idx;
07337
07338
07339 TRACE (Func_Entry, "exponent_intrinsic", NULL);
07340
07341 ir_idx = OPND_IDX((*result_opnd));
07342 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
07343
07344 conform_check(0,
07345 ir_idx,
07346 res_exp_desc,
07347 spec_idx,
07348 FALSE);
07349
07350 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07351 IR_RANK(ir_idx) = res_exp_desc->rank;
07352
07353 # if 0
07354
07355 IR_OPR(ir_idx) = Exponent_Opr;
07356 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
07357 IR_OPND_R(ir_idx) = null_opnd;
07358
07359 # endif
07360
07361
07362
07363
07364 res_exp_desc->foldable = FALSE;
07365 res_exp_desc->will_fold_later = FALSE;
07366
07367
07368 TRACE (Func_Exit, "exponent_intrinsic", NULL);
07369
07370 }
07371
07372
07373
07374
07375
07376
07377
07378
07379
07380
07381
07382
07383
07384
07385
07386
07387
07388
07389 void floor_intrinsic(opnd_type *result_opnd,
07390 expr_arg_type *res_exp_desc,
07391 int *spec_idx)
07392 {
07393 int info_idx2;
07394 int ir_idx;
07395 int list_idx1;
07396 int list_idx2;
07397
07398
07399 TRACE (Func_Entry, "floor_intrinsic", NULL);
07400
07401 ir_idx = OPND_IDX((*result_opnd));
07402 list_idx1 = IR_IDX_R(ir_idx);
07403 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
07404 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
07405
07406 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
07407 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
07408 kind_to_linear_type(&((IL_OPND(list_idx2))),
07409 ATP_RSLT_IDX(*spec_idx),
07410 arg_info_list[info_idx2].ed.kind0seen,
07411 arg_info_list[info_idx2].ed.kind0E0seen,
07412 arg_info_list[info_idx2].ed.kind0D0seen,
07413 ! arg_info_list[info_idx2].ed.kindnotconst);
07414 }
07415
07416 conform_check(0,
07417 ir_idx,
07418 res_exp_desc,
07419 spec_idx,
07420 FALSE);
07421
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
07426 IR_OPR(ir_idx) = Floor_Opr;
07427
07428 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
07429 IR_OPND_R(ir_idx) = null_opnd;
07430 IR_LIST_CNT_L(ir_idx) = 1;
07431 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
07432
07433
07434
07435
07436 res_exp_desc->foldable = FALSE;
07437 res_exp_desc->will_fold_later = FALSE;
07438
07439
07440 TRACE (Func_Exit, "floor_intrinsic", NULL);
07441
07442 }
07443
07444
07445
07446
07447
07448
07449
07450
07451
07452
07453
07454
07455
07456
07457
07458
07459
07460
07461 void fraction_intrinsic(opnd_type *result_opnd,
07462 expr_arg_type *res_exp_desc,
07463 int *spec_idx)
07464 {
07465 int ir_idx;
07466 int info_idx1;
07467
07468 TRACE (Func_Entry, "fraction_intrinsic", NULL);
07469
07470 ir_idx = OPND_IDX((*result_opnd));
07471 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
07472 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
07473
07474 conform_check(0,
07475 ir_idx,
07476 res_exp_desc,
07477 spec_idx,
07478 FALSE);
07479
07480 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07481 IR_RANK(ir_idx) = res_exp_desc->rank;
07482
07483 # if 0
07484
07485 IR_OPR(ir_idx) = Fraction_Opr;
07486 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
07487 IR_OPND_R(ir_idx) = null_opnd;
07488
07489
07490
07491
07492 # endif
07493
07494 res_exp_desc->foldable = FALSE;
07495 res_exp_desc->will_fold_later = FALSE;
07496
07497 TRACE (Func_Exit, "fraction_intrinsic", NULL);
07498
07499 }
07500
07501
07502
07503
07504
07505
07506
07507
07508
07509
07510
07511
07512
07513
07514
07515
07516
07517
07518 void huge_intrinsic(opnd_type *result_opnd,
07519 expr_arg_type *res_exp_desc,
07520 int *spec_idx)
07521 {
07522 int cn_idx;
07523 int info_idx1;
07524 int ir_idx;
07525
07526
07527 TRACE (Func_Entry, "huge_intrinsic", NULL);
07528
07529 ir_idx = OPND_IDX((*result_opnd));
07530 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
07531 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
07532
07533 conform_check(0,
07534 ir_idx,
07535 res_exp_desc,
07536 spec_idx,
07537 TRUE);
07538 res_exp_desc->rank = 0;
07539 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
07540 IR_RANK(ir_idx) = res_exp_desc->rank;
07541
07542
07543 switch (arg_info_list[info_idx1].ed.linear_type) {
07544 case Real_4:
07545 cn_idx = cvrt_str_to_cn(HUGE_REAL4_F90,
07546 arg_info_list[info_idx1].ed.linear_type);
07547 break;
07548
07549 case Real_8:
07550 cn_idx = cvrt_str_to_cn(HUGE_REAL8_F90,
07551 arg_info_list[info_idx1].ed.linear_type);
07552 break;
07553
07554 case Real_16:
07555 cn_idx = cvrt_str_to_cn(HUGE_REAL16_F90,
07556 arg_info_list[info_idx1].ed.linear_type);
07557 break;
07558
07559 case Integer_1:
07560 cn_idx = cvrt_str_to_cn(HUGE_INT1_F90,
07561 arg_info_list[info_idx1].ed.linear_type);
07562 break;
07563
07564 case Integer_2:
07565 cn_idx = cvrt_str_to_cn(HUGE_INT2_F90,
07566 arg_info_list[info_idx1].ed.linear_type);
07567 break;
07568
07569 case Integer_4:
07570 cn_idx = cvrt_str_to_cn(HUGE_INT4_F90,
07571 arg_info_list[info_idx1].ed.linear_type);
07572 break;
07573
07574 case Integer_8:
07575 cn_idx = cvrt_str_to_cn(HUGE_INT8_F90,
07576 arg_info_list[info_idx1].ed.linear_type);
07577
07578 # ifdef _TARGET_HAS_FAST_INTEGER
07579 if (opt_flags.set_allfastint_option ||
07580 (opt_flags.set_fastint_option &&
07581 (TYP_DESC(arg_info_list[info_idx1].ed.type_idx) ==
07582 Default_Typed))) {
07583 cn_idx = C_INT_TO_CN(IR_TYPE_IDX(ir_idx), 70368744177663L);
07584 }
07585 # endif
07586 break;
07587 }
07588
07589
07590 OPND_IDX((*result_opnd)) = cn_idx;
07591 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
07592 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
07593 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
07594 res_exp_desc->constant = TRUE;
07595 res_exp_desc->foldable = TRUE;
07596
07597
07598 TRACE (Func_Exit, "huge_intrinsic", NULL);
07599
07600 }
07601
07602
07603
07604
07605
07606
07607
07608
07609
07610
07611
07612
07613
07614
07615
07616
07617
07618
07619
07620
07621
07622
07623 void ibits_intrinsic(opnd_type *result_opnd,
07624 expr_arg_type *res_exp_desc,
07625 int *spec_idx)
07626 {
07627 boolean fold_it = FALSE;
07628 int ir_idx;
07629 int info_idx1;
07630 int list_idx1;
07631 int list_idx2;
07632 int list_idx3;
07633 opnd_type opnd;
07634 int typeless_idx;
07635
07636 # if !(defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX))
07637 int cn_idx;
07638 int cn_idx2;
07639 long num;
07640 int shiftl_idx;
07641 int shiftr_idx;
07642 int shifta_idx;
07643 int first_idx;
07644 int second_idx;
07645 int mask_idx;
07646 int band_idx;
07647 int minus_idx;
07648 int line;
07649 int column;
07650 # endif
07651
07652
07653 TRACE (Func_Entry, "ibits_intrinsic", NULL);
07654
07655 ir_idx = OPND_IDX((*result_opnd));
07656 list_idx1 = IR_IDX_R(ir_idx);
07657 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
07658 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
07659 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
07660 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
07661
07662 if (arg_info_list[info_idx1].ed.type == Typeless) {
07663 PRINTMSG(arg_info_list[info_idx1].line, 1076, Ansi,
07664 arg_info_list[info_idx1].col);
07665
07666 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
07667 }
07668
07669 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_8) {
07670 typeless_idx = Typeless_8;
07671 # if defined(GENERATE_WHIRL)
07672 typeless_idx = Integer_8;
07673 # endif
07674
07675 }
07676 else {
07677 typeless_idx = TYPELESS_DEFAULT_TYPE;
07678 # if defined(GENERATE_WHIRL)
07679 typeless_idx = INTEGER_DEFAULT_TYPE;
07680 if (arg_info_list[info_idx1].ed.type == Integer) {
07681 typeless_idx = arg_info_list[info_idx1].ed.linear_type;
07682 }
07683 # endif
07684
07685 }
07686
07687 # ifdef _TARGET_OS_MAX
07688 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_1 ||
07689 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_2 ||
07690 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_4) {
07691 typeless_idx = Typeless_4;
07692 }
07693 # endif
07694
07695 conform_check(0,
07696 ir_idx,
07697 res_exp_desc,
07698 spec_idx,
07699 FALSE);
07700
07701 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07702 IR_RANK(ir_idx) = res_exp_desc->rank;
07703
07704 # if 0
07705
07706 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
07707 IL_FLD(list_idx2) == CN_Tbl_Idx &&
07708 IL_FLD(list_idx3) == CN_Tbl_Idx) {
07709 fold_it = TRUE;
07710 }
07711
07712 # if defined(GENERATE_WHIRL)
07713
07714 IR_OPR(ir_idx) = Ibits_Opr;
07715 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
07716 IR_OPND_R(ir_idx) = null_opnd;
07717
07718 # else
07719
07720 line = IR_LINE_NUM(ir_idx);
07721 column = IR_COL_NUM(ir_idx);
07722
07723 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
07724 ATP_RSLT_IDX(*spec_idx)))] * 2;
07725
07726 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
07727
07728 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
07729 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), line, column,
07730 IL_FLD(list_idx3), IL_IDX(list_idx3));
07731
07732 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
07733 Mask_Opr, typeless_idx, line, column,
07734 NO_Tbl_Idx, NULL_IDX);
07735
07736 NTR_IR_LIST_TBL(first_idx);
07737 IL_FLD(first_idx) = IR_Tbl_Idx;
07738 IL_IDX(first_idx) = mask_idx;
07739 NTR_IR_LIST_TBL(second_idx);
07740 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx2));
07741 IL_NEXT_LIST_IDX(first_idx) = second_idx;
07742
07743 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
07744 Shiftl_Opr, typeless_idx, line, column,
07745 NO_Tbl_Idx, NULL_IDX);
07746
07747 COPY_OPND(opnd, IL_OPND(list_idx1));
07748 cast_opnd_to_type_idx(&opnd, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
07749 COPY_OPND(IL_OPND(list_idx1), opnd);
07750
07751 band_idx = gen_ir(IR_Tbl_Idx, shiftl_idx,
07752 Band_Opr, typeless_idx, line, column,
07753 IL_FLD(list_idx1), IL_IDX(list_idx1));
07754
07755 NTR_IR_LIST_TBL(first_idx);
07756 IL_FLD(first_idx) = IR_Tbl_Idx;
07757 IL_IDX(first_idx) = band_idx;
07758 NTR_IR_LIST_TBL(second_idx);
07759 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx2));
07760 IL_NEXT_LIST_IDX(first_idx) = second_idx;
07761
07762 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
07763 Shiftr_Opr, typeless_idx, line, column,
07764 NO_Tbl_Idx, NULL_IDX);
07765
07766 num =storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
07767
07768 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
07769
07770 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
07771 case Integer_1:
07772 num = BITSIZE_INT1_F90;
07773 break;
07774
07775 case Integer_2:
07776 num = BITSIZE_INT2_F90;
07777 break;
07778
07779 case Integer_4:
07780 num = BITSIZE_INT4_F90;
07781 break;
07782
07783 case Integer_8:
07784 num = BITSIZE_INT8_F90;
07785 break;
07786 }
07787
07788 cn_idx2 = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
07789
07790 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
07791 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, line, column,
07792 CN_Tbl_Idx, cn_idx2);
07793
07794 NTR_IR_LIST_TBL(first_idx);
07795 IL_FLD(first_idx) = IR_Tbl_Idx;
07796 IL_IDX(first_idx) = shiftr_idx;
07797 NTR_IR_LIST_TBL(second_idx);
07798 IL_FLD(second_idx) = IR_Tbl_Idx;
07799 IL_IDX(second_idx) = minus_idx;
07800 IL_NEXT_LIST_IDX(first_idx) = second_idx;
07801
07802 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
07803 Shiftl_Opr, typeless_idx, line, column,
07804 NO_Tbl_Idx, NULL_IDX);
07805
07806 NTR_IR_LIST_TBL(first_idx);
07807 IL_FLD(first_idx) = IR_Tbl_Idx;
07808 IL_IDX(first_idx) = shiftl_idx;
07809 NTR_IR_LIST_TBL(second_idx);
07810 IL_FLD(second_idx) = IR_Tbl_Idx;
07811 IL_IDX(second_idx) = minus_idx;
07812 IL_NEXT_LIST_IDX(first_idx) = second_idx;
07813
07814 shifta_idx = gen_ir(IL_Tbl_Idx, first_idx,
07815 Shifta_Opr, typeless_idx, line, column,
07816 NO_Tbl_Idx, NULL_IDX);
07817
07818 IR_OPR(ir_idx) = Cvrt_Opr;
07819 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07820 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
07821 IR_IDX_L(ir_idx) = shifta_idx;
07822 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
07823 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
07824 IR_OPND_R(ir_idx) = null_opnd;
07825
07826 # endif
07827
07828 if (fold_it) {
07829 COPY_OPND(opnd, (*result_opnd));
07830 fold_aggragate_expression(&opnd, res_exp_desc, FALSE);
07831 COPY_OPND((*result_opnd), opnd);
07832 }
07833
07834 # endif
07835
07836 res_exp_desc->foldable = FALSE;
07837 res_exp_desc->will_fold_later = FALSE;
07838
07839 TRACE (Func_Exit, "ibits_intrinsic", NULL);
07840
07841 }
07842
07843
07844
07845
07846
07847
07848
07849
07850
07851
07852
07853
07854
07855
07856
07857
07858
07859
07860
07861
07862
07863 void btest_intrinsic(opnd_type *result_opnd,
07864 expr_arg_type *res_exp_desc,
07865 int *spec_idx)
07866 {
07867 int ir_idx;
07868 int cn_idx;
07869 int minus_idx;
07870 int shiftl_idx;
07871 int typeless_idx;
07872 int first_idx;
07873 int second_idx;
07874 int shiftr_idx;
07875 int info_idx1;
07876 int list_idx1;
07877 int list_idx2;
07878 int type_idx;
07879 int line;
07880 int column;
07881 long num;
07882
07883
07884 TRACE (Func_Entry, "btest_intrinsic", NULL);
07885
07886 ir_idx = OPND_IDX((*result_opnd));
07887 list_idx1 = IR_IDX_R(ir_idx);
07888 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
07889 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
07890 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
07891
07892 if (ATP_INTRIN_ENUM(*spec_idx) == Bitest_Intrinsic) {
07893 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Logical_2;
07894 }
07895 else if (ATP_INTRIN_ENUM(*spec_idx) == Bjtest_Intrinsic) {
07896 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Logical_4;
07897 }
07898 else if (ATP_INTRIN_ENUM(*spec_idx) == Bktest_Intrinsic) {
07899 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Logical_8;
07900 }
07901
07902 if (arg_info_list[info_idx1].ed.linear_type == Integer_8) {
07903 typeless_idx = Typeless_8;
07904 }
07905 else {
07906 typeless_idx = TYPELESS_DEFAULT_TYPE;
07907 }
07908
07909 # ifdef _TARGET_OS_MAX
07910 if (arg_info_list[info_idx1].ed.linear_type == Integer_1 ||
07911 arg_info_list[info_idx1].ed.linear_type == Integer_2 ||
07912 arg_info_list[info_idx1].ed.linear_type == Integer_4) {
07913 typeless_idx = Typeless_4;
07914 }
07915 # endif
07916
07917 conform_check(0,
07918 ir_idx,
07919 res_exp_desc,
07920 spec_idx,
07921 FALSE);
07922
07923 type_idx = INTEGER_DEFAULT_TYPE;
07924
07925 # ifdef _TARGET32
07926 if (arg_info_list[info_idx1].ed.linear_type == Integer_8) {
07927 type_idx = Integer_8;
07928 }
07929 # endif
07930
07931 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
07932 IR_RANK(ir_idx) = res_exp_desc->rank;
07933
07934 # if 0
07935
07936 num = storage_bit_size_tbl[TYP_LINEAR(typeless_idx)] - 1;
07937
07938 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
07939
07940 line = IR_LINE_NUM(ir_idx);
07941 column = IR_COL_NUM(ir_idx);
07942
07943 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
07944 Minus_Opr, type_idx, line, column,
07945 IL_FLD(list_idx2), IL_IDX(list_idx2));
07946
07947 NTR_IR_LIST_TBL(first_idx);
07948 COPY_OPND(IL_OPND(first_idx), IL_OPND(list_idx1));
07949 NTR_IR_LIST_TBL(second_idx);
07950 IL_NEXT_LIST_IDX(first_idx) = second_idx;
07951 IL_FLD(second_idx) = IR_Tbl_Idx;
07952 IL_IDX(second_idx) = minus_idx;
07953
07954 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
07955 Shiftl_Opr, typeless_idx, line, column,
07956 NO_Tbl_Idx, NULL_IDX);
07957
07958 NTR_IR_LIST_TBL(first_idx);
07959 IL_FLD(first_idx) = IR_Tbl_Idx;
07960 IL_IDX(first_idx) = shiftl_idx;
07961 NTR_IR_LIST_TBL(second_idx);
07962 IL_NEXT_LIST_IDX(first_idx) = second_idx;
07963 IL_FLD(second_idx) = CN_Tbl_Idx;
07964 IL_IDX(second_idx) = cn_idx;
07965 IL_LINE_NUM(second_idx) = IR_LINE_NUM(ir_idx);
07966 IL_COL_NUM(second_idx) = IR_COL_NUM(ir_idx);
07967
07968 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
07969 Shifta_Opr, typeless_idx, line, column,
07970 NO_Tbl_Idx, NULL_IDX);
07971
07972 if (target_ieee) {
07973 IR_OPR(shiftr_idx) = Shiftr_Opr;
07974 }
07975
07976
07977 IR_OPR(ir_idx) = Cvrt_Opr;
07978 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
07979 IR_IDX_L(ir_idx) = shiftr_idx;
07980 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
07981 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
07982 IR_OPND_R(ir_idx) = null_opnd;
07983
07984 # endif
07985
07986
07987
07988
07989 res_exp_desc->foldable = FALSE;
07990 res_exp_desc->will_fold_later = FALSE;
07991
07992
07993 TRACE (Func_Exit, "btest_intrinsic", NULL);
07994
07995 }
07996
07997
07998
07999
08000
08001
08002
08003
08004
08005
08006
08007
08008
08009
08010
08011
08012
08013
08014
08015
08016
08017
08018
08019
08020
08021
08022
08023
08024
08025 void ibset_intrinsic(opnd_type *result_opnd,
08026 expr_arg_type *res_exp_desc,
08027 int *spec_idx)
08028 {
08029 int ir_idx;
08030 int cn_idx;
08031 int cn_idx2;
08032 int info_idx1;
08033 int info_idx2;
08034 int list_idx1;
08035 int list_idx2;
08036 long num1;
08037 long num2;
08038 int shiftl_idx;
08039 int shifta_idx;
08040 int csmg_idx;
08041 int minus_idx;
08042 int first_idx;
08043 int second_idx;
08044 int third_idx;
08045 int bor_idx;
08046 int band_idx;
08047 int bnot_idx;
08048 int bnot_idx1;
08049 int typeless_idx;
08050 opnd_type opnd;
08051 boolean fold_it = FALSE;
08052 int line;
08053 int column;
08054
08055
08056 TRACE (Func_Entry, "ibset_intrinsic", NULL);
08057
08058 ir_idx = OPND_IDX((*result_opnd));
08059 list_idx1 = IR_IDX_R(ir_idx);
08060 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
08061 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
08062 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
08063
08064 if (arg_info_list[info_idx1].ed.type == Typeless) {
08065 PRINTMSG(arg_info_list[info_idx1].line, 1076, Ansi,
08066 arg_info_list[info_idx1].col);
08067 }
08068
08069 switch (arg_info_list[info_idx1].ed.linear_type) {
08070 case Typeless_1:
08071 case Integer_1:
08072 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_1;
08073 typeless_idx = Typeless_1;
08074 # ifdef _TARGET_OS_MAX
08075 typeless_idx = Typeless_4;
08076 # endif
08077 # ifdef _TARGET_OS_UNICOS
08078 typeless_idx = Typeless_8;
08079 # endif
08080 num1 = BITSIZE_INT1_F90 - 1;
08081 num2 = BITSIZE_INT1_F90;
08082 break;
08083
08084 case Typeless_2:
08085 case Integer_2:
08086 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_2;
08087 typeless_idx = Typeless_2;
08088 # ifdef _TARGET_OS_MAX
08089 typeless_idx = Typeless_4;
08090 # endif
08091 # ifdef _TARGET_OS_UNICOS
08092 typeless_idx = Typeless_8;
08093 # endif
08094 num1 = BITSIZE_INT2_F90 - 1;
08095 num2 = BITSIZE_INT2_F90;
08096 break;
08097
08098 case Typeless_4:
08099 case Integer_4:
08100 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_4;
08101 typeless_idx = Typeless_4;
08102 # ifdef _TARGET_OS_UNICOS
08103 typeless_idx = Typeless_8;
08104 # endif
08105 num1 = BITSIZE_INT4_F90 - 1;
08106 num2 = BITSIZE_INT4_F90;
08107 break;
08108
08109 case Typeless_8:
08110 case Integer_8:
08111 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = Integer_8;
08112 typeless_idx = Typeless_8;
08113 num1 = BITSIZE_INT8_F90 - 1;
08114 num2 = BITSIZE_INT8_F90;
08115 break;
08116
08117 default:
08118 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal,
08119 IR_COL_NUM(ir_idx),
08120 "ibset_intrinsic");
08121 break;
08122 }
08123
08124 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
08125 if (compare_cn_and_value(IL_IDX(list_idx2), 0, Lt_Opr) ||
08126 compare_cn_and_value(IL_IDX(list_idx2), num1, Gt_Opr)) {
08127 PRINTMSG(arg_info_list[info_idx2].line, 1062, Error,
08128 arg_info_list[info_idx2].col);
08129 }
08130 }
08131
08132 conform_check(0,
08133 ir_idx,
08134 res_exp_desc,
08135 spec_idx,
08136 FALSE);
08137
08138 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
08139 IR_RANK(ir_idx) = res_exp_desc->rank;
08140
08141 # if 0
08142
08143 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
08144 IL_FLD(list_idx2) == CN_Tbl_Idx) {
08145 fold_it = TRUE;
08146 }
08147
08148 line = IR_LINE_NUM(ir_idx);
08149 column = IR_COL_NUM(ir_idx);
08150 cn_idx = (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) ==
08151 CG_INTEGER_DEFAULT_TYPE) ?
08152 CN_INTEGER_ONE_IDX :
08153 C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), 1);
08154
08155 NTR_IR_LIST_TBL(first_idx);
08156 IL_FLD(first_idx) = CN_Tbl_Idx;
08157 IL_IDX(first_idx) = cn_idx;
08158 IL_LINE_NUM(first_idx) = line;
08159 IL_COL_NUM(first_idx) = column;
08160
08161 NTR_IR_LIST_TBL(second_idx);
08162 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx2));
08163 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08164
08165 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08166 Shiftl_Opr,
08167 typeless_idx,
08168 line, column,
08169 NO_Tbl_Idx, NULL_IDX);
08170
08171 COPY_OPND(opnd, IL_OPND(list_idx1));
08172 cast_opnd_to_type_idx(&opnd, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
08173 COPY_OPND(IL_OPND(list_idx1), opnd);
08174
08175 num1=storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
08176
08177 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num1);
08178 cn_idx2 = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num2);
08179
08180 switch (ATP_INTRIN_ENUM(*spec_idx)) {
08181 case Ibset_Intrinsic:
08182 case Iibset_Intrinsic:
08183 case Jibset_Intrinsic:
08184 case Kibset_Intrinsic:
08185 bor_idx = gen_ir(IR_Tbl_Idx, shiftl_idx,
08186 Bor_Opr,
08187 typeless_idx,
08188 line, column,
08189 IL_FLD(list_idx1), IL_IDX(list_idx1));
08190
08191 NTR_IR_LIST_TBL(first_idx);
08192 IL_FLD(first_idx) = IR_Tbl_Idx;
08193 IL_IDX(first_idx) = bor_idx;
08194 break;
08195
08196
08197 case Ibclr_Intrinsic:
08198 case Iibclr_Intrinsic:
08199 case Jibclr_Intrinsic:
08200 case Kibclr_Intrinsic:
08201 bnot_idx = gen_ir(IR_Tbl_Idx, shiftl_idx,
08202 Bnot_Opr,
08203 typeless_idx,
08204 line, column,
08205 NO_Tbl_Idx, NULL_IDX);
08206
08207 band_idx = gen_ir(IR_Tbl_Idx, bnot_idx,
08208 Band_Opr,
08209 typeless_idx,
08210 line, column,
08211 IL_FLD(list_idx1), IL_IDX(list_idx1));
08212
08213 NTR_IR_LIST_TBL(first_idx);
08214 IL_FLD(first_idx) = IR_Tbl_Idx;
08215 IL_IDX(first_idx) = band_idx;
08216 break;
08217
08218
08219 case Ibchng_Intrinsic:
08220 case Iibchng_Intrinsic:
08221 case Jibchng_Intrinsic:
08222 case Kibchng_Intrinsic:
08223 bnot_idx = gen_ir(IR_Tbl_Idx, shiftl_idx,
08224 Bnot_Opr,
08225 typeless_idx,
08226 line, column,
08227 NO_Tbl_Idx, NULL_IDX);
08228
08229 COPY_OPND(opnd, IL_OPND(list_idx1));
08230 copy_subtree(&opnd, &opnd);
08231 bnot_idx1 = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
08232 Bnot_Opr,
08233 typeless_idx,
08234 line, column,
08235 NO_Tbl_Idx, NULL_IDX);
08236
08237 NTR_IR_LIST_TBL(first_idx);
08238 COPY_OPND(opnd, IL_OPND(list_idx1));
08239 copy_subtree(&opnd, &opnd);
08240 COPY_OPND(IL_OPND(first_idx), opnd);
08241
08242 NTR_IR_LIST_TBL(second_idx);
08243 IL_FLD(second_idx) = IR_Tbl_Idx;
08244 IL_IDX(second_idx) = bnot_idx1;
08245
08246 NTR_IR_LIST_TBL(third_idx);
08247 IL_FLD(third_idx) = IR_Tbl_Idx;
08248 IL_IDX(third_idx) = bnot_idx;
08249
08250 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08251 IL_NEXT_LIST_IDX(second_idx) = third_idx;
08252
08253 csmg_idx = gen_ir(IL_Tbl_Idx, first_idx,
08254 Csmg_Opr,
08255 typeless_idx,
08256 line, column,
08257 NO_Tbl_Idx, NULL_IDX);
08258
08259
08260 NTR_IR_LIST_TBL(first_idx);
08261 IL_FLD(first_idx) = IR_Tbl_Idx;
08262 IL_IDX(first_idx) = csmg_idx;
08263 break;
08264
08265
08266 default:
08267 PRINTMSG(IR_LINE_NUM(ir_idx), 179, Internal,
08268 IR_COL_NUM(ir_idx),
08269 "ibset_intrinsic");
08270 break;
08271 }
08272
08273 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
08274 Minus_Opr,
08275 CG_INTEGER_DEFAULT_TYPE,
08276 line, column,
08277 CN_Tbl_Idx, cn_idx2);
08278
08279 NTR_IR_LIST_TBL(second_idx);
08280 IL_FLD(second_idx) = IR_Tbl_Idx;
08281 IL_IDX(second_idx) = minus_idx;
08282 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08283
08284 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08285 Shiftl_Opr,
08286 typeless_idx,
08287 line, column,
08288 NO_Tbl_Idx, NULL_IDX);
08289
08290 NTR_IR_LIST_TBL(first_idx);
08291 IL_FLD(first_idx) = IR_Tbl_Idx;
08292 IL_IDX(first_idx) = shiftl_idx;
08293
08294 NTR_IR_LIST_TBL(second_idx);
08295 IL_FLD(second_idx) = IR_Tbl_Idx;
08296 IL_IDX(second_idx) = minus_idx;
08297 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08298
08299 shifta_idx = gen_ir(IL_Tbl_Idx, first_idx,
08300 Shifta_Opr,
08301 typeless_idx,
08302 line, column,
08303 NO_Tbl_Idx, NULL_IDX);
08304
08305 IR_OPR(ir_idx) = Cvrt_Opr;
08306 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
08307 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
08308 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
08309 IR_IDX_L(ir_idx) = shifta_idx;
08310 IR_OPND_R(ir_idx) = null_opnd;
08311
08312 if (fold_it) {
08313 COPY_OPND(opnd, (*result_opnd));
08314 fold_aggragate_expression(&opnd, res_exp_desc, FALSE);
08315 COPY_OPND((*result_opnd), opnd);
08316 }
08317
08318 # endif
08319 res_exp_desc->foldable = FALSE;
08320 res_exp_desc->will_fold_later = FALSE;
08321
08322
08323 TRACE (Func_Exit, "ibset_intrinsic", NULL);
08324
08325 }
08326
08327
08328
08329
08330
08331
08332
08333
08334
08335
08336
08337
08338
08339
08340
08341
08342
08343
08344
08345
08346 void ishft_intrinsic(opnd_type *result_opnd,
08347 expr_arg_type *res_exp_desc,
08348 int *spec_idx)
08349 {
08350 int ir_idx;
08351 int gt_idx;
08352 int list_idx1;
08353 int list_idx2;
08354 int info_idx1;
08355 int info_idx2;
08356 int minus_idx;
08357 int first_idx;
08358 int second_idx;
08359 int third_idx;
08360 int shiftl_idx;
08361 int shiftr_idx;
08362 int shifta_idx;
08363 int shiftr_idx2;
08364 int cvmgt_idx;
08365 int typeless_idx;
08366 int cn_idx;
08367 operator_type opr;
08368 int cn_idx2;
08369 opnd_type opnd;
08370 boolean fold_it = FALSE;
08371 int line;
08372 int column;
08373 long num1;
08374 long num2;
08375
08376
08377 TRACE (Func_Entry, "ishft_intrinsic", NULL);
08378
08379 ir_idx = OPND_IDX((*result_opnd));
08380 list_idx1 = IR_IDX_R(ir_idx);
08381 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
08382 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
08383 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
08384 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
08385
08386 if (ATP_INTRIN_ENUM(*spec_idx) == Isha_Intrinsic ||
08387 ATP_INTRIN_ENUM(*spec_idx) == Iisha_Intrinsic ||
08388 ATP_INTRIN_ENUM(*spec_idx) == Jisha_Intrinsic ||
08389 ATP_INTRIN_ENUM(*spec_idx) == Kisha_Intrinsic) {
08390 opr = Shifta_Opr;
08391 }
08392 else {
08393 opr = Shiftr_Opr;
08394 }
08395
08396 line = IR_LINE_NUM(ir_idx);
08397 column = IR_COL_NUM(ir_idx);
08398
08399 if (arg_info_list[info_idx1].ed.type == Typeless) {
08400 PRINTMSG(arg_info_list[info_idx1].line, 1076, Ansi,
08401 arg_info_list[info_idx1].col);
08402
08403 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
08404 }
08405
08406 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_8) {
08407 typeless_idx = Typeless_8;
08408 }
08409 else {
08410 typeless_idx = TYPELESS_DEFAULT_TYPE;
08411 }
08412
08413 # ifdef _TARGET_OS_MAX
08414 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_1 ||
08415 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_2 ||
08416 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_4) {
08417 typeless_idx = Typeless_4;
08418 }
08419 # endif
08420
08421 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
08422 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
08423 case Integer_1:
08424 num1 = BITSIZE_INT1_F90;
08425 num2 = -BITSIZE_INT1_F90;
08426 break;
08427
08428 case Integer_2:
08429 num1 = BITSIZE_INT2_F90;
08430 num2 = -BITSIZE_INT2_F90;
08431 break;
08432
08433 case Integer_4:
08434 num1 = BITSIZE_INT4_F90;
08435 num2 = -BITSIZE_INT4_F90;
08436 break;
08437
08438 case Integer_8:
08439 num1 = BITSIZE_INT8_F90;
08440 num2 = -BITSIZE_INT8_F90;
08441 break;
08442 }
08443
08444 if (compare_cn_and_value(IL_IDX(list_idx2), num1, Gt_Opr) ||
08445 compare_cn_and_value(IL_IDX(list_idx2), num2, Lt_Opr)) {
08446 PRINTMSG(arg_info_list[info_idx2].line, 1062, Error,
08447 arg_info_list[info_idx2].col);
08448 }
08449 }
08450
08451 conform_check(0,
08452 ir_idx,
08453 res_exp_desc,
08454 spec_idx,
08455 FALSE);
08456
08457
08458 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
08459 IR_RANK(ir_idx) = res_exp_desc->rank;
08460
08461 # if 0
08462
08463 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) !=
08464 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx)) {
08465
08466
08467
08468 COPY_OPND(opnd, IL_OPND(list_idx1));
08469 cast_to_type_idx(&opnd,
08470 &arg_info_list[info_idx1].ed,
08471 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
08472 COPY_OPND(IL_OPND(list_idx1), opnd);
08473
08474 }
08475
08476 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) !=
08477 TYP_LINEAR(arg_info_list[info_idx2].ed.type_idx)) {
08478
08479
08480
08481 COPY_OPND(opnd, IL_OPND(list_idx2));
08482 cast_to_type_idx(&opnd,
08483 &arg_info_list[info_idx2].ed,
08484 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
08485 COPY_OPND(IL_OPND(list_idx2), opnd);
08486
08487 }
08488
08489 if (opr == Shifta_Opr &&
08490 IL_FLD(list_idx2) == CN_Tbl_Idx) {
08491
08492 if (CN_INT_TO_C(IL_IDX(list_idx2)) == -8 &&
08493 arg_info_list[info_idx1].ed.linear_type == Integer_1) {
08494 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, -7);
08495 IL_IDX(list_idx2) = cn_idx;
08496 }
08497
08498 else if (CN_INT_TO_C(IL_IDX(list_idx2)) == -16 &&
08499 arg_info_list[info_idx1].ed.linear_type == Integer_2) {
08500 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, -15);
08501 IL_IDX(list_idx2) = cn_idx;
08502 }
08503
08504 else if (CN_INT_TO_C(IL_IDX(list_idx2)) == -32 &&
08505 arg_info_list[info_idx1].ed.linear_type == Integer_4) {
08506 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, -31);
08507 IL_IDX(list_idx2) = cn_idx;
08508 }
08509
08510 else if (CN_INT_TO_C(IL_IDX(list_idx2)) == -64 &&
08511 arg_info_list[info_idx1].ed.linear_type == Integer_8) {
08512 cn_idx = C_INT_TO_CN(arg_info_list[info_idx2].ed.type_idx, -63);
08513 IL_IDX(list_idx2) = cn_idx;
08514 }
08515 }
08516
08517 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
08518 IL_FLD(list_idx2) == CN_Tbl_Idx) {
08519 fold_it = TRUE;
08520 }
08521
08522 num1 = register_bit_size_tbl[
08523 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
08524
08525 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num1);
08526
08527 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
08528 case Integer_1:
08529 num1 = BITSIZE_INT1_F90;
08530 break;
08531
08532 case Integer_2:
08533 num1 = BITSIZE_INT2_F90;
08534 break;
08535
08536 case Integer_4:
08537 num1 = BITSIZE_INT4_F90;
08538 break;
08539
08540 case Integer_8:
08541 num1 = BITSIZE_INT8_F90;
08542 break;
08543 }
08544
08545 cn_idx2 = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num1);
08546
08547 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
08548 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, line, column,
08549 CN_Tbl_Idx, cn_idx2);
08550
08551 NTR_IR_LIST_TBL(first_idx);
08552 COPY_OPND(IL_OPND(first_idx), IL_OPND(list_idx1));
08553 NTR_IR_LIST_TBL(second_idx);
08554 IL_FLD(second_idx) = IR_Tbl_Idx;
08555 IL_IDX(second_idx) = minus_idx;
08556 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08557
08558 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08559 Shiftl_Opr, typeless_idx, line, column,
08560 NO_Tbl_Idx, NULL_IDX);
08561
08562 NTR_IR_LIST_TBL(first_idx);
08563 IL_FLD(first_idx) = IR_Tbl_Idx;
08564 IL_IDX(first_idx) = shiftl_idx;
08565 NTR_IR_LIST_TBL(second_idx);
08566 IL_FLD(second_idx) = IR_Tbl_Idx;
08567 IL_IDX(second_idx) = minus_idx;
08568 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08569
08570 shiftr_idx2 = gen_ir(IL_Tbl_Idx, first_idx,
08571 opr, typeless_idx, line, column,
08572 NO_Tbl_Idx, NULL_IDX);
08573
08574
08575 NTR_IR_LIST_TBL(first_idx);
08576 IL_FLD(first_idx) = IR_Tbl_Idx;
08577 IL_IDX(first_idx) = shiftr_idx2;
08578 NTR_IR_LIST_TBL(second_idx);
08579 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx2));
08580 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08581
08582 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08583 Shiftl_Opr, typeless_idx, line, column,
08584 NO_Tbl_Idx, NULL_IDX);
08585
08586
08587
08588 COPY_OPND(opnd, IL_OPND(list_idx2));
08589 copy_subtree(&opnd, &opnd);
08590
08591 minus_idx = gen_ir(CN_Tbl_Idx, CN_INTEGER_ZERO_IDX,
08592 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, line, column,
08593 OPND_FLD(opnd), OPND_IDX(opnd));
08594
08595 NTR_IR_LIST_TBL(first_idx);
08596 IL_FLD(first_idx) = IR_Tbl_Idx;
08597 IL_IDX(first_idx) = shiftr_idx2;
08598 NTR_IR_LIST_TBL(second_idx);
08599 IL_FLD(second_idx) = IR_Tbl_Idx;
08600 IL_IDX(second_idx) = minus_idx;
08601 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08602
08603 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
08604 opr, typeless_idx, line, column,
08605 NO_Tbl_Idx, NULL_IDX);
08606
08607
08608
08609 COPY_OPND(opnd, IL_OPND(list_idx2));
08610 copy_subtree(&opnd, &opnd);
08611
08612 gt_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
08613 Gt_Opr, LOGICAL_DEFAULT_TYPE, line, column,
08614 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
08615
08616
08617 NTR_IR_LIST_TBL(first_idx);
08618 IL_ARG_DESC_VARIANT(first_idx) = TRUE;
08619 IL_FLD(first_idx) = IR_Tbl_Idx;
08620 IL_IDX(first_idx) = shiftl_idx;
08621
08622 NTR_IR_LIST_TBL(second_idx);
08623 IL_ARG_DESC_VARIANT(second_idx) = TRUE;
08624 IL_FLD(second_idx) = IR_Tbl_Idx;
08625 IL_IDX(second_idx) = shiftr_idx;
08626
08627 NTR_IR_LIST_TBL(third_idx);
08628 IL_ARG_DESC_VARIANT(third_idx) = TRUE;
08629 IL_FLD(third_idx) = IR_Tbl_Idx;
08630 IL_IDX(third_idx) = gt_idx;
08631
08632 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08633 IL_NEXT_LIST_IDX(second_idx) = third_idx;
08634
08635 cvmgt_idx = gen_ir(IL_Tbl_Idx, first_idx,
08636 Cvmgt_Opr, typeless_idx, line, column,
08637 NO_Tbl_Idx, NULL_IDX);
08638
08639
08640 io_item_must_flatten = TRUE;
08641
08642 if (fold_it) {
08643 if (compare_cn_and_value(IL_IDX(list_idx2), 0, Gt_Opr)) {
08644 cvmgt_idx = shiftl_idx;
08645 }
08646 else {
08647 cvmgt_idx = shiftr_idx;
08648 }
08649 }
08650
08651 num1 = register_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
08652 ATP_RSLT_IDX(*spec_idx)))];
08653
08654 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num1);
08655
08656 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
08657 case Integer_1:
08658 num1 = BITSIZE_INT1_F90;
08659 break;
08660
08661 case Integer_2:
08662 num1 = BITSIZE_INT2_F90;
08663 break;
08664
08665 case Integer_4:
08666 num1 = BITSIZE_INT4_F90;
08667 break;
08668
08669 case Integer_8:
08670 num1 = BITSIZE_INT8_F90;
08671 break;
08672 }
08673
08674 cn_idx2 = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num1);
08675
08676 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
08677 Minus_Opr, CG_INTEGER_DEFAULT_TYPE, line, column,
08678 CN_Tbl_Idx, cn_idx2);
08679
08680 NTR_IR_LIST_TBL(first_idx);
08681 IL_FLD(first_idx) = IR_Tbl_Idx;
08682 IL_IDX(first_idx) = cvmgt_idx;
08683 NTR_IR_LIST_TBL(second_idx);
08684 IL_FLD(second_idx) = IR_Tbl_Idx;
08685 IL_IDX(second_idx) = minus_idx;
08686 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08687
08688 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
08689 Shiftl_Opr, typeless_idx, line, column,
08690 NO_Tbl_Idx, NULL_IDX);
08691
08692 NTR_IR_LIST_TBL(first_idx);
08693 IL_FLD(first_idx) = IR_Tbl_Idx;
08694 IL_IDX(first_idx) = shiftl_idx;
08695 NTR_IR_LIST_TBL(second_idx);
08696 IL_FLD(second_idx) = IR_Tbl_Idx;
08697 IL_IDX(second_idx) = minus_idx;
08698 IL_NEXT_LIST_IDX(first_idx) = second_idx;
08699
08700 shifta_idx = gen_ir(IL_Tbl_Idx, first_idx,
08701 Shifta_Opr, typeless_idx, line, column,
08702 NO_Tbl_Idx, NULL_IDX);
08703
08704 IR_OPR(ir_idx) = Cvrt_Opr;
08705 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
08706 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
08707 IR_IDX_L(ir_idx) = shifta_idx;
08708 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
08709 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
08710 IR_FLD_R(ir_idx) = NO_Tbl_Idx;
08711 IR_IDX_R(ir_idx) = NULL_IDX;
08712
08713 if (fold_it) {
08714 COPY_OPND(opnd, (*result_opnd));
08715 fold_aggragate_expression(&opnd, res_exp_desc, FALSE);
08716 COPY_OPND((*result_opnd), opnd);
08717 }
08718
08719 # endif
08720
08721 res_exp_desc->foldable = FALSE;
08722 res_exp_desc->will_fold_later = FALSE;
08723
08724
08725 TRACE (Func_Exit, "ishft_intrinsic", NULL);
08726
08727 }
08728
08729
08730
08731
08732
08733
08734
08735
08736
08737
08738
08739
08740
08741
08742
08743
08744
08745
08746
08747 void ishftc_intrinsic(opnd_type *result_opnd,
08748 expr_arg_type *res_exp_desc,
08749 int *spec_idx)
08750 {
08751
08752 # if !(defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX))
08753 int ishft2_idx;
08754 int minus_idx;
08755 int uminus_idx;
08756 int shift_idx;
08757 int shiftl_idx;
08758 int shifta_idx;
08759 int mask_idx;
08760 int sign_idx;
08761 int csmg_idx;
08762 int abs_idx;
08763 int ior_idx;
08764 int plus_idx;
08765 int band_idx;
08766 int band1_idx;
08767 int first_idx;
08768 int second_idx;
08769 int third_idx;
08770 int cn_idx2;
08771 opnd_type save_opnd;
08772 int line;
08773 int column;
08774 int ishft1_idx;
08775 # endif
08776
08777 int cn_idx;
08778 boolean fold_it = FALSE;
08779 int ir_idx;
08780 int list_idx1;
08781 int list_idx2;
08782 int list_idx3;
08783 int info_idx1;
08784 int info_idx2;
08785 int info_idx3;
08786 long num;
08787 opnd_type opnd;
08788 int typeless_idx;
08789
08790
08791 TRACE (Func_Entry, "ishftc_intrinsic", NULL);
08792
08793 ir_idx = OPND_IDX((*result_opnd));
08794 list_idx1 = IR_IDX_R(ir_idx);
08795 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
08796 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
08797 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
08798 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
08799 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
08800
08801 if (arg_info_list[info_idx1].ed.type == Typeless) {
08802 PRINTMSG(arg_info_list[info_idx1].line, 1076, Ansi,
08803 arg_info_list[info_idx1].col);
08804
08805 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
08806 }
08807
08808 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_8) {
08809 typeless_idx = Typeless_8;
08810 }
08811 else {
08812 typeless_idx = TYPELESS_DEFAULT_TYPE;
08813 }
08814
08815 # ifdef _TARGET_OS_MAX
08816 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_1 ||
08817 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_2 ||
08818 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_4) {
08819 typeless_idx = Typeless_4;
08820 }
08821 # endif
08822
08823 conform_check(3,
08824 ir_idx,
08825 res_exp_desc,
08826 spec_idx,
08827 FALSE);
08828
08829
08830 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
08831 IR_RANK(ir_idx) = res_exp_desc->rank;
08832
08833 # if 0
08834
08835 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
08836 case Integer_1:
08837 num = BITSIZE_INT1_F90;
08838 break;
08839
08840 case Integer_2:
08841 num = BITSIZE_INT2_F90;
08842 break;
08843
08844 case Integer_4:
08845 num = BITSIZE_INT4_F90;
08846 break;
08847
08848 case Integer_8:
08849 num = BITSIZE_INT8_F90;
08850 break;
08851 }
08852
08853 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
08854
08855 if (ATP_INTRIN_ENUM(*spec_idx) != Ishc_Intrinsic &&
08856 ATP_INTRIN_ENUM(*spec_idx) != Iishc_Intrinsic &&
08857 ATP_INTRIN_ENUM(*spec_idx) != Jishc_Intrinsic &&
08858 ATP_INTRIN_ENUM(*spec_idx) != Kishc_Intrinsic) {
08859 if (IL_IDX(list_idx3) == NULL_IDX) {
08860 IL_FLD(list_idx3) = CN_Tbl_Idx;
08861 IL_IDX(list_idx3) = cn_idx;
08862 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
08863 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
08864
08865 arg_info_list_base = arg_info_list_top;
08866 arg_info_list_top = arg_info_list_base + 1;
08867
08868 if (arg_info_list_top >= arg_info_list_size) {
08869 enlarge_info_list_table();
08870 }
08871
08872 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
08873 arg_info_list[arg_info_list_top] = init_arg_info;
08874 arg_info_list[arg_info_list_top].ed.type_idx =
08875 CG_INTEGER_DEFAULT_TYPE;
08876 arg_info_list[arg_info_list_top].ed.type = Integer;
08877 arg_info_list[arg_info_list_top].ed.linear_type =
08878 CG_INTEGER_DEFAULT_TYPE;
08879 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
08880 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
08881
08882 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
08883 }
08884 else {
08885 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
08886 }
08887 }
08888 else {
08889 NTR_IR_LIST_TBL(list_idx3);
08890 IL_FLD(list_idx3) = CN_Tbl_Idx;
08891 IL_IDX(list_idx3) = cn_idx;
08892 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
08893 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
08894 IL_NEXT_LIST_IDX(list_idx2) = list_idx3;
08895 IR_LIST_CNT_R(ir_idx) = 3;
08896 }
08897
08898 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) !=
08899 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx)) {
08900
08901
08902
08903 COPY_OPND(opnd, IL_OPND(list_idx1));
08904 cast_to_type_idx(&opnd,
08905 &arg_info_list[info_idx1].ed,
08906 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
08907 COPY_OPND(IL_OPND(list_idx1), opnd);
08908 }
08909
08910 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) !=
08911 TYP_LINEAR(arg_info_list[info_idx2].ed.type_idx)) {
08912
08913
08914
08915 COPY_OPND(opnd, IL_OPND(list_idx2));
08916 cast_to_type_idx(&opnd,
08917 &arg_info_list[info_idx2].ed,
08918 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
08919 COPY_OPND(IL_OPND(list_idx2), opnd);
08920 }
08921
08922 if (ATP_INTRIN_ENUM(*spec_idx) != Ishc_Intrinsic &&
08923 ATP_INTRIN_ENUM(*spec_idx) != Iishc_Intrinsic &&
08924 ATP_INTRIN_ENUM(*spec_idx) != Jishc_Intrinsic &&
08925 ATP_INTRIN_ENUM(*spec_idx) != Kishc_Intrinsic) {
08926 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) !=
08927 TYP_LINEAR(arg_info_list[info_idx3].ed.type_idx)) {
08928
08929
08930
08931 COPY_OPND(opnd, IL_OPND(list_idx3));
08932 cast_to_type_idx(&opnd,
08933 &arg_info_list[info_idx3].ed,
08934 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
08935 COPY_OPND(IL_OPND(list_idx3), opnd);
08936 }
08937
08938 if (IL_FLD(list_idx3) == CN_Tbl_Idx) {
08939 if (compare_cn_and_value(IL_IDX(list_idx3), num, Gt_Opr)) {
08940 PRINTMSG(arg_info_list[info_idx3].line, 1062, Error,
08941 arg_info_list[info_idx3].col);
08942 }
08943 }
08944 }
08945
08946 if (IL_FLD(list_idx1) == CN_Tbl_Idx &&
08947 IL_FLD(list_idx2) == CN_Tbl_Idx &&
08948 IL_FLD(list_idx3) == CN_Tbl_Idx) {
08949 fold_it = TRUE;
08950 }
08951
08952 # if defined(GENERATE_WHIRL)
08953
08954 IR_OPR(ir_idx) = Ishftc_Opr;
08955 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
08956 IR_OPND_R(ir_idx) = null_opnd;
08957
08958 # else
08959
08960 line = IR_LINE_NUM(ir_idx);
08961 column = IR_COL_NUM(ir_idx);
08962
08963
08964
08965 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
08966 ATP_RSLT_IDX(*spec_idx)))] * 2;
08967 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
08968
08969 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
08970 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
08971 IL_FLD(list_idx3), IL_IDX(list_idx3));
08972
08973 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
08974 Mask_Opr, typeless_idx, line, column,
08975 NO_Tbl_Idx, NULL_IDX);
08976
08977 COPY_OPND(opnd, IL_OPND(list_idx1));
08978 cast_opnd_to_type_idx(&opnd, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
08979 COPY_OPND(IL_OPND(list_idx1), opnd);
08980
08981 band1_idx = gen_ir(IR_Tbl_Idx, mask_idx,
08982 Band_Opr, typeless_idx, line, column,
08983 IL_FLD(list_idx1), IL_IDX(list_idx1));
08984
08985
08986
08987 num =storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
08988
08989 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
08990
08991 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
08992 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
08993 IL_FLD(list_idx2), IL_IDX(list_idx2));
08994
08995 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
08996 Mask_Opr, typeless_idx, line, column,
08997 NO_Tbl_Idx, NULL_IDX);
08998
08999 num =storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
09000
09001 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09002
09003 COPY_OPND(opnd, IL_OPND(list_idx2));
09004 copy_subtree(&opnd, &opnd);
09005
09006 plus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09007 Plus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09008 OPND_FLD(opnd), OPND_IDX(opnd));
09009
09010 num = storage_bit_size_tbl[TYP_LINEAR(
09011 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))] - 1;
09012
09013 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09014
09015 band_idx = gen_ir(IR_Tbl_Idx, plus_idx,
09016 Band_Opr, typeless_idx, line, column,
09017 CN_Tbl_Idx, cn_idx);
09018
09019 NTR_IR_LIST_TBL(first_idx);
09020 IL_FLD(first_idx) = IR_Tbl_Idx;
09021 IL_IDX(first_idx) = band1_idx;
09022 NTR_IR_LIST_TBL(second_idx);
09023 IL_FLD(second_idx) = IR_Tbl_Idx;
09024 IL_IDX(second_idx) = band_idx;
09025 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09026
09027 shift_idx = gen_ir(IL_Tbl_Idx, first_idx,
09028 Shift_Opr, typeless_idx, line, column,
09029 NO_Tbl_Idx, NULL_IDX);
09030
09031 ishft1_idx = gen_ir(IR_Tbl_Idx, shift_idx,
09032 Band_Opr, typeless_idx, line, column,
09033 IR_Tbl_Idx, mask_idx);
09034
09035
09036
09037 COPY_OPND(opnd, IL_OPND(list_idx2));
09038 copy_subtree(&opnd, &opnd);
09039
09040 abs_idx = gen_ir(OPND_FLD(opnd), OPND_IDX(opnd),
09041 Abs_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09042 NO_Tbl_Idx, NULL_IDX);
09043
09044 COPY_OPND(opnd, IL_OPND(list_idx3));
09045 copy_subtree(&opnd, &opnd);
09046
09047 minus_idx = gen_ir(IR_Tbl_Idx, abs_idx,
09048 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09049 OPND_FLD(opnd), OPND_IDX(opnd));
09050
09051 NTR_IR_LIST_TBL(first_idx);
09052 IL_FLD(first_idx) = IR_Tbl_Idx;
09053 IL_IDX(first_idx) = minus_idx;
09054 NTR_IR_LIST_TBL(second_idx);
09055
09056 COPY_OPND(opnd, IL_OPND(list_idx2));
09057 copy_subtree(&opnd, &opnd);
09058
09059 COPY_OPND(IL_OPND(second_idx), opnd);
09060 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09061
09062 sign_idx = gen_ir(IL_Tbl_Idx, first_idx,
09063 Sign_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09064 NO_Tbl_Idx, NULL_IDX);
09065
09066 uminus_idx = gen_ir(IR_Tbl_Idx, sign_idx,
09067 Uminus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09068 NO_Tbl_Idx, NULL_IDX);
09069
09070
09071
09072 num =storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
09073
09074 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09075
09076 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09077 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09078 IR_Tbl_Idx, uminus_idx);
09079
09080 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
09081 Mask_Opr, typeless_idx, line, column,
09082 NO_Tbl_Idx, NULL_IDX);
09083
09084 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
09085 ATP_RSLT_IDX(*spec_idx)))];
09086
09087 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09088
09089 plus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09090 Plus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09091 IR_Tbl_Idx, uminus_idx);
09092
09093 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
09094 ATP_RSLT_IDX(*spec_idx)))] - 1;
09095
09096 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09097
09098 band_idx = gen_ir(IR_Tbl_Idx, plus_idx,
09099 Band_Opr, typeless_idx, line, column,
09100 CN_Tbl_Idx, cn_idx);
09101
09102 NTR_IR_LIST_TBL(first_idx);
09103 IL_FLD(first_idx) = IR_Tbl_Idx;
09104 IL_IDX(first_idx) = band1_idx;
09105 NTR_IR_LIST_TBL(second_idx);
09106 IL_FLD(second_idx) = IR_Tbl_Idx;
09107 IL_IDX(second_idx) = band_idx;
09108 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09109
09110 shift_idx = gen_ir(IL_Tbl_Idx, first_idx,
09111 Shift_Opr, typeless_idx, line, column,
09112 NO_Tbl_Idx, NULL_IDX);
09113
09114 ishft2_idx = gen_ir(IR_Tbl_Idx, shift_idx,
09115 Band_Opr, typeless_idx, line, column,
09116 IR_Tbl_Idx, mask_idx);
09117
09118
09119
09120 ior_idx = gen_ir(IR_Tbl_Idx, ishft1_idx,
09121 Bor_Opr, typeless_idx, line, column,
09122 IR_Tbl_Idx, ishft2_idx);
09123
09124
09125
09126 num =storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))];
09127
09128 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09129
09130 COPY_OPND(opnd, IL_OPND(list_idx3));
09131 copy_subtree(&opnd, &opnd);
09132
09133 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09134 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09135 OPND_FLD(opnd), OPND_IDX(opnd));
09136
09137 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
09138 Mask_Opr, typeless_idx, line, column,
09139 NO_Tbl_Idx, NULL_IDX);
09140
09141
09142
09143 NTR_IR_LIST_TBL(first_idx);
09144 IL_ARG_DESC_VARIANT(first_idx) = TRUE;
09145 COPY_OPND(opnd, IL_OPND(list_idx1));
09146 copy_subtree(&opnd, &opnd);
09147 COPY_OPND(IL_OPND(first_idx), opnd);
09148
09149 NTR_IR_LIST_TBL(second_idx);
09150 IL_ARG_DESC_VARIANT(second_idx) = TRUE;
09151 IL_FLD(second_idx) = IR_Tbl_Idx;
09152 IL_IDX(second_idx) = ior_idx;
09153
09154 NTR_IR_LIST_TBL(third_idx);
09155 IL_ARG_DESC_VARIANT(third_idx) = TRUE;
09156 IL_FLD(third_idx) = IR_Tbl_Idx;
09157 IL_IDX(third_idx) = mask_idx;
09158
09159 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09160 IL_NEXT_LIST_IDX(second_idx) = third_idx;
09161
09162 csmg_idx = gen_ir(IL_Tbl_Idx, first_idx,
09163 Csmg_Opr, typeless_idx, line, column,
09164 NO_Tbl_Idx, NULL_IDX);
09165
09166 num = storage_bit_size_tbl[TYP_LINEAR(ATD_TYPE_IDX(
09167 ATP_RSLT_IDX(*spec_idx)))];
09168
09169 cn_idx = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09170
09171 switch (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)))) {
09172 case Integer_1:
09173 num = BITSIZE_INT1_F90;
09174 break;
09175
09176 case Integer_2:
09177 num = BITSIZE_INT2_F90;
09178 break;
09179
09180 case Integer_4:
09181 num = BITSIZE_INT4_F90;
09182 break;
09183
09184 case Integer_8:
09185 num = BITSIZE_INT8_F90;
09186 break;
09187 }
09188
09189 cn_idx2 = C_INT_TO_CN(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)), num);
09190
09191 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09192 Minus_Opr, ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)),line,column,
09193 CN_Tbl_Idx, cn_idx2);
09194
09195 NTR_IR_LIST_TBL(first_idx);
09196 IL_FLD(first_idx) = IR_Tbl_Idx;
09197 IL_IDX(first_idx) = csmg_idx;
09198 NTR_IR_LIST_TBL(second_idx);
09199 IL_FLD(second_idx) = IR_Tbl_Idx;
09200 IL_IDX(second_idx) = minus_idx;
09201 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09202
09203 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
09204 Shiftl_Opr, typeless_idx, line, column,
09205 NO_Tbl_Idx, NULL_IDX);
09206
09207 NTR_IR_LIST_TBL(first_idx);
09208 IL_FLD(first_idx) = IR_Tbl_Idx;
09209 IL_IDX(first_idx) = shiftl_idx;
09210 NTR_IR_LIST_TBL(second_idx);
09211 IL_FLD(second_idx) = IR_Tbl_Idx;
09212 IL_IDX(second_idx) = minus_idx;
09213 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09214
09215 shifta_idx = gen_ir(IL_Tbl_Idx, first_idx,
09216 Shifta_Opr, typeless_idx, line, column,
09217 NO_Tbl_Idx, NULL_IDX);
09218
09219 IR_OPR(ir_idx) = Cvrt_Opr;
09220 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
09221 IR_FLD_L(ir_idx) = IR_Tbl_Idx;
09222 IR_IDX_L(ir_idx) = shifta_idx;
09223 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
09224 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
09225 IR_OPND_R(ir_idx) = null_opnd;
09226
09227 # endif
09228
09229 if (fold_it) {
09230 COPY_OPND(opnd, (*result_opnd));
09231 fold_aggragate_expression(&opnd, res_exp_desc, FALSE);
09232 COPY_OPND((*result_opnd), opnd);
09233 }
09234
09235 # endif
09236
09237 res_exp_desc->foldable = FALSE;
09238 res_exp_desc->will_fold_later = FALSE;
09239
09240 TRACE (Func_Exit, "ishftc_intrinsic", NULL);
09241
09242 }
09243
09244
09245
09246
09247
09248
09249
09250
09251
09252
09253
09254
09255
09256
09257
09258
09259
09260
09261
09262
09263
09264 void mvbits_intrinsic(opnd_type *result_opnd,
09265 expr_arg_type *res_exp_desc,
09266 int *spec_idx)
09267 {
09268 int info_idx1;
09269 int info_idx2;
09270 int info_idx3;
09271 int info_idx4;
09272 int info_idx5;
09273 int ir_idx;
09274 int list_idx1;
09275 int list_idx2;
09276 int list_idx3;
09277 int list_idx4;
09278 int list_idx5;
09279 int mask_idx;
09280 int minus_idx;
09281 int shiftr_idx;
09282 int shiftl_idx;
09283 int shiftl1_idx;
09284 int shiftl2_idx;
09285 int csmg_idx;
09286 int band_idx;
09287 int first_idx;
09288 int second_idx;
09289 int third_idx;
09290 int cn_idx;
09291 int u_idx;
09292 int type_idx;
09293 int typeless_idx;
09294 opnd_type opnd;
09295 opnd_type left_hand_side_opnd;
09296 int line;
09297 int column;
09298 long num;
09299
09300
09301 TRACE (Func_Entry, "mvbits_intrinsic", NULL);
09302
09303 ir_idx = OPND_IDX((*result_opnd));
09304
09305 conform_check(0,
09306 ir_idx,
09307 res_exp_desc,
09308 spec_idx,
09309 FALSE);
09310
09311
09312 list_idx1 = IR_IDX_R(ir_idx);
09313 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
09314 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
09315 list_idx4 = IL_NEXT_LIST_IDX(list_idx3);
09316 list_idx5 = IL_NEXT_LIST_IDX(list_idx4);
09317
09318 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
09319 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
09320 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
09321 info_idx4 = IL_ARG_DESC_IDX(list_idx4);
09322 info_idx5 = IL_ARG_DESC_IDX(list_idx5);
09323
09324 if (TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx) !=
09325 TYP_LINEAR(arg_info_list[info_idx4].ed.type_idx)) {
09326 PRINTMSG(arg_info_list[info_idx1].line, 727, Error,
09327 arg_info_list[info_idx1].col);
09328 }
09329
09330 if (arg_info_list[info_idx1].ed.linear_type == Integer_8 ||
09331 arg_info_list[info_idx4].ed.linear_type == Integer_8) {
09332 type_idx = Integer_8;
09333 }
09334 else {
09335 type_idx = INTEGER_DEFAULT_TYPE;
09336 }
09337
09338 if (TYP_LINEAR(type_idx) == Integer_8) {
09339 typeless_idx = Typeless_8;
09340 }
09341 else {
09342 typeless_idx = TYPELESS_DEFAULT_TYPE;
09343 }
09344
09345 # ifdef _TARGET_OS_MAX
09346 if (TYP_LINEAR(type_idx) == Integer_1 ||
09347 TYP_LINEAR(type_idx) == Integer_2 ||
09348 TYP_LINEAR(type_idx) == Integer_4) {
09349 typeless_idx = Typeless_4;
09350 }
09351 # endif
09352
09353 if (res_exp_desc->rank != arg_info_list[info_idx4].ed.rank) {
09354 PRINTMSG(arg_info_list[info_idx4].line, 1093, Error,
09355 arg_info_list[info_idx4].col);
09356 }
09357
09358 # if 0
09359
09360 if (TYP_LINEAR(type_idx) !=
09361 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx)) {
09362
09363
09364
09365 COPY_OPND(opnd, IL_OPND(list_idx1));
09366 cast_to_type_idx(&opnd,
09367 &arg_info_list[info_idx1].ed,
09368 type_idx);
09369 COPY_OPND(IL_OPND(list_idx1), opnd);
09370
09371 }
09372
09373 if (TYP_LINEAR(type_idx) !=
09374 TYP_LINEAR(arg_info_list[info_idx2].ed.type_idx)) {
09375
09376
09377
09378 COPY_OPND(opnd, IL_OPND(list_idx2));
09379 cast_to_type_idx(&opnd,
09380 &arg_info_list[info_idx2].ed,
09381 type_idx);
09382 COPY_OPND(IL_OPND(list_idx2), opnd);
09383
09384 }
09385
09386 if (TYP_LINEAR(type_idx) !=
09387 TYP_LINEAR(arg_info_list[info_idx3].ed.type_idx)) {
09388
09389
09390
09391 COPY_OPND(opnd, IL_OPND(list_idx3));
09392 cast_to_type_idx(&opnd,
09393 &arg_info_list[info_idx3].ed,
09394 type_idx);
09395 COPY_OPND(IL_OPND(list_idx3), opnd);
09396
09397 }
09398
09399
09400
09401 COPY_OPND(left_hand_side_opnd, IL_OPND(list_idx4));
09402
09403 if (TYP_LINEAR(type_idx) !=
09404 TYP_LINEAR(arg_info_list[info_idx4].ed.type_idx)) {
09405
09406
09407
09408 COPY_OPND(opnd, IL_OPND(list_idx4));
09409 cast_to_type_idx(&opnd,
09410 &arg_info_list[info_idx4].ed,
09411 type_idx);
09412 COPY_OPND(IL_OPND(list_idx4), opnd);
09413
09414 }
09415
09416 if (TYP_LINEAR(type_idx) !=
09417 TYP_LINEAR(arg_info_list[info_idx5].ed.type_idx)) {
09418
09419
09420
09421 COPY_OPND(opnd, IL_OPND(list_idx5));
09422 cast_to_type_idx(&opnd,
09423 &arg_info_list[info_idx5].ed,
09424 type_idx);
09425 COPY_OPND(IL_OPND(list_idx5), opnd);
09426
09427 }
09428
09429 line = IR_LINE_NUM(ir_idx);
09430 column = IR_COL_NUM(ir_idx);
09431
09432
09433
09434 num = storage_bit_size_tbl[TYP_LINEAR(typeless_idx)] * 2;
09435 cn_idx = C_INT_TO_CN(type_idx, num);
09436
09437 minus_idx = gen_ir(CN_Tbl_Idx, cn_idx,
09438 Minus_Opr, type_idx, line, column,
09439 IL_FLD(list_idx3), IL_IDX(list_idx3));
09440
09441 mask_idx = gen_ir(IR_Tbl_Idx, minus_idx,
09442 Mask_Opr, typeless_idx, line, column,
09443 NO_Tbl_Idx, NULL_IDX);
09444
09445 NTR_IR_LIST_TBL(first_idx);
09446 IL_FLD(first_idx) = IR_Tbl_Idx;
09447 IL_IDX(first_idx) = mask_idx;
09448 NTR_IR_LIST_TBL(second_idx);
09449 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx5));
09450 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09451
09452 shiftl1_idx = gen_ir(IL_Tbl_Idx, first_idx,
09453 Shiftl_Opr, typeless_idx, line, column,
09454 NO_Tbl_Idx, NULL_IDX);
09455
09456
09457 NTR_IR_LIST_TBL(first_idx);
09458 IL_FLD(first_idx) = IR_Tbl_Idx;
09459 IL_IDX(first_idx) = mask_idx;
09460 NTR_IR_LIST_TBL(second_idx);
09461 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx2));
09462 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09463
09464 shiftl2_idx = gen_ir(IL_Tbl_Idx, first_idx,
09465 Shiftl_Opr, typeless_idx, line, column,
09466 NO_Tbl_Idx, NULL_IDX);
09467
09468 band_idx = gen_ir(IR_Tbl_Idx, shiftl2_idx,
09469 Band_Opr, typeless_idx, line, column,
09470 IL_FLD(list_idx1), IL_IDX(list_idx1));
09471
09472 NTR_IR_LIST_TBL(first_idx);
09473 IL_FLD(first_idx) = IR_Tbl_Idx;
09474 IL_IDX(first_idx) = band_idx;
09475 NTR_IR_LIST_TBL(second_idx);
09476 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx2));
09477 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09478
09479 shiftr_idx = gen_ir(IL_Tbl_Idx, first_idx,
09480 Shiftr_Opr, typeless_idx, line, column,
09481 NO_Tbl_Idx, NULL_IDX);
09482
09483 NTR_IR_LIST_TBL(first_idx);
09484 IL_FLD(first_idx) = IR_Tbl_Idx;
09485 IL_IDX(first_idx) = shiftr_idx;
09486 NTR_IR_LIST_TBL(second_idx);
09487 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx5));
09488 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09489
09490 shiftl_idx = gen_ir(IL_Tbl_Idx, first_idx,
09491 Shiftl_Opr, typeless_idx, line, column,
09492 NO_Tbl_Idx, NULL_IDX);
09493
09494
09495
09496 NTR_IR_LIST_TBL(first_idx);
09497 IL_ARG_DESC_VARIANT(first_idx) = TRUE;
09498 IL_FLD(first_idx) = IR_Tbl_Idx;
09499 IL_IDX(first_idx) = shiftl_idx;
09500
09501 NTR_IR_LIST_TBL(second_idx);
09502 IL_ARG_DESC_VARIANT(second_idx) = TRUE;
09503 COPY_OPND(IL_OPND(second_idx), IL_OPND(list_idx4));
09504
09505 NTR_IR_LIST_TBL(third_idx);
09506 IL_ARG_DESC_VARIANT(third_idx) = TRUE;
09507 IL_FLD(third_idx) = IR_Tbl_Idx;
09508 IL_IDX(third_idx) = shiftl1_idx;
09509
09510 IL_NEXT_LIST_IDX(first_idx) = second_idx;
09511 IL_NEXT_LIST_IDX(second_idx) = third_idx;
09512
09513 csmg_idx = gen_ir(IL_Tbl_Idx, first_idx,
09514 Csmg_Opr, typeless_idx, line, column,
09515 NO_Tbl_Idx, NULL_IDX);
09516
09517 u_idx = gen_ir(IR_Tbl_Idx, csmg_idx,
09518 Cvrt_Unsigned_Opr, type_idx, line, column,
09519 NO_Tbl_Idx, NULL_IDX);
09520
09521 IR_OPR(ir_idx) = Asg_Opr;
09522 # if defined(GENERATE_WHIRL)
09523 IR_OPR(ir_idx) = Mvbits_Opr;
09524 # else
09525 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
09526 IR_IDX_R(ir_idx) = u_idx;
09527 # endif
09528
09529 IR_TYPE_IDX(ir_idx) = type_idx;
09530 COPY_OPND(IR_OPND_L(ir_idx), left_hand_side_opnd);
09531
09532
09533
09534
09535 # endif
09536
09537 res_exp_desc->foldable = FALSE;
09538 res_exp_desc->will_fold_later = FALSE;
09539
09540 TRACE (Func_Exit, "mvbits_intrinsic", NULL);
09541
09542 }
09543
09544
09545
09546
09547
09548
09549
09550
09551
09552
09553
09554
09555
09556
09557
09558
09559
09560
09561 void exit_intrinsic(opnd_type *result_opnd,
09562 expr_arg_type *res_exp_desc,
09563 int *spec_idx)
09564 {
09565 int ir_idx;
09566
09567
09568 TRACE (Func_Entry, "exit_intrinsic", NULL);
09569
09570 ir_idx = OPND_IDX((*result_opnd));
09571 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
09572
09573
09574
09575
09576 res_exp_desc->foldable = FALSE;
09577 res_exp_desc->will_fold_later = FALSE;
09578
09579 TRACE (Func_Exit, "exit_intrinsic", NULL);
09580
09581 }
09582
09583
09584
09585
09586
09587
09588
09589
09590
09591
09592
09593
09594
09595
09596
09597
09598
09599
09600
09601 void system_clock_intrinsic(opnd_type *result_opnd,
09602 expr_arg_type *res_exp_desc,
09603 int *spec_idx)
09604 {
09605 int ir_idx;
09606 int info_idx1;
09607 int info_idx2;
09608 int info_idx3;
09609 int list_idx1;
09610 int list_idx2;
09611 int list_idx3;
09612
09613
09614 TRACE (Func_Entry, "system_clock_intrinsic", NULL);
09615
09616 ir_idx = OPND_IDX((*result_opnd));
09617 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
09618
09619 list_idx1 = IR_IDX_R(ir_idx);
09620 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
09621 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
09622
09623 if ((list_idx3 != NULL_IDX) && (IL_IDX(list_idx3) != NULL_IDX)) {
09624 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
09625 if (arg_info_list[info_idx3].ed.type_idx != INTEGER_DEFAULT_TYPE) {
09626 PRINTMSG(arg_info_list[info_idx3].line, 1533, Error,
09627 arg_info_list[info_idx3].col);
09628 }
09629 }
09630
09631 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
09632 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
09633 if (arg_info_list[info_idx2].ed.type_idx != INTEGER_DEFAULT_TYPE) {
09634 PRINTMSG(arg_info_list[info_idx2].line, 1533, Error,
09635 arg_info_list[info_idx2].col);
09636 }
09637 }
09638
09639 if ((list_idx1 != NULL_IDX) && (IL_IDX(list_idx1) != NULL_IDX)) {
09640 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
09641 if (arg_info_list[info_idx1].ed.type_idx != INTEGER_DEFAULT_TYPE) {
09642 PRINTMSG(arg_info_list[info_idx1].line, 1533, Error,
09643 arg_info_list[info_idx1].col);
09644 }
09645 }
09646
09647
09648
09649
09650 res_exp_desc->foldable = FALSE;
09651 res_exp_desc->will_fold_later = FALSE;
09652
09653 TRACE (Func_Exit, "system_clock_intrinsic", NULL);
09654
09655 }
09656
09657
09658
09659
09660
09661
09662
09663
09664
09665
09666
09667
09668
09669
09670
09671
09672
09673
09674
09675 void idate_intrinsic(opnd_type *result_opnd,
09676 expr_arg_type *res_exp_desc,
09677 int *spec_idx)
09678 {
09679 int ir_idx;
09680 int info_idx1;
09681 int info_idx2;
09682 int info_idx3;
09683 int list_idx1;
09684 int list_idx2;
09685 int list_idx3;
09686
09687 TRACE (Func_Entry, "idate_intrinsic", NULL);
09688
09689 ir_idx = OPND_IDX((*result_opnd));
09690
09691 list_idx1 = IR_IDX_R(ir_idx);
09692 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
09693 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
09694 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
09695 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
09696 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
09697
09698 if (IL_FLD(list_idx1) == CN_Tbl_Idx) {
09699 PRINTMSG(arg_info_list[info_idx1].line, 1650, Error,
09700 arg_info_list[info_idx1].col);
09701 }
09702
09703 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
09704 PRINTMSG(arg_info_list[info_idx2].line, 1650, Error,
09705 arg_info_list[info_idx2].col);
09706 }
09707
09708 if (IL_FLD(list_idx3) == CN_Tbl_Idx) {
09709 PRINTMSG(arg_info_list[info_idx3].line, 1650, Error,
09710 arg_info_list[info_idx3].col);
09711 }
09712
09713
09714
09715
09716
09717 res_exp_desc->foldable = FALSE;
09718 res_exp_desc->will_fold_later = FALSE;
09719
09720 TRACE (Func_Exit, "idate_intrinsic", NULL);
09721
09722 }
09723
09724
09725
09726
09727
09728
09729
09730
09731
09732
09733
09734
09735
09736
09737
09738
09739
09740
09741
09742 void random_seed_intrinsic(opnd_type *result_opnd,
09743 expr_arg_type *res_exp_desc,
09744 int *spec_idx)
09745 {
09746 int ir_idx;
09747 int cn_idx;
09748 int info_idx1;
09749 int info_idx2;
09750 int info_idx3;
09751 int list_idx1;
09752 int list_idx2;
09753 int list_idx3;
09754 int loc_idx;
09755 int ranget_idx;
09756 int ranset_idx;
09757 int ranf_idx;
09758 int tmp_attr;
09759 int unused1 = NULL_IDX;
09760 int unused2 = NULL_IDX;
09761 opnd_type old_opnd;
09762 opnd_type base_opnd;
09763 int line;
09764 int column;
09765
09766
09767 TRACE (Func_Entry, "random_seed_intrinsic", NULL);
09768
09769 ir_idx = OPND_IDX((*result_opnd));
09770 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
09771
09772 line = IR_LINE_NUM(ir_idx);
09773 column = IR_COL_NUM(ir_idx);
09774
09775 list_idx1 = IR_IDX_R(ir_idx);
09776 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
09777 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
09778
09779 if (((IL_IDX(list_idx1) != NULL_IDX) &&
09780 (IL_IDX(list_idx2) != NULL_IDX)) ||
09781 ((IL_IDX(list_idx1) != NULL_IDX) &&
09782 (IL_IDX(list_idx3) != NULL_IDX)) ||
09783 ((IL_IDX(list_idx2) != NULL_IDX) &&
09784 (IL_IDX(list_idx3) != NULL_IDX))) {
09785 PRINTMSG(IR_LINE_NUM(ir_idx), 830, Error,
09786 IR_COL_NUM(ir_idx));
09787 }
09788
09789
09790 if ((list_idx3 != NULL_IDX) && (IL_IDX(list_idx3) != NULL_IDX)) {
09791
09792 COPY_OPND(old_opnd, IL_OPND(list_idx3));
09793 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
09794
09795 if (IL_FLD(list_idx3) == CN_Tbl_Idx) {
09796 PRINTMSG(arg_info_list[info_idx3].line, 1214, Error,
09797 arg_info_list[info_idx3].col);
09798 }
09799
09800
09801 if (! arg_info_list[info_idx3].ed.reference &&
09802 ! arg_info_list[info_idx3].ed.tmp_reference) {
09803
09804 # if 0
09805
09806 tmp_attr = create_tmp_asg(&old_opnd,
09807 (expr_arg_type *)&(arg_info_list[info_idx3].ed),
09808 &base_opnd,
09809 Intent_In,
09810 TRUE,
09811 FALSE);
09812
09813 COPY_OPND(old_opnd, base_opnd);
09814 # endif
09815
09816 }
09817
09818 if (arg_info_list[info_idx3].ed.rank > 0) {
09819
09820 }
09821 else {
09822
09823 }
09824
09825 # if 0
09826 loc_idx = gen_ir(OPND_FLD(base_opnd), OPND_IDX(base_opnd),
09827 Aloc_Opr, CRI_Ptr_8, line, column,
09828 NO_Tbl_Idx, NULL_IDX);
09829
09830 ranget_idx = gen_ir(IR_Tbl_Idx, loc_idx,
09831 Ranget_Opr, TYPELESS_DEFAULT_TYPE, line, column,
09832 NO_Tbl_Idx, NULL_IDX);
09833
09834 IR_OPR(ir_idx) = Asg_Opr;
09835 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_L(loc_idx));
09836 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
09837 IR_IDX_R(ir_idx) = ranget_idx;
09838 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
09839 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);
09840
09841 # endif
09842
09843 }
09844 else if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
09845
09846 COPY_OPND(old_opnd, IL_OPND(list_idx2));
09847 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
09848
09849 if (! arg_info_list[info_idx2].ed.reference &&
09850 ! arg_info_list[info_idx2].ed.tmp_reference) {
09851
09852 # if 0
09853
09854 tmp_attr = create_tmp_asg(&old_opnd,
09855 (expr_arg_type *)&(arg_info_list[info_idx2].ed),
09856 &base_opnd,
09857 Intent_In,
09858 TRUE,
09859 FALSE);
09860
09861 COPY_OPND(old_opnd, base_opnd);
09862 # endif
09863 }
09864
09865 if (arg_info_list[info_idx2].ed.rank > 0) {
09866
09867 }
09868 else {
09869
09870 }
09871
09872 # if 0
09873
09874 ranset_idx = gen_ir(OPND_FLD(base_opnd), OPND_IDX(base_opnd),
09875 Ranset_Opr, TYPELESS_DEFAULT_TYPE, line, column,
09876 NO_Tbl_Idx, NULL_IDX);
09877
09878 IR_OPR(ir_idx) = Asg_Opr;
09879 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_L(ranset_idx));
09880 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
09881 IR_IDX_R(ir_idx) = ranset_idx;
09882 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
09883 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);
09884
09885 # endif
09886
09887 }
09888 else if ((list_idx1 != NULL_IDX) && (IL_IDX(list_idx1) != NULL_IDX)) {
09889 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
09890
09891 if (IL_FLD(list_idx1) == CN_Tbl_Idx) {
09892 PRINTMSG(arg_info_list[info_idx1].line, 1214, Error,
09893 arg_info_list[info_idx1].col);
09894 }
09895
09896 # if 0
09897
09898 # if defined(GENERATE_WHIRL)
09899 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 64);
09900 # else
09901 cn_idx = CN_INTEGER_ONE_IDX;
09902 # endif
09903
09904 IR_OPR(ir_idx) = Asg_Opr;
09905 COPY_OPND(IR_OPND_L(ir_idx), IL_OPND(list_idx1));
09906 IR_FLD_R(ir_idx) = CN_Tbl_Idx;
09907 IR_IDX_R(ir_idx) = cn_idx;
09908 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
09909 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);
09910
09911 # endif
09912
09913 }
09914 else {
09915
09916 # if 0
09917 ranf_idx = gen_ir(NO_Tbl_Idx, NULL_IDX,
09918 Ranf_Opr, REAL_DEFAULT_TYPE, line, column,
09919 NO_Tbl_Idx, NULL_IDX);
09920
09921 tree_has_ranf = TRUE;
09922
09923 tmp_attr = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
09924 IR_COL_NUM(ir_idx),
09925 Priv, TRUE);
09926 ATD_STOR_BLK_IDX(tmp_attr) = SCP_SB_STACK_IDX(curr_scp_idx);
09927 ATD_TYPE_IDX(tmp_attr) = REAL_DEFAULT_TYPE;
09928 AT_SEMANTICS_DONE(tmp_attr) = TRUE;
09929
09930 IR_OPR(ir_idx) = Asg_Opr;
09931 IR_FLD_L(ir_idx) = AT_Tbl_Idx;
09932 IR_IDX_L(ir_idx) = tmp_attr;
09933 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
09934 IR_IDX_R(ir_idx) = ranf_idx;
09935 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
09936 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
09937
09938 # endif
09939
09940 }
09941
09942
09943
09944
09945 res_exp_desc->foldable = FALSE;
09946 res_exp_desc->will_fold_later = FALSE;
09947
09948 TRACE (Func_Exit, "random_seed_intrinsic", NULL);
09949
09950 }
09951
09952
09953
09954
09955
09956
09957
09958
09959
09960
09961
09962
09963
09964
09965
09966
09967
09968
09969
09970
09971
09972
09973
09974
09975
09976 void get_ieee_status_intrinsic(opnd_type *result_opnd,
09977 expr_arg_type *res_exp_desc,
09978 int *spec_idx)
09979 {
09980 int idx;
09981 int idx1;
09982 int ir_idx;
09983 int info_idx1;
09984 int list_idx1;
09985 int line;
09986 int column;
09987
09988
09989 TRACE (Func_Entry, "get_ieee_status_intrinsic", NULL);
09990
09991 ir_idx = OPND_IDX((*result_opnd));
09992 list_idx1 = IR_IDX_R(ir_idx);
09993 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
09994
09995 line = IR_LINE_NUM(ir_idx);
09996 column = IR_COL_NUM(ir_idx);
09997
09998 conform_check(0,
09999 ir_idx,
10000 res_exp_desc,
10001 spec_idx,
10002 FALSE);
10003
10004 # if 0
10005
10006 switch (ATP_INTRIN_ENUM(*spec_idx)) {
10007
10008 case Get_Ieee_Status_Intrinsic:
10009 IR_OPR(ir_idx) = Asg_Opr;
10010 COPY_OPND(IR_OPND_L(ir_idx), IL_OPND(list_idx1));
10011
10012 NTR_IR_LIST_TBL(idx1);
10013 IL_FLD(idx1) = CN_Tbl_Idx;
10014 IL_IDX(idx1) = CN_INTEGER_ZERO_IDX;
10015 IL_LINE_NUM(idx1) = IR_LINE_NUM(ir_idx);
10016 IL_COL_NUM(idx1) = IR_COL_NUM(ir_idx);
10017
10018 idx = gen_ir(IL_Tbl_Idx, idx1,
10019 Get_Ieee_Status_Opr, arg_info_list[info_idx1].ed.type_idx,
10020 line, column,
10021 NO_Tbl_Idx, NULL_IDX);
10022
10023 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10024 IR_IDX_R(ir_idx) = idx;
10025 break;
10026
10027 case Set_Ieee_Status_Intrinsic:
10028 IR_OPR(ir_idx) = Set_Ieee_Status_Opr;
10029 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10030 IR_IDX_R(ir_idx) = NULL_IDX;
10031 IR_FLD_R(ir_idx) = NO_Tbl_Idx;
10032 break;
10033
10034 case Get_Ieee_Exceptions_Intrinsic:
10035 IR_OPR(ir_idx) = Asg_Opr;
10036 COPY_OPND(IR_OPND_L(ir_idx), IL_OPND(list_idx1));
10037
10038 idx = gen_ir(NO_Tbl_Idx, NULL_IDX,
10039 Get_Ieee_Exceptions_Opr, arg_info_list[info_idx1].ed.type_idx,
10040 line, column,
10041 NO_Tbl_Idx, NULL_IDX);
10042
10043 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10044 IR_IDX_R(ir_idx) = idx;
10045 break;
10046
10047 case Set_Ieee_Exceptions_Intrinsic:
10048 IR_OPR(ir_idx) = Set_Ieee_Exceptions_Opr;
10049 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10050 IR_OPND_R(ir_idx) = null_opnd;
10051 break;
10052
10053 case Get_Ieee_Interrupts_Intrinsic:
10054 IR_OPR(ir_idx) = Asg_Opr;
10055 COPY_OPND(IR_OPND_L(ir_idx), IL_OPND(list_idx1));
10056
10057 idx = gen_ir(NO_Tbl_Idx, NULL_IDX,
10058 Get_Ieee_Interrupts_Opr, arg_info_list[info_idx1].ed.type_idx,
10059 line, column,
10060 NO_Tbl_Idx, NULL_IDX);
10061
10062 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10063 IR_IDX_R(ir_idx) = idx;
10064 break;
10065
10066 case Set_Ieee_Interrupts_Intrinsic:
10067 IR_OPR(ir_idx) = Set_Ieee_Interrupts_Opr;
10068 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10069 IR_OPND_R(ir_idx) = null_opnd;
10070 break;
10071
10072 case Get_Ieee_Rounding_Mode_Intrinsic:
10073 IR_OPR(ir_idx) = Asg_Opr;
10074 COPY_OPND(IR_OPND_L(ir_idx), IL_OPND(list_idx1));
10075
10076 idx = gen_ir(NO_Tbl_Idx, NULL_IDX,
10077 Get_Ieee_Rounding_Mode_Opr,
10078 arg_info_list[info_idx1].ed.type_idx, line, column,
10079 NO_Tbl_Idx, NULL_IDX);
10080
10081 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10082 IR_IDX_R(ir_idx) = idx;
10083 break;
10084
10085 case Set_Ieee_Rounding_Mode_Intrinsic:
10086 IR_OPR(ir_idx) = Set_Ieee_Rounding_Mode_Opr;
10087 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10088 IR_OPND_R(ir_idx) = null_opnd;
10089 break;
10090 }
10091
10092 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
10093 IR_RANK(ir_idx) = res_exp_desc->rank;
10094
10095 # endif
10096
10097
10098
10099
10100 res_exp_desc->foldable = FALSE;
10101 res_exp_desc->will_fold_later = FALSE;
10102
10103
10104 TRACE (Func_Exit, "get_ieee_status_intrinsic", NULL);
10105
10106 }
10107
10108
10109
10110
10111
10112
10113
10114
10115
10116
10117
10118
10119
10120
10121
10122
10123
10124
10125
10126 void test_ieee_interrupt_intrinsic(opnd_type *result_opnd,
10127 expr_arg_type *res_exp_desc,
10128 int *spec_idx)
10129 {
10130 int ir_idx;
10131
10132
10133 TRACE (Func_Entry, "test_ieee_interrupt_intrinsic", NULL);
10134
10135 ir_idx = OPND_IDX((*result_opnd));
10136 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
10137
10138 conform_check(0,
10139 ir_idx,
10140 res_exp_desc,
10141 spec_idx,
10142 FALSE);
10143
10144 # if 0
10145
10146 switch (ATP_INTRIN_ENUM(*spec_idx)) {
10147
10148 case Test_Ieee_Interrupt_Intrinsic:
10149 IR_OPR(ir_idx) = Test_Ieee_Interrupt_Opr;
10150 break;
10151
10152 case Test_Ieee_Exception_Intrinsic:
10153 IR_OPR(ir_idx) = Test_Ieee_Exception_Opr;
10154 break;
10155 }
10156
10157 # endif
10158
10159 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
10160 IR_RANK(ir_idx) = res_exp_desc->rank;
10161
10162 #if 0
10163 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10164 IR_OPND_R(ir_idx) = null_opnd;
10165 #endif
10166
10167
10168
10169
10170 res_exp_desc->foldable = FALSE;
10171 res_exp_desc->will_fold_later = FALSE;
10172
10173
10174 TRACE (Func_Exit, "test_ieee_interrupt_intrinsic", NULL);
10175
10176 }
10177
10178
10179
10180
10181
10182
10183
10184
10185
10186
10187
10188
10189
10190
10191
10192
10193
10194
10195
10196
10197
10198 void set_ieee_exception_intrinsic(opnd_type *result_opnd,
10199 expr_arg_type *res_exp_desc,
10200 int *spec_idx)
10201 {
10202 int ir_idx;
10203 int idx;
10204 int info_idx1;
10205 int list_idx1;
10206
10207 TRACE (Func_Entry, "set_ieee_exception_intrinsic", NULL);
10208
10209 ir_idx = OPND_IDX((*result_opnd));
10210 list_idx1 = IR_IDX_R(ir_idx);
10211 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
10212
10213 conform_check(0,
10214 ir_idx,
10215 res_exp_desc,
10216 spec_idx,
10217 FALSE);
10218 # if 0
10219
10220 switch (ATP_INTRIN_ENUM(*spec_idx)) {
10221
10222 case Set_Ieee_Exception_Intrinsic:
10223 IR_OPR(ir_idx) = Set_Ieee_Exception_Opr;
10224
10225 NTR_IR_LIST_TBL(idx);
10226 IL_NEXT_LIST_IDX(list_idx1) = idx;
10227 IL_FLD(idx) = CN_Tbl_Idx;
10228 IL_IDX(idx) = CN_INTEGER_ONE_IDX;
10229 IL_LINE_NUM(idx) = IR_LINE_NUM(ir_idx);
10230 IL_COL_NUM(idx) = IR_COL_NUM(ir_idx);
10231 IR_LIST_CNT_R(ir_idx) = 2;
10232 break;
10233
10234 case Clear_Ieee_Exception_Intrinsic:
10235 IR_OPR(ir_idx) = Clear_Ieee_Exception_Opr;
10236
10237 NTR_IR_LIST_TBL(idx);
10238 IL_NEXT_LIST_IDX(list_idx1) = idx;
10239 IL_FLD(idx) = CN_Tbl_Idx;
10240 IL_IDX(idx) = CN_INTEGER_ZERO_IDX;
10241 IL_LINE_NUM(idx) = IR_LINE_NUM(ir_idx);
10242 IL_COL_NUM(idx) = IR_COL_NUM(ir_idx);
10243 IR_LIST_CNT_R(ir_idx) = 2;
10244 break;
10245
10246 case Enable_Ieee_Interrupt_Intrinsic:
10247 IR_OPR(ir_idx) = Enable_Ieee_Interrupt_Opr;
10248 break;
10249
10250 case Disable_Ieee_Interrupt_Intrinsic:
10251 IR_OPR(ir_idx) = Disable_Ieee_Interrupt_Opr;
10252 break;
10253 }
10254
10255 # endif
10256
10257 if (arg_info_list[info_idx1].ed.rank > 1) {
10258 PRINTMSG(arg_info_list[info_idx1].line, 654, Error,
10259 arg_info_list[info_idx1].col);
10260 }
10261
10262 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
10263 IR_RANK(ir_idx) = res_exp_desc->rank;
10264
10265 #if 0
10266 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10267 IR_OPND_R(ir_idx) = null_opnd;
10268 #endif
10269
10270
10271
10272
10273 res_exp_desc->foldable = FALSE;
10274 res_exp_desc->will_fold_later = FALSE;
10275
10276
10277 TRACE (Func_Exit, "set_ieee_exception_intrinsic", NULL);
10278
10279 }
10280
10281
10282
10283
10284
10285
10286
10287
10288
10289
10290
10291
10292
10293
10294
10295
10296
10297
10298
10299
10300
10301
10302
10303
10304
10305
10306 void ieee_real_intrinsic(opnd_type *result_opnd,
10307 expr_arg_type *res_exp_desc,
10308 int *spec_idx)
10309 {
10310 int ir_idx;
10311 int list_idx1;
10312 int list_idx2;
10313 int info_idx1;
10314 int info_idx2;
10315 opnd_type opnd;
10316
10317
10318 TRACE (Func_Entry, "ieee_real_intrinsic", NULL);
10319
10320 ir_idx = OPND_IDX((*result_opnd));
10321 list_idx1 = IR_IDX_R(ir_idx);
10322 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
10323 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
10324 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
10325 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
10326 }
10327
10328 switch (ATP_INTRIN_ENUM(*spec_idx)) {
10329 case Ieee_Int_Intrinsic:
10330 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
10331
10332 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
10333 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10334 arg_info_list[info_idx2].ed.type_idx;
10335 }
10336
10337 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
10338 IR_LIST_CNT_R(ir_idx) = 1;
10339 IR_OPR(ir_idx) = Ieee_Int_Opr;
10340 break;
10341
10342 case Ieee_Real_Intrinsic:
10343 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = REAL_DEFAULT_TYPE;
10344
10345 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
10346 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10347 arg_info_list[info_idx2].ed.type_idx;
10348 }
10349
10350 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
10351 IR_LIST_CNT_R(ir_idx) = 1;
10352 IR_OPR(ir_idx) = Ieee_Real_Opr;
10353 break;
10354
10355 case Int_Mult_Upper_Intrinsic:
10356 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10357 arg_info_list[info_idx1].ed.type_idx;
10358
10359 if (arg_info_list[info_idx1].ed.type == Typeless) {
10360 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
10361
10362 COPY_OPND(opnd, IL_OPND(list_idx1));
10363 cast_opnd_to_type_idx(&opnd, INTEGER_DEFAULT_TYPE);
10364 COPY_OPND(IL_OPND(list_idx1), opnd);
10365
10366 COPY_OPND(opnd, IL_OPND(list_idx2));
10367 cast_opnd_to_type_idx(&opnd, INTEGER_DEFAULT_TYPE);
10368 COPY_OPND(IL_OPND(list_idx2), opnd);
10369 }
10370
10371 IR_OPR(ir_idx) = Int_Mult_Upper_Opr;
10372 break;
10373
10374 case Ieee_Exponent_Intrinsic:
10375 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
10376
10377 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
10378 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10379 arg_info_list[info_idx2].ed.type_idx;
10380
10381 if (arg_info_list[info_idx2].ed.rank != 0) {
10382 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
10383 arg_info_list[info_idx2].col);
10384 }
10385 }
10386
10387 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
10388 IR_LIST_CNT_R(ir_idx) = 1;
10389 IR_OPR(ir_idx) = Ieee_Exponent_Opr;
10390 break;
10391
10392 case Ieee_Remainder_Intrinsic:
10393 if (TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx) >
10394 TYP_LINEAR(arg_info_list[info_idx2].ed.type_idx)) {
10395 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10396 arg_info_list[info_idx1].ed.type_idx;
10397 }
10398 else {
10399 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10400 arg_info_list[info_idx2].ed.type_idx;
10401 }
10402 IR_OPR(ir_idx) = Ieee_Remainder_Opr;
10403 break;
10404
10405 case Ieee_Unordered_Intrinsic:
10406 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
10407 IR_OPR(ir_idx) = Ieee_Unordered_Opr;
10408 break;
10409
10410 case Ieee_Binary_Scale_Intrinsic:
10411 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10412 arg_info_list[info_idx1].ed.type_idx;
10413 IR_OPR(ir_idx) = Ieee_Binary_Scale_Opr;
10414 break;
10415
10416 case Ieee_Next_After_Intrinsic:
10417 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10418 arg_info_list[info_idx1].ed.type_idx;
10419 IR_OPR(ir_idx) = Ieee_Next_After_Opr;
10420 break;
10421
10422 case Ieee_Copy_Sign_Intrinsic:
10423 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10424 arg_info_list[info_idx1].ed.type_idx;
10425 IR_OPR(ir_idx) = Ieee_Copy_Sign_Opr;
10426 break;
10427 }
10428
10429 conform_check(0,
10430 ir_idx,
10431 res_exp_desc,
10432 spec_idx,
10433 FALSE);
10434
10435
10436 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
10437 IR_RANK(ir_idx) = res_exp_desc->rank;
10438
10439 # if 0
10440
10441 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10442 IR_OPND_R(ir_idx) = null_opnd;
10443
10444
10445
10446
10447 # endif
10448
10449 res_exp_desc->foldable = FALSE;
10450 res_exp_desc->will_fold_later = FALSE;
10451
10452 TRACE (Func_Exit, "ieee_real_intrinsic", NULL);
10453
10454 }
10455
10456
10457
10458
10459
10460
10461
10462
10463
10464
10465
10466
10467
10468
10469
10470
10471
10472
10473
10474
10475
10476
10477
10478 void ieee_finite_intrinsic(opnd_type *result_opnd,
10479 expr_arg_type *res_exp_desc,
10480 int *spec_idx)
10481 {
10482 int ir_idx;
10483
10484
10485 TRACE (Func_Entry, "ieee_finite_intrinsic", NULL);
10486
10487 ir_idx = OPND_IDX((*result_opnd));
10488
10489 switch (ATP_INTRIN_ENUM(*spec_idx)) {
10490
10491 case Ieee_Finite_Intrinsic:
10492 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
10493 IR_OPR(ir_idx) = Ieee_Finite_Opr;
10494 break;
10495
10496 case Ieee_Is_Nan_Intrinsic:
10497 case Isnan_Intrinsic:
10498 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
10499 IR_OPR(ir_idx) = Ieee_Is_Nan_Opr;
10500 break;
10501
10502 case Ieee_Class_Intrinsic:
10503 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
10504 IR_OPR(ir_idx) = Ieee_Class_Opr;
10505 break;
10506
10507 case Fp_Class_Intrinsic:
10508 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
10509 break;
10510 }
10511
10512 conform_check(0,
10513 ir_idx,
10514 res_exp_desc,
10515 spec_idx,
10516 FALSE);
10517
10518 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
10519 IR_RANK(ir_idx) = res_exp_desc->rank;
10520
10521 # if 0
10522
10523 if (ATP_INTRIN_ENUM(*spec_idx) != Fp_Class_Intrinsic) {
10524 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10525 IR_OPND_R(ir_idx) = null_opnd;
10526 }
10527
10528 # endif
10529
10530
10531
10532
10533 res_exp_desc->foldable = FALSE;
10534 res_exp_desc->will_fold_later = FALSE;
10535
10536 TRACE (Func_Exit, "ieee_finite_intrinsic", NULL);
10537
10538 }
10539
10540
10541
10542
10543
10544
10545
10546
10547
10548
10549
10550
10551
10552
10553
10554
10555
10556
10557 void lock_release_intrinsic(opnd_type *result_opnd,
10558 expr_arg_type *res_exp_desc,
10559 int *spec_idx)
10560 {
10561 int ir_idx;
10562
10563
10564 TRACE (Func_Entry, "lock_release_intrinsic", NULL);
10565
10566 ir_idx = OPND_IDX((*result_opnd));
10567 IR_TYPE_IDX(ir_idx) = REAL_DEFAULT_TYPE;
10568
10569 #if 0
10570 IR_OPR(ir_idx) = Lock_Release_Opr;
10571 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10572 IR_OPND_R(ir_idx) = null_opnd;
10573
10574 io_item_must_flatten = TRUE;
10575 #endif
10576
10577
10578
10579
10580 res_exp_desc->foldable = FALSE;
10581 res_exp_desc->will_fold_later = FALSE;
10582
10583 TRACE (Func_Exit, "lock_release_intrinsic", NULL);
10584
10585 }
10586
10587
10588
10589
10590
10591
10592
10593
10594
10595
10596
10597
10598
10599
10600
10601
10602
10603
10604
10605 void random_number_intrinsic(opnd_type *result_opnd,
10606 expr_arg_type *res_exp_desc,
10607 int *spec_idx)
10608 {
10609 int ir_idx;
10610 int list_idx1;
10611 int info_idx1;
10612 int ranf_idx;
10613 int attr_idx;
10614 int line;
10615 int col;
10616
10617
10618 TRACE (Func_Entry, "random_number_intrinsic", NULL);
10619
10620 ir_idx = OPND_IDX((*result_opnd));
10621 IR_TYPE_IDX(ir_idx) = REAL_DEFAULT_TYPE;
10622 list_idx1 = IR_IDX_R(ir_idx);
10623 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
10624 IR_TYPE_IDX(ir_idx) = arg_info_list[info_idx1].ed.type_idx;
10625
10626 if (arg_info_list[info_idx1].ed.reference) {
10627 attr_idx = find_base_attr(&IL_OPND(list_idx1), &line, &col);
10628 AT_DEFINED(attr_idx) = TRUE;
10629
10630 if ((AT_OBJ_CLASS(attr_idx) == Data_Obj) &&
10631 (ATD_CLASS(attr_idx) == Function_Result) &&
10632 (ATD_FUNC_IDX(attr_idx) != NULL_IDX)) {
10633 AT_DEFINED(ATD_FUNC_IDX(attr_idx)) = TRUE;
10634 }
10635 }
10636
10637 if (IL_FLD(list_idx1) == CN_Tbl_Idx) {
10638 PRINTMSG(arg_info_list[info_idx1].line, 1214, Error,
10639 arg_info_list[info_idx1].col);
10640 }
10641
10642 # if 0
10643
10644 ranf_idx = gen_ir(NO_Tbl_Idx, NULL_IDX,
10645 Ranf_Opr, IR_TYPE_IDX(ir_idx), IR_LINE_NUM(ir_idx),
10646 IR_COL_NUM(ir_idx),
10647 NO_Tbl_Idx, NULL_IDX);
10648
10649 IR_OPR(ir_idx) = Asg_Opr;
10650 IR_FLD_L(ir_idx) = IL_FLD(list_idx1);
10651 IR_IDX_L(ir_idx) = IL_IDX(list_idx1);
10652 IR_FLD_R(ir_idx) = IR_Tbl_Idx;
10653 IR_IDX_R(ir_idx) = ranf_idx;
10654 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
10655 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
10656 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
10657 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx);
10658
10659
10660
10661
10662 # endif
10663
10664 res_exp_desc->foldable = FALSE;
10665 res_exp_desc->will_fold_later = FALSE;
10666
10667 TRACE (Func_Exit, "random_number_intrinsic", NULL);
10668
10669 }
10670
10671
10672
10673
10674
10675
10676
10677
10678
10679
10680
10681
10682
10683
10684
10685
10686
10687
10688
10689
10690 void all_intrinsic(opnd_type *result_opnd,
10691 expr_arg_type *res_exp_desc,
10692 int *spec_idx)
10693 {
10694 int list_idx1;
10695 int list_idx2;
10696 int info_idx1;
10697 int info_idx2;
10698 int attr_idx;
10699 int ir_idx;
10700 int i;
10701 int j;
10702 int line;
10703 int col;
10704 opnd_type opnd;
10705
10706
10707 TRACE (Func_Entry, "all_intrinsic", NULL);
10708 ir_idx = OPND_IDX((*result_opnd));
10709 list_idx1 = IR_IDX_R(ir_idx);
10710 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
10711 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
10712 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
10713
10714 if (ATP_INTRIN_ENUM(*spec_idx) == Count_Intrinsic) {
10715 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
10716 }
10717 else {
10718 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) =
10719 arg_info_list[info_idx1].ed.type_idx;
10720 }
10721
10722 if (arg_info_list[info_idx1].ed.rank < 1) {
10723 PRINTMSG(arg_info_list[info_idx1].line, 640, Error,
10724 arg_info_list[info_idx1].col);
10725 }
10726
10727 conform_check(0,
10728 ir_idx,
10729 res_exp_desc,
10730 spec_idx,
10731 FALSE);
10732
10733 if (list_idx2 != NULL_IDX && IL_IDX(list_idx2) != NULL_IDX) {
10734 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
10735
10736 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
10737 if (compare_cn_and_value(IL_IDX(list_idx2), 1, Lt_Opr) ||
10738 compare_cn_and_value(IL_IDX(list_idx2),
10739 (long) arg_info_list[info_idx1].ed.rank,
10740 Gt_Opr)) {
10741
10742 PRINTMSG(arg_info_list[info_idx2].line, 881, Error,
10743 arg_info_list[info_idx2].col);
10744 }
10745
10746 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
10747 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
10748 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
10749 j = 1;
10750 for (i = 1; i < 8; i++) {
10751 if (i == CN_INT_TO_C(IL_IDX(list_idx2))) {
10752 j = j + 1;
10753 }
10754
10755 COPY_OPND(res_exp_desc->shape[i-1],
10756 arg_info_list[info_idx1].ed.shape[j-1]);
10757 j = j + 1;
10758 }
10759
10760 # ifdef _INLINE_INTRINSICS
10761 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
10762 # endif
10763 }
10764 else {
10765 if (arg_info_list[info_idx2].ed.reference) {
10766 attr_idx = find_base_attr(&IL_OPND(list_idx2), &line, &col);
10767
10768 if ((AT_OPTIONAL(attr_idx)) &&
10769 (arg_info_list[info_idx2].line != 0)) {
10770 PRINTMSG(arg_info_list[info_idx2].line, 875, Error,
10771 arg_info_list[info_idx2].col);
10772 }
10773 }
10774 }
10775
10776 COPY_OPND(opnd, IL_OPND(list_idx2));
10777 cast_to_cg_default(&opnd, &(arg_info_list[info_idx2].ed));
10778 COPY_OPND(IL_OPND(list_idx2), opnd);
10779
10780 res_exp_desc->rank = arg_info_list[info_idx1].ed.rank - 1;
10781 }
10782 else {
10783 res_exp_desc->rank = 0;
10784 NTR_IR_LIST_TBL(list_idx2);
10785 IL_INTRIN_PLACE_HOLDER(list_idx2) = TRUE;
10786 IL_ARG_DESC_VARIANT(list_idx2) = TRUE;
10787 IL_NEXT_LIST_IDX(list_idx1) = list_idx2;
10788 IR_LIST_CNT_R(ir_idx) = 2;
10789 # ifdef _INLINE_INTRINSICS
10790 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
10791 # endif
10792 }
10793
10794
10795 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
10796
10797 if (ATP_INTRIN_ENUM(*spec_idx) == Any_Intrinsic) {
10798 IR_OPR(ir_idx) = Any_Opr;
10799 }
10800 else if (ATP_INTRIN_ENUM(*spec_idx) == All_Intrinsic) {
10801 IR_OPR(ir_idx) = All_Opr;
10802 }
10803 else {
10804 IR_OPR(ir_idx) = Count_Opr;
10805 }
10806
10807 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10808 IR_OPND_R(ir_idx) = null_opnd;
10809 IR_LIST_CNT_L(ir_idx) = IR_LIST_CNT_R(ir_idx);
10810 }
10811
10812
10813 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
10814 IR_RANK(ir_idx) = res_exp_desc->rank;
10815
10816
10817
10818 res_exp_desc->foldable = FALSE;
10819 res_exp_desc->will_fold_later = FALSE;
10820
10821 TRACE (Func_Exit, "all_intrinsic", NULL);
10822
10823 }
10824
10825
10826
10827
10828
10829
10830
10831
10832
10833
10834
10835
10836
10837
10838
10839
10840
10841
10842 void tiny_intrinsic(opnd_type *result_opnd,
10843 expr_arg_type *res_exp_desc,
10844 int *spec_idx)
10845 {
10846 int cn_idx;
10847 int info_idx1;
10848 int ir_idx;
10849
10850
10851 TRACE (Func_Entry, "tiny_intrinsic", NULL);
10852
10853 ir_idx = OPND_IDX((*result_opnd));
10854 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
10855 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
10856
10857 conform_check(0,
10858 ir_idx,
10859 res_exp_desc,
10860 spec_idx,
10861 FALSE);
10862
10863 res_exp_desc->rank = 0;
10864 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
10865 IR_RANK(ir_idx) = res_exp_desc->rank;
10866
10867 # if 0
10868
10869 switch (arg_info_list[info_idx1].ed.linear_type) {
10870 case Real_4:
10871 cn_idx = cvrt_str_to_cn(TINY_REAL4_F90,
10872 arg_info_list[info_idx1].ed.linear_type);
10873 break;
10874
10875 case Real_8:
10876 cn_idx = cvrt_str_to_cn(TINY_REAL8_F90,
10877 arg_info_list[info_idx1].ed.linear_type);
10878 break;
10879
10880 case Real_16:
10881 cn_idx = cvrt_str_to_cn(TINY_REAL16_F90,
10882 arg_info_list[info_idx1].ed.linear_type);
10883 break;
10884 }
10885
10886
10887 OPND_IDX((*result_opnd)) = cn_idx;
10888 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
10889 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
10890 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
10891 res_exp_desc->constant = TRUE;
10892 res_exp_desc->foldable = TRUE;
10893
10894 # endif
10895
10896 res_exp_desc->foldable = FALSE;
10897 res_exp_desc->will_fold_later = FALSE;
10898
10899 TRACE (Func_Exit, "tiny_intrinsic", NULL);
10900
10901 }
10902
10903
10904
10905
10906
10907
10908
10909
10910
10911
10912
10913
10914
10915
10916
10917
10918
10919
10920 void spacing_intrinsic(opnd_type *result_opnd,
10921 expr_arg_type *res_exp_desc,
10922 int *spec_idx)
10923 {
10924 int ir_idx;
10925 int cn_idx;
10926 int info_idx1;
10927 int list_idx1;
10928 int list_idx2;
10929 long num;
10930
10931
10932 TRACE (Func_Entry, "spacing_intrinsic", NULL);
10933
10934 ir_idx = OPND_IDX((*result_opnd));
10935 list_idx1 = IR_IDX_R(ir_idx);
10936 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
10937 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
10938
10939 conform_check(0,
10940 ir_idx,
10941 res_exp_desc,
10942 spec_idx,
10943 FALSE);
10944 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
10945 IR_RANK(ir_idx) = res_exp_desc->rank;
10946
10947 # if 0
10948
10949 IR_OPR(ir_idx) = Spacing_Opr;
10950 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
10951 IR_LIST_CNT_L(ir_idx) = 2;
10952
10953 switch (arg_info_list[info_idx1].ed.linear_type) {
10954 case Real_4:
10955 num = DIGITS_REAL4_F90;
10956 break;
10957
10958 case Real_8:
10959 num = DIGITS_REAL8_F90;
10960 break;
10961
10962 case Real_16:
10963 num = DIGITS_REAL16_F90;
10964 break;
10965 }
10966
10967 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, num);
10968
10969 NTR_IR_LIST_TBL(list_idx2);
10970 IL_ARG_DESC_VARIANT(list_idx2) = TRUE;
10971
10972
10973 IL_NEXT_LIST_IDX(list_idx1) = list_idx2;
10974
10975 IL_IDX(list_idx2) = cn_idx;
10976 IL_FLD(list_idx2) = CN_Tbl_Idx;
10977
10978 IL_LINE_NUM(list_idx2) = IL_LINE_NUM(list_idx1);
10979 IL_COL_NUM(list_idx2) = IL_COL_NUM(list_idx1);
10980
10981 IR_OPND_R(ir_idx) = null_opnd;
10982
10983 # endif
10984
10985
10986
10987 res_exp_desc->foldable = FALSE;
10988 res_exp_desc->will_fold_later = FALSE;
10989
10990
10991 TRACE (Func_Exit, "spacing_intrinsic", NULL);
10992
10993 }
10994
10995
10996
10997
10998
10999
11000
11001
11002
11003
11004
11005
11006
11007
11008
11009
11010
11011
11012 void cshift_intrinsic(opnd_type *result_opnd,
11013 expr_arg_type *res_exp_desc,
11014 int *spec_idx)
11015 {
11016 int ir_idx;
11017 int cn_idx;
11018 int list_idx1;
11019 int list_idx2;
11020 int list_idx3;
11021 int info_idx1;
11022 int info_idx2;
11023 int info_idx3;
11024 int type_idx;
11025 opnd_type opnd;
11026
11027
11028 TRACE (Func_Entry, "cshift_intrinsic", NULL);
11029
11030
11031 # ifdef _INLINE_INTRINSICS
11032 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
11033 # endif
11034
11035 # if defined(GENERATE_WHIRL)
11036 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
11037 # endif
11038
11039 ir_idx = OPND_IDX((*result_opnd));
11040 list_idx1 = IR_IDX_R(ir_idx);
11041 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
11042 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
11043 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
11044 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
11045 type_idx = arg_info_list[info_idx1].ed.type_idx;
11046
11047 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = type_idx;
11048
11049 if ((arg_info_list[info_idx1].ed.rank == 1) &&
11050 (arg_info_list[info_idx2].ed.rank != 0)) {
11051 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
11052 arg_info_list[info_idx2].col);
11053 }
11054 else if ((arg_info_list[info_idx2].ed.rank != 0) &&
11055 (arg_info_list[info_idx2].ed.rank !=
11056 (arg_info_list[info_idx1].ed.rank - 1))) {
11057 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
11058 arg_info_list[info_idx2].col);
11059 }
11060
11061 if (list_idx3 != NULL_IDX && IL_IDX(list_idx3) != NULL_IDX) {
11062 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
11063
11064 if (arg_info_list[info_idx3].ed.rank != 0) {
11065 PRINTMSG(arg_info_list[info_idx3].line, 654, Error,
11066 arg_info_list[info_idx3].col);
11067 }
11068
11069 if (IL_FLD(list_idx3) == CN_Tbl_Idx) {
11070 if (compare_cn_and_value(IL_IDX(list_idx3),
11071 (long) arg_info_list[info_idx1].ed.rank,
11072 Gt_Opr) ||
11073 compare_cn_and_value(IL_IDX(list_idx3), 1, Lt_Opr)) {
11074
11075 PRINTMSG(arg_info_list[info_idx3].line, 1017, Error,
11076 arg_info_list[info_idx3].col);
11077 }
11078 }
11079 }
11080 else {
11081
11082 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
11083 CN_INTEGER_ONE_IDX : C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
11084 IL_FLD(list_idx3) = CN_Tbl_Idx;
11085 IL_IDX(list_idx3) = cn_idx;
11086 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
11087 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
11088
11089 arg_info_list_base = arg_info_list_top;
11090 arg_info_list_top = arg_info_list_base + 1;
11091
11092 if (arg_info_list_top >= arg_info_list_size) {
11093 enlarge_info_list_table();
11094 }
11095
11096 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
11097 arg_info_list[arg_info_list_top] = init_arg_info;
11098 arg_info_list[arg_info_list_top].ed.type_idx = INTEGER_DEFAULT_TYPE;
11099 arg_info_list[arg_info_list_top].ed.type = Integer;
11100 arg_info_list[arg_info_list_top].ed.linear_type = INTEGER_DEFAULT_TYPE;
11101 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
11102 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
11103
11104 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
11105 }
11106
11107 # if defined(GENERATE_WHIRL)
11108 if (list_idx3 != NULL_IDX &&
11109 IL_IDX(list_idx3) != NULL_IDX &&
11110 IL_FLD(list_idx3) == CN_Tbl_Idx) {
11111 # ifdef _INLINE_INTRINSICS
11112 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
11113 # endif
11114 }
11115 # endif
11116
11117 COPY_OPND(opnd, IL_OPND(list_idx3));
11118 cast_to_cg_default(&opnd, &(arg_info_list[info_idx3].ed));
11119 COPY_OPND(IL_OPND(list_idx3), opnd);
11120
11121
11122 conform_check(0,
11123 ir_idx,
11124 res_exp_desc,
11125 spec_idx,
11126 FALSE);
11127 # if 0
11128
11129 COPY_OPND(res_exp_desc->shape[0], arg_info_list[info_idx1].ed.shape[0]);
11130 COPY_OPND(res_exp_desc->shape[1], arg_info_list[info_idx1].ed.shape[1]);
11131 COPY_OPND(res_exp_desc->shape[2], arg_info_list[info_idx1].ed.shape[2]);
11132 COPY_OPND(res_exp_desc->shape[3], arg_info_list[info_idx1].ed.shape[3]);
11133 COPY_OPND(res_exp_desc->shape[4], arg_info_list[info_idx1].ed.shape[4]);
11134 COPY_OPND(res_exp_desc->shape[5], arg_info_list[info_idx1].ed.shape[5]);
11135 COPY_OPND(res_exp_desc->shape[6], arg_info_list[info_idx1].ed.shape[6]);
11136
11137 COPY_OPND(res_exp_desc->char_len, arg_info_list[info_idx1].ed.char_len);
11138
11139 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11140 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
11141 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
11142
11143
11144 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
11145 io_item_must_flatten = TRUE;
11146 IR_OPR(ir_idx) = Cshift_Opr;
11147 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
11148 IR_OPND_R(ir_idx) = null_opnd;
11149 }
11150
11151 # endif
11152
11153 IR_TYPE_IDX(ir_idx) = type_idx;
11154 IR_RANK(ir_idx) = res_exp_desc->rank;
11155
11156
11157
11158
11159 res_exp_desc->foldable = FALSE;
11160 res_exp_desc->will_fold_later = FALSE;
11161
11162 TRACE (Func_Exit, "cshift_intrinsic", NULL);
11163
11164 }
11165
11166
11167
11168
11169
11170
11171
11172
11173
11174
11175
11176
11177
11178
11179
11180
11181
11182
11183 void eoshift_intrinsic(opnd_type *result_opnd,
11184 expr_arg_type *res_exp_desc,
11185 int *spec_idx)
11186 {
11187 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
11188 long_type cnst[MAX_WORDS_FOR_INTEGER];
11189 int ir_idx;
11190 int list_idx1;
11191 int list_idx2;
11192 int list_idx3;
11193 int list_idx4;
11194 int info_idx1;
11195 int info_idx2;
11196 int info_idx3;
11197 int info_idx4;
11198 int input_type_idx;
11199 int output_type_idx;
11200 int cn_idx;
11201 opnd_type opnd;
11202
11203
11204 TRACE (Func_Entry, "eoshift_intrinsic", NULL);
11205
11206 # ifdef _INLINE_INTRINSICS
11207 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
11208 # endif
11209
11210 ir_idx = OPND_IDX((*result_opnd));
11211 list_idx1 = IR_IDX_R(ir_idx);
11212 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
11213 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
11214 list_idx4 = IL_NEXT_LIST_IDX(list_idx3);
11215 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
11216 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
11217 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
11218
11219 if ((arg_info_list[info_idx1].ed.rank == 1) &&
11220 (arg_info_list[info_idx2].ed.rank != 0)) {
11221 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
11222 arg_info_list[info_idx2].col);
11223 }
11224 else {
11225 if ((arg_info_list[info_idx2].ed.rank != 0) &&
11226 (arg_info_list[info_idx2].ed.rank !=
11227 (arg_info_list[info_idx1].ed.rank - 1))) {
11228 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
11229 arg_info_list[info_idx2].col);
11230 }
11231 }
11232
11233 conform_check(0,
11234 ir_idx,
11235 res_exp_desc,
11236 spec_idx,
11237 FALSE);
11238
11239 if (list_idx3 != NULL_IDX && IL_IDX(list_idx3) != NULL_IDX) {
11240 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
11241
11242 if (TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx) !=
11243 TYP_LINEAR(arg_info_list[info_idx3].ed.type_idx)) {
11244 PRINTMSG(arg_info_list[info_idx3].line, 727, Error,
11245 arg_info_list[info_idx3].col);
11246 }
11247
11248 if ((arg_info_list[info_idx1].ed.rank == 1) &&
11249 (arg_info_list[info_idx3].ed.rank != 0)) {
11250 PRINTMSG(arg_info_list[info_idx3].line, 654, Error,
11251 arg_info_list[info_idx3].col);
11252 }
11253 else {
11254 if ((arg_info_list[info_idx3].ed.rank != 0) &&
11255 (arg_info_list[info_idx3].ed.rank !=
11256 (arg_info_list[info_idx1].ed.rank - 1))) {
11257 PRINTMSG(arg_info_list[info_idx3].line, 654, Error,
11258 arg_info_list[info_idx3].col);
11259 }
11260 }
11261 }
11262 else {
11263
11264
11265
11266 switch (arg_info_list[info_idx1].ed.type) {
11267 case Structure :
11268 PRINTMSG(arg_info_list[info_idx1].line, 888, Error,
11269 arg_info_list[info_idx1].col);
11270 break;
11271
11272 case Integer :
11273
11274 cn_idx = (TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx) ==
11275 CG_INTEGER_DEFAULT_TYPE) ? CN_INTEGER_ZERO_IDX :
11276 C_INT_TO_CN(arg_info_list[info_idx1].ed.type_idx, 0);
11277
11278 IL_FLD(list_idx3) = CN_Tbl_Idx;
11279 IL_IDX(list_idx3) = cn_idx;
11280 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
11281 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
11282
11283 arg_info_list_base = arg_info_list_top;
11284 arg_info_list_top = arg_info_list_base + 1;
11285
11286 if (arg_info_list_top >= arg_info_list_size) {
11287 enlarge_info_list_table();
11288 }
11289
11290 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
11291 arg_info_list[arg_info_list_top] = init_arg_info;
11292 arg_info_list[arg_info_list_top].ed.type_idx =
11293 arg_info_list[info_idx1].ed.type_idx;
11294 arg_info_list[arg_info_list_top].ed.type = Integer;
11295 arg_info_list[arg_info_list_top].ed.linear_type =
11296 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx);
11297 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
11298 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
11299
11300 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
11301 break;
11302
11303 case Real :
11304 output_type_idx = arg_info_list[info_idx1].ed.type_idx;
11305 input_type_idx = CG_INTEGER_DEFAULT_TYPE;
11306
11307 if (folder_driver((char *)&CN_CONST(CN_INTEGER_ZERO_IDX),
11308 input_type_idx,
11309 NULL,
11310 NULL_IDX,
11311 folded_const,
11312 &output_type_idx,
11313 IR_LINE_NUM(ir_idx),
11314 IR_COL_NUM(ir_idx),
11315 1,
11316 Cvrt_Opr)) {
11317 }
11318
11319 cn_idx = ntr_const_tbl(output_type_idx,
11320 FALSE,
11321 folded_const);
11322
11323 IL_FLD(list_idx3) = CN_Tbl_Idx;
11324 IL_IDX(list_idx3) = cn_idx;
11325 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
11326 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
11327
11328 arg_info_list_base = arg_info_list_top;
11329 arg_info_list_top = arg_info_list_base + 1;
11330
11331 if (arg_info_list_top >= arg_info_list_size) {
11332 enlarge_info_list_table();
11333 }
11334
11335 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
11336 arg_info_list[arg_info_list_top] = init_arg_info;
11337 arg_info_list[arg_info_list_top].ed.type_idx =
11338 arg_info_list[info_idx1].ed.type_idx;
11339 arg_info_list[arg_info_list_top].ed.type = Real;
11340 arg_info_list[arg_info_list_top].ed.linear_type =
11341 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx);
11342 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
11343 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
11344 break;
11345
11346 case Complex :
11347 output_type_idx = arg_info_list[info_idx1].ed.type_idx;
11348 input_type_idx = CG_INTEGER_DEFAULT_TYPE;
11349
11350 if (folder_driver((char *)&CN_CONST(CN_INTEGER_ZERO_IDX),
11351 input_type_idx,
11352 NULL,
11353 NULL_IDX,
11354 folded_const,
11355 &output_type_idx,
11356 IR_LINE_NUM(ir_idx),
11357 IR_COL_NUM(ir_idx),
11358 1,
11359 Cvrt_Opr)) {
11360 }
11361
11362 cn_idx = ntr_const_tbl(output_type_idx,
11363 FALSE,
11364 folded_const);
11365
11366 IL_FLD(list_idx3) = CN_Tbl_Idx;
11367 IL_IDX(list_idx3) = cn_idx;
11368 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
11369 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
11370
11371 arg_info_list_base = arg_info_list_top;
11372 arg_info_list_top = arg_info_list_base + 1;
11373
11374 if (arg_info_list_top >= arg_info_list_size) {
11375 enlarge_info_list_table();
11376 }
11377
11378 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
11379 arg_info_list[arg_info_list_top] = init_arg_info;
11380 arg_info_list[arg_info_list_top].ed.type_idx =
11381 arg_info_list[info_idx1].ed.type_idx;
11382 arg_info_list[arg_info_list_top].ed.type = Complex;
11383 arg_info_list[arg_info_list_top].ed.linear_type =
11384 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx);
11385 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
11386 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
11387 break;
11388
11389 case Logical :
11390 cn_idx = set_up_logical_constant(cnst,
11391 arg_info_list[info_idx1].ed.type_idx,
11392 FALSE_VALUE,
11393 TRUE);
11394 IL_FLD(list_idx3) = CN_Tbl_Idx;
11395 IL_IDX(list_idx3) = cn_idx;
11396 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
11397 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
11398
11399 arg_info_list_base = arg_info_list_top;
11400 arg_info_list_top = arg_info_list_base + 1;
11401
11402 if (arg_info_list_top >= arg_info_list_size) {
11403 enlarge_info_list_table();
11404 }
11405
11406 IL_ARG_DESC_IDX(list_idx3) = arg_info_list_top;
11407 arg_info_list[arg_info_list_top] = init_arg_info;
11408 arg_info_list[arg_info_list_top].ed.type_idx =
11409 arg_info_list[info_idx1].ed.type_idx;
11410 arg_info_list[arg_info_list_top].ed.type = Logical;
11411 arg_info_list[arg_info_list_top].ed.linear_type =
11412 TYP_LINEAR(arg_info_list[info_idx1].ed.type_idx);
11413 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
11414 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
11415
11416 info_idx3 = IL_ARG_DESC_IDX(list_idx3);
11417 break;
11418
11419 case Character :
11420 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
11421 break;
11422 }
11423
11424
11425
11426 }
11427
11428 if (list_idx4 != NULL_IDX && IL_IDX(list_idx4) != NULL_IDX) {
11429 info_idx4 = IL_ARG_DESC_IDX(list_idx4);
11430
11431 if (arg_info_list[info_idx4].ed.rank != 0) {
11432 PRINTMSG(arg_info_list[info_idx4].line, 654, Error,
11433 arg_info_list[info_idx4].col);
11434 }
11435
11436 if (IL_FLD(list_idx4) == CN_Tbl_Idx) {
11437 if (compare_cn_and_value(IL_IDX(list_idx4),
11438 (long) arg_info_list[info_idx1].ed.rank,
11439 Gt_Opr) ||
11440 compare_cn_and_value(IL_IDX(list_idx4), 1, Lt_Opr)) {
11441
11442 PRINTMSG(arg_info_list[info_idx4].line, 1017, Error,
11443 arg_info_list[info_idx4].col);
11444 }
11445 }
11446 }
11447 else {
11448
11449 # if 0
11450
11451 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
11452 CN_INTEGER_ONE_IDX : C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
11453 IL_FLD(list_idx4) = CN_Tbl_Idx;
11454 IL_IDX(list_idx4) = cn_idx;
11455 IL_LINE_NUM(list_idx4) = IR_LINE_NUM(ir_idx);
11456 IL_COL_NUM(list_idx4) = IR_COL_NUM(ir_idx);
11457
11458 arg_info_list_base = arg_info_list_top;
11459 arg_info_list_top = arg_info_list_base + 1;
11460
11461 if (arg_info_list_top >= arg_info_list_size) {
11462 enlarge_info_list_table();
11463 }
11464
11465 IL_ARG_DESC_IDX(list_idx4) = arg_info_list_top;
11466 arg_info_list[arg_info_list_top] = init_arg_info;
11467 arg_info_list[arg_info_list_top].ed.type_idx = INTEGER_DEFAULT_TYPE;
11468 arg_info_list[arg_info_list_top].ed.type = Integer;
11469 arg_info_list[arg_info_list_top].ed.linear_type = INTEGER_DEFAULT_TYPE;
11470 arg_info_list[arg_info_list_top].line = IR_LINE_NUM(ir_idx);
11471 arg_info_list[arg_info_list_top].col = IR_COL_NUM(ir_idx);
11472
11473 info_idx4 = IL_ARG_DESC_IDX(list_idx4);
11474
11475 # endif
11476
11477 }
11478
11479 # if 0
11480
11481 if (IL_FLD(list_idx4) != CN_Tbl_Idx) {
11482 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
11483 }
11484
11485 COPY_OPND(opnd, IL_OPND(list_idx4));
11486 cast_to_cg_default(&opnd, &(arg_info_list[info_idx4].ed));
11487 COPY_OPND(IL_OPND(list_idx4), opnd);
11488
11489 COPY_OPND(res_exp_desc->shape[0], arg_info_list[info_idx1].ed.shape[0]);
11490 COPY_OPND(res_exp_desc->shape[1], arg_info_list[info_idx1].ed.shape[1]);
11491 COPY_OPND(res_exp_desc->shape[2], arg_info_list[info_idx1].ed.shape[2]);
11492 COPY_OPND(res_exp_desc->shape[3], arg_info_list[info_idx1].ed.shape[3]);
11493 COPY_OPND(res_exp_desc->shape[4], arg_info_list[info_idx1].ed.shape[4]);
11494 COPY_OPND(res_exp_desc->shape[5], arg_info_list[info_idx1].ed.shape[5]);
11495 COPY_OPND(res_exp_desc->shape[6], arg_info_list[info_idx1].ed.shape[6]);
11496
11497 COPY_OPND(res_exp_desc->char_len, arg_info_list[info_idx1].ed.char_len);
11498
11499 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11500 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
11501 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
11502
11503 if (!ATP_EXTERNAL_INTRIN(*spec_idx)) {
11504 io_item_must_flatten = TRUE;
11505 IR_OPR(ir_idx) = Eoshift_Opr;
11506 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
11507 IR_OPND_R(ir_idx) = null_opnd;
11508 }
11509
11510 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11511 IR_RANK(ir_idx) = res_exp_desc->rank;
11512
11513
11514
11515
11516 # endif
11517
11518 res_exp_desc->foldable = FALSE;
11519 res_exp_desc->will_fold_later = FALSE;
11520
11521 TRACE (Func_Exit, "eoshift_intrinsic", NULL);
11522
11523 }
11524
11525
11526
11527
11528
11529
11530
11531
11532
11533
11534
11535
11536
11537
11538
11539
11540
11541
11542 void minexponent_intrinsic(opnd_type *result_opnd,
11543 expr_arg_type *res_exp_desc,
11544 int *spec_idx)
11545 {
11546 int ir_idx;
11547 long num;
11548 int info_idx1;
11549 int cn_idx;
11550
11551
11552 TRACE (Func_Entry, "minexponent_intrinsic", NULL);
11553
11554 ir_idx = OPND_IDX((*result_opnd));
11555 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
11556 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
11557
11558 conform_check(0,
11559 ir_idx,
11560 res_exp_desc,
11561 spec_idx,
11562 TRUE);
11563
11564
11565 res_exp_desc->rank = 0;
11566 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11567 IR_RANK(ir_idx) = res_exp_desc->rank;
11568
11569 # if 0
11570
11571 switch (arg_info_list[info_idx1].ed.linear_type) {
11572 case Real_4:
11573 num = MINEXPONENT_REAL4_F90;
11574 break;
11575
11576 case Real_8:
11577 num = MINEXPONENT_REAL8_F90;
11578 break;
11579
11580 case Real_16:
11581 num = MINEXPONENT_REAL16_F90;
11582 break;
11583 }
11584
11585 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
11586
11587 OPND_IDX((*result_opnd)) = cn_idx;
11588 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
11589 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
11590 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
11591 res_exp_desc->constant = TRUE;
11592 res_exp_desc->foldable = TRUE;
11593
11594 # endif
11595 res_exp_desc->foldable = FALSE;
11596 res_exp_desc->will_fold_later = FALSE;
11597
11598 TRACE (Func_Exit, "minexponent_intrinsic", NULL);
11599
11600 }
11601
11602
11603
11604
11605
11606
11607
11608
11609
11610
11611
11612
11613
11614
11615
11616
11617
11618
11619 void maxexponent_intrinsic(opnd_type *result_opnd,
11620 expr_arg_type *res_exp_desc,
11621 int *spec_idx)
11622 {
11623 int ir_idx;
11624 int info_idx1;
11625 int cn_idx;
11626 long num;
11627
11628
11629 TRACE (Func_Entry, "maxexponent_intrinsic", NULL);
11630
11631 ir_idx = OPND_IDX((*result_opnd));
11632 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
11633 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
11634
11635 conform_check(0,
11636 ir_idx,
11637 res_exp_desc,
11638 spec_idx,
11639 TRUE);
11640
11641 res_exp_desc->rank = 0;
11642 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11643 IR_RANK(ir_idx) = res_exp_desc->rank;
11644
11645 # if 0
11646
11647 switch (arg_info_list[info_idx1].ed.linear_type) {
11648 case Real_4:
11649 num = MAXEXPONENT_REAL4_F90;
11650 break;
11651
11652 case Real_8:
11653 num = MAXEXPONENT_REAL8_F90;
11654 break;
11655
11656 case Real_16:
11657 num = MAXEXPONENT_REAL16_F90;
11658 break;
11659 }
11660
11661 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
11662
11663 OPND_IDX((*result_opnd)) = cn_idx;
11664 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
11665 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
11666 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
11667 res_exp_desc->constant = TRUE;
11668 res_exp_desc->foldable = TRUE;
11669
11670 # endif
11671
11672 res_exp_desc->foldable = FALSE;
11673 res_exp_desc->will_fold_later = FALSE;
11674
11675 TRACE (Func_Exit, "maxexponent_intrinsic", NULL);
11676
11677 }
11678
11679
11680
11681
11682
11683
11684
11685
11686
11687
11688
11689
11690
11691
11692
11693
11694
11695
11696 void radix_intrinsic(opnd_type *result_opnd,
11697 expr_arg_type *res_exp_desc,
11698 int *spec_idx)
11699 {
11700 int ir_idx;
11701 int cn_idx;
11702
11703
11704 TRACE (Func_Entry, "radix_intrinsic", NULL);
11705
11706 ir_idx = OPND_IDX((*result_opnd));
11707 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
11708
11709 conform_check(0,
11710 ir_idx,
11711 res_exp_desc,
11712 spec_idx,
11713 TRUE);
11714
11715 res_exp_desc->rank = 0;
11716 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11717 IR_RANK(ir_idx) = res_exp_desc->rank;
11718
11719 # if 0
11720 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, RADIX_F90);
11721
11722 OPND_IDX((*result_opnd)) = cn_idx;
11723 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
11724 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
11725 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
11726 res_exp_desc->constant = TRUE;
11727 res_exp_desc->foldable = TRUE;
11728
11729 # endif
11730 res_exp_desc->foldable = FALSE;
11731 res_exp_desc->will_fold_later = FALSE;
11732
11733 TRACE (Func_Exit, "radix_intrinsic", NULL);
11734
11735 }
11736
11737
11738
11739
11740
11741
11742
11743
11744
11745
11746
11747
11748
11749
11750
11751
11752
11753
11754 void range_intrinsic(opnd_type *result_opnd,
11755 expr_arg_type *res_exp_desc,
11756 int *spec_idx)
11757 {
11758 int ir_idx;
11759 int cn_idx;
11760 int info_idx1;
11761 long num;
11762
11763
11764 TRACE (Func_Entry, "range_intrinsic", NULL);
11765
11766 ir_idx = OPND_IDX((*result_opnd));
11767 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
11768 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
11769
11770 conform_check(0,
11771 ir_idx,
11772 res_exp_desc,
11773 spec_idx,
11774 TRUE);
11775
11776 res_exp_desc->rank = 0;
11777 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11778 IR_RANK(ir_idx) = res_exp_desc->rank;
11779
11780 # if 0
11781
11782 switch (arg_info_list[info_idx1].ed.linear_type) {
11783 case Complex_4:
11784 num = RANGE_REAL4_F90;
11785 break;
11786
11787 case Complex_8:
11788 num = RANGE_REAL8_F90;
11789 break;
11790
11791 case Complex_16:
11792 num = RANGE_REAL16_F90;
11793 break;
11794
11795 case Real_4:
11796 num = RANGE_REAL4_F90;
11797 break;
11798
11799 case Real_8:
11800 num = RANGE_REAL8_F90;
11801 break;
11802
11803 case Real_16:
11804 num = RANGE_REAL16_F90;
11805 break;
11806
11807 case Integer_1:
11808 num = RANGE_INT1_F90;
11809 break;
11810
11811 case Integer_2:
11812 num = RANGE_INT2_F90;
11813 break;
11814
11815 case Integer_4:
11816 num = RANGE_INT4_F90;
11817 break;
11818
11819 case Integer_8:
11820 num = RANGE_INT8_F90;
11821
11822 # ifdef _TARGET_HAS_FAST_INTEGER
11823 if (opt_flags.set_allfastint_option ||
11824 (opt_flags.set_fastint_option &&
11825 (TYP_DESC(arg_info_list[info_idx1].ed.type_idx) ==
11826 Default_Typed))) {
11827 num = 13;
11828 }
11829 # endif
11830
11831 break;
11832 }
11833
11834
11835 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
11836
11837 OPND_IDX((*result_opnd)) = cn_idx;
11838 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
11839 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
11840 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
11841 res_exp_desc->constant = TRUE;
11842 res_exp_desc->foldable = TRUE;
11843
11844 # endif
11845
11846 res_exp_desc->foldable = FALSE;
11847 res_exp_desc->will_fold_later = FALSE;
11848
11849 TRACE (Func_Exit, "range_intrinsic", NULL);
11850
11851 }
11852
11853
11854
11855
11856
11857
11858
11859
11860
11861
11862
11863
11864
11865
11866
11867
11868
11869
11870 void precision_intrinsic(opnd_type *result_opnd,
11871 expr_arg_type *res_exp_desc,
11872 int *spec_idx)
11873 {
11874 int ir_idx;
11875 int cn_idx;
11876 int info_idx1;
11877 long num;
11878
11879
11880 TRACE (Func_Entry, "precision_intrinsic", NULL);
11881
11882 ir_idx = OPND_IDX((*result_opnd));
11883 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
11884 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
11885
11886 conform_check(0,
11887 ir_idx,
11888 res_exp_desc,
11889 spec_idx,
11890 TRUE);
11891
11892 res_exp_desc->rank = 0;
11893 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11894 IR_RANK(ir_idx) = res_exp_desc->rank;
11895
11896 switch (arg_info_list[info_idx1].ed.linear_type) {
11897 case Complex_4:
11898 num = PRECISION_REAL4_F90;
11899 break;
11900
11901 case Complex_8:
11902 num = PRECISION_REAL8_F90;
11903 break;
11904
11905 case Complex_16:
11906 num = PRECISION_REAL16_F90;
11907 break;
11908
11909 case Real_4:
11910 num = PRECISION_REAL4_F90;
11911 break;
11912
11913 case Real_8:
11914 num = PRECISION_REAL8_F90;
11915 break;
11916
11917 case Real_16:
11918 num = PRECISION_REAL16_F90;
11919 break;
11920 }
11921
11922 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
11923
11924 OPND_IDX((*result_opnd)) = cn_idx;
11925 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
11926 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
11927 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
11928 res_exp_desc->constant = TRUE;
11929 res_exp_desc->foldable = TRUE;
11930
11931 TRACE (Func_Exit, "precision_intrinsic", NULL);
11932
11933 }
11934
11935
11936
11937
11938
11939
11940
11941
11942
11943
11944
11945
11946
11947
11948
11949
11950
11951
11952 void kind_intrinsic(opnd_type *result_opnd,
11953 expr_arg_type *res_exp_desc,
11954 int *spec_idx)
11955 {
11956 int ir_idx;
11957 int cn_idx;
11958 int list_idx1;
11959 int info_idx1;
11960 long num;
11961
11962
11963 TRACE (Func_Entry, "kind_intrinsic", NULL);
11964
11965 ir_idx = OPND_IDX((*result_opnd));
11966 list_idx1 = IR_IDX_R(ir_idx);
11967 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
11968
11969 if (IL_FLD(list_idx1) == AT_Tbl_Idx) {
11970 AT_ARG_TO_KIND(IL_IDX(list_idx1)) = TRUE;
11971 }
11972 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
11973
11974 conform_check(0,
11975 ir_idx,
11976 res_exp_desc,
11977 spec_idx,
11978 TRUE);
11979
11980 res_exp_desc->rank = 0;
11981 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
11982 IR_RANK(ir_idx) = res_exp_desc->rank;
11983
11984
11985 switch (arg_info_list[info_idx1].ed.linear_type) {
11986 case Complex_4:
11987 num = 4;
11988 break;
11989
11990 case Complex_8:
11991 num = 8;
11992 break;
11993
11994 case Complex_16:
11995 num = 16;
11996 break;
11997
11998 case Real_4:
11999 num = 4;
12000 break;
12001
12002 case Real_8:
12003 num = 8;
12004 break;
12005
12006 case Real_16:
12007 num = 16;
12008 break;
12009
12010 case Integer_1:
12011 num = 1;
12012 break;
12013
12014 case Integer_2:
12015 num = 2;
12016 break;
12017
12018 case Integer_4:
12019 num = 4;
12020 break;
12021
12022 case Integer_8:
12023 num = 8;
12024 break;
12025
12026 case Logical_1:
12027 num = 1;
12028 break;
12029
12030 case Logical_2:
12031 num = 2;
12032 break;
12033
12034 case Logical_4:
12035 num = 4;
12036 break;
12037
12038 case Logical_8:
12039 num = 8;
12040 break;
12041
12042 case Short_Char_Const:
12043 num = 1;
12044 break;
12045
12046 case Character_1:
12047 num = 1;
12048 break;
12049
12050 case Character_2:
12051 num = 2;
12052 break;
12053
12054 case Character_4:
12055 num = 4;
12056 break;
12057 }
12058
12059 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
12060
12061 OPND_IDX((*result_opnd)) = cn_idx;
12062 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12063 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12064 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12065 res_exp_desc->constant = TRUE;
12066 res_exp_desc->foldable = TRUE;
12067
12068 if (TYP_DESC(arg_info_list[info_idx1].ed.type_idx) == Default_Typed) {
12069
12070 if (arg_info_list[info_idx1].ed.linear_type ==
12071 init_default_linear_type[Fortran_Double] ||
12072 (TYP_DP_HIT_ME(arg_info_list[info_idx1].ed.type_idx) &&
12073 arg_info_list[info_idx1].ed.linear_type ==
12074 half_linear_type[Fortran_Double])) {
12075
12076 res_exp_desc->kind0D0seen = TRUE;
12077 }
12078 else if (arg_info_list[info_idx1].ed.linear_type == REAL_DEFAULT_TYPE &&
12079 ! TYP_DP_HIT_ME(arg_info_list[info_idx1].ed.type_idx)) {
12080
12081 res_exp_desc->kind0E0seen = TRUE;
12082 }
12083 else if (arg_info_list[info_idx1].ed.linear_type ==
12084 INTEGER_DEFAULT_TYPE ||
12085 arg_info_list[info_idx1].ed.linear_type ==
12086 LOGICAL_DEFAULT_TYPE) {
12087
12088 res_exp_desc->kind0seen = TRUE;
12089 }
12090 else {
12091 res_exp_desc->kindnotconst = TRUE;
12092 }
12093 }
12094
12095
12096
12097 TRACE (Func_Exit, "eind_intrinsic", NULL);
12098
12099 }
12100
12101
12102
12103
12104
12105
12106
12107
12108
12109
12110
12111
12112
12113
12114
12115
12116
12117
12118 void bit_size_intrinsic(opnd_type *result_opnd,
12119 expr_arg_type *res_exp_desc,
12120 int *spec_idx)
12121 {
12122 int ir_idx;
12123 int cn_idx;
12124 int info_idx1;
12125 long num;
12126
12127
12128 TRACE (Func_Entry, "bit_size_intrinsic", NULL);
12129
12130 ir_idx = OPND_IDX((*result_opnd));
12131 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
12132 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
12133
12134 conform_check(0,
12135 ir_idx,
12136 res_exp_desc,
12137 spec_idx,
12138 TRUE);
12139 res_exp_desc->rank = 0;
12140 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
12141 IR_RANK(ir_idx) = res_exp_desc->rank;
12142
12143 # if 0
12144
12145 switch (arg_info_list[info_idx1].ed.linear_type) {
12146 case Integer_1:
12147 num = BITSIZE_INT1_F90;
12148 break;
12149
12150 case Integer_2:
12151 num = BITSIZE_INT2_F90;
12152 break;
12153
12154 case Integer_4:
12155 num = BITSIZE_INT4_F90;
12156 break;
12157
12158 case Integer_8:
12159 num = BITSIZE_INT8_F90;
12160 break;
12161 }
12162
12163 cn_idx = C_INT_TO_CN(arg_info_list[info_idx1].ed.type_idx, num);
12164
12165 OPND_IDX((*result_opnd)) = cn_idx;
12166 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12167 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12168 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12169 res_exp_desc->constant = TRUE;
12170 res_exp_desc->foldable = TRUE;
12171
12172 # endif
12173 res_exp_desc->foldable = FALSE;
12174 res_exp_desc->will_fold_later = FALSE;
12175
12176 TRACE (Func_Exit, "bit_size_intrinsic", NULL);
12177
12178 }
12179
12180
12181
12182
12183
12184
12185
12186
12187
12188
12189
12190
12191
12192
12193
12194
12195
12196 void lbound_intrinsic(opnd_type *result_opnd,
12197 expr_arg_type *res_exp_desc,
12198 int *spec_idx)
12199 {
12200 int select;
12201 int asg_idx;
12202 int attr_idx = NULL_IDX;
12203 int subscript_idx;
12204 long64 bit_length;
12205 int constant_type_idx;
12206 long dim;
12207 int arg1;
12208 int arg2;
12209 int arg3;
12210 int ir_idx;
12211 int il_idx;
12212 int le_idx;
12213 int eq_idx;
12214 int array_attr;
12215 boolean ok;
12216 int i;
12217 int idx;
12218 int idx2;
12219 int bd_idx;
12220 int new_idx;
12221 int cn_idx;
12222 opnd_type opnd;
12223 opnd_type base_opnd;
12224 int info_idx1;
12225 int info_idx2;
12226 int list_idx1;
12227 int list_idx2;
12228 int line;
12229 int col;
12230 boolean make_const_tmp = FALSE;
12231 int the_cn_idx;
12232 int tmp_idx;
12233 expr_arg_type loc_exp_desc;
12234 int expr_IDX[MAX_NUM_DIMS];
12235 fld_type expr_FLD[MAX_NUM_DIMS];
12236 int save_arg3;
12237 # ifdef _WHIRL_HOST64_TARGET64
12238 int const_array[MAX_NUM_DIMS];
12239 # else
12240 long_type const_array[MAX_NUM_DIMS];
12241 # endif
12242 long64 host_array[MAX_NUM_DIMS];
12243
12244
12245 TRACE (Func_Entry, "lbound_intrinsic", NULL);
12246
12247 for (i = 0; i < MAX_NUM_DIMS; i++) {
12248 expr_IDX[i] = NULL_IDX;
12249 expr_FLD[i] = NO_Tbl_Idx;
12250 host_array[i] = 0;
12251 }
12252
12253 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
12254
12255 ir_idx = OPND_IDX((*result_opnd));
12256 list_idx1 = IR_IDX_R(ir_idx);
12257 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
12258 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
12259 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
12260
12261 if (arg_info_list[info_idx1].ed.reference) {
12262 attr_idx = find_base_attr(&IL_OPND(list_idx1), &line, &col);
12263 }
12264
12265 conform_check(0,
12266 ir_idx,
12267 res_exp_desc,
12268 spec_idx,
12269 TRUE);
12270
12271
12272
12273 res_exp_desc->foldable = FALSE;
12274 res_exp_desc->will_fold_later = FALSE;
12275
12276 if (arg_info_list[info_idx1].ed.rank == 0) {
12277 PRINTMSG(arg_info_list[info_idx1].line, 640, Error,
12278 arg_info_list[info_idx1].col);
12279 }
12280
12281 if (list_idx2 != NULL_IDX && IL_IDX(list_idx2) != NULL_IDX) {
12282 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
12283
12284 if (IL_FLD(list_idx2) == CN_Tbl_Idx &&
12285 (compare_cn_and_value(IL_IDX(list_idx2), 1, Lt_Opr) ||
12286 compare_cn_and_value(IL_IDX(list_idx2),
12287 (long) arg_info_list[info_idx1].ed.rank,
12288 Gt_Opr))) {
12289
12290 find_opnd_line_and_column((opnd_type *) &IL_OPND(list_idx2),
12291 &line,
12292 &col);
12293 PRINTMSG(line, 1012, Error, col);
12294 goto EXIT;
12295 }
12296
12297 if (arg_info_list[info_idx2].ed.rank != 0) {
12298 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
12299 arg_info_list[info_idx2].col);
12300 goto EXIT;
12301 }
12302
12303 res_exp_desc->rank = 0;
12304
12305 if (arg_info_list[info_idx2].ed.reference) {
12306 attr_idx = find_base_attr(&IL_OPND(list_idx2), &line, &col);
12307
12308 if (AT_OPTIONAL(attr_idx)) {
12309 PRINTMSG(arg_info_list[info_idx2].line, 875, Error,
12310 arg_info_list[info_idx2].col);
12311 }
12312 }
12313
12314 # if 0
12315
12316 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
12317
12318 dim = (long) CN_INT_TO_C(IL_IDX(list_idx2));
12319
12320 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
12321 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
12322 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
12323 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
12324 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
12325
12326 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
12327
12328 COPY_OPND(opnd, IL_OPND(list_idx1));
12329 array_attr = find_base_attr(&opnd, &line, &col);
12330
12331 bd_idx = ATD_ARRAY_IDX(array_attr);
12332
12333
12334
12335
12336 idx = IL_IDX(list_idx1);
12337
12338 if (IR_OPR(idx) == Whole_Substring_Opr) {
12339 idx = IR_IDX_L(idx);
12340 }
12341
12342 idx = IR_IDX_R(idx);
12343
12344 for (i = 1; i < dim; i++) {
12345 idx = IL_NEXT_LIST_IDX(idx);
12346 }
12347 idx = IL_IDX(idx);
12348 idx = IR_IDX_L(idx);
12349
12350 if (arg_info_list[info_idx1].ed.shape[dim-1].fld == CN_Tbl_Idx) {
12351
12352 if (compare_cn_and_value(
12353 arg_info_list[info_idx1].ed.shape[dim-1].idx, 0, Le_Opr)) {
12354
12355
12356
12357 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
12358 CN_INTEGER_ONE_IDX :
12359 C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
12360
12361 OPND_IDX((*result_opnd)) = cn_idx;
12362 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12363 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12364 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12365 }
12366 else {
12367
12368 COPY_OPND((*result_opnd), IL_OPND(idx));
12369 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
12370 res_exp_desc->type_idx =
12371 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
12372 res_exp_desc->linear_type =
12373 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
12374 }
12375
12376 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
12377 res_exp_desc->constant = TRUE;
12378 res_exp_desc->foldable = TRUE;
12379 }
12380 }
12381 else {
12382
12383
12384
12385 NTR_IR_LIST_TBL(arg1);
12386 IL_ARG_DESC_VARIANT(arg1) = TRUE;
12387
12388 NTR_IR_LIST_TBL(arg2);
12389 IL_ARG_DESC_VARIANT(arg2) = TRUE;
12390
12391 NTR_IR_LIST_TBL(arg3);
12392 IL_ARG_DESC_VARIANT(arg3) = TRUE;
12393
12394
12395 IL_NEXT_LIST_IDX(arg1) = arg2;
12396 IL_NEXT_LIST_IDX(arg2) = arg3;
12397
12398 IR_OPR(ir_idx) = Cvmgt_Opr;
12399 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
12400 IR_IDX_L(ir_idx) = arg1;
12401 IR_LIST_CNT_L(ir_idx) = 3;
12402
12403
12404 io_item_must_flatten = TRUE;
12405
12406
12407 IR_OPND_R(ir_idx) = null_opnd;
12408
12409 IL_FLD(arg1) = CN_Tbl_Idx;
12410 IL_IDX(arg1) = CN_INTEGER_ONE_IDX;
12411 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
12412 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
12413
12414 COPY_OPND(IL_OPND(arg2), IL_OPND(idx));
12415
12416 le_idx=gen_ir(OPND_FLD(arg_info_list[info_idx1].ed.shape[dim-1]),
12417 OPND_IDX(arg_info_list[info_idx1].ed.shape[dim-1]),
12418 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12419 IR_COL_NUM(ir_idx),
12420 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
12421
12422 IL_FLD(arg3) = IR_Tbl_Idx;
12423 IL_IDX(arg3) = le_idx;
12424 IL_LINE_NUM(arg3) = IR_LINE_NUM(ir_idx);
12425 IL_COL_NUM(arg3) = IR_COL_NUM(ir_idx);
12426 }
12427 }
12428 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
12429 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
12430 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
12431 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
12432
12433
12434
12435
12436 if (IL_FLD(list_idx1) == AT_Tbl_Idx) {
12437 attr_idx = IL_IDX(list_idx1);
12438 }
12439 else {
12440 attr_idx = IR_IDX_L(IL_IDX(list_idx1));
12441 }
12442
12443 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
12444 bd_idx = ATD_ARRAY_IDX(attr_idx);
12445
12446 if (dim == BD_RANK(bd_idx)) {
12447 OPND_IDX((*result_opnd)) = BD_LB_IDX(bd_idx, dim);
12448 OPND_FLD((*result_opnd)) = BD_LB_FLD(bd_idx, dim);
12449 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12450 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12451
12452 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
12453 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
12454 res_exp_desc->linear_type =
12455 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
12456
12457 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
12458 res_exp_desc->constant = TRUE;
12459 res_exp_desc->foldable = TRUE;
12460 }
12461 }
12462 else if (BD_XT_FLD(bd_idx, dim) == CN_Tbl_Idx) {
12463
12464 if (compare_cn_and_value(BD_XT_IDX(bd_idx, dim), 0, Le_Opr)) {
12465
12466
12467
12468 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
12469 CN_INTEGER_ONE_IDX :
12470 C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
12471
12472 OPND_IDX((*result_opnd)) = cn_idx;
12473 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12474 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12475 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12476 }
12477 else {
12478 OPND_IDX((*result_opnd)) = BD_LB_IDX(bd_idx, dim);
12479 OPND_FLD((*result_opnd)) = BD_LB_FLD(bd_idx, dim);
12480 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12481 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12482 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
12483 res_exp_desc->type_idx =
12484 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
12485 res_exp_desc->linear_type =
12486 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
12487 }
12488
12489 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
12490 res_exp_desc->constant = TRUE;
12491 res_exp_desc->foldable = TRUE;
12492 }
12493 }
12494 else {
12495
12496
12497
12498 NTR_IR_LIST_TBL(arg1);
12499 IL_ARG_DESC_VARIANT(arg1) = TRUE;
12500
12501 NTR_IR_LIST_TBL(arg2);
12502 IL_ARG_DESC_VARIANT(arg2) = TRUE;
12503
12504 NTR_IR_LIST_TBL(arg3);
12505 IL_ARG_DESC_VARIANT(arg3) = TRUE;
12506
12507
12508 IL_NEXT_LIST_IDX(arg1) = arg2;
12509 IL_NEXT_LIST_IDX(arg2) = arg3;
12510
12511 IR_OPR(ir_idx) = Cvmgt_Opr;
12512 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
12513 IR_IDX_L(ir_idx) = arg1;
12514 IR_LIST_CNT_L(ir_idx) = 3;
12515
12516
12517 io_item_must_flatten = TRUE;
12518
12519
12520 IR_OPND_R(ir_idx) = null_opnd;
12521
12522 IL_FLD(arg1) = CN_Tbl_Idx;
12523 IL_IDX(arg1) = CN_INTEGER_ONE_IDX;
12524 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
12525 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
12526
12527 IL_FLD(arg2) = BD_LB_FLD(bd_idx, dim);
12528 IL_IDX(arg2) = BD_LB_IDX(bd_idx, dim);
12529 IL_LINE_NUM(arg2) = IR_LINE_NUM(ir_idx);
12530 IL_COL_NUM(arg2) = IR_COL_NUM(ir_idx);
12531
12532 le_idx = gen_ir(BD_XT_FLD(bd_idx, dim), BD_XT_IDX(bd_idx, dim),
12533 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12534 IR_COL_NUM(ir_idx),
12535 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
12536
12537 IL_FLD(arg3) = IR_Tbl_Idx;
12538 IL_IDX(arg3) = le_idx;
12539 }
12540 }
12541 else if (arg_info_list[info_idx1].ed.section ||
12542 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
12543 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
12544
12545
12546
12547 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
12548
12549 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
12550 CN_INTEGER_ONE_IDX :
12551 C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
12552 OPND_IDX((*result_opnd)) = cn_idx;
12553 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12554 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12555 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12556 res_exp_desc->constant = TRUE;
12557 res_exp_desc->foldable = TRUE;
12558 }
12559 }
12560 else {
12561
12562
12563 COPY_OPND(opnd, IL_OPND(list_idx2));
12564 cast_to_cg_default(&opnd, &(arg_info_list[info_idx2].ed));
12565 COPY_OPND(IL_OPND(list_idx2), opnd);
12566
12567 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
12568 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
12569 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
12570 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
12571 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
12572 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
12573
12574 COPY_OPND(opnd, IL_OPND(list_idx1));
12575 array_attr = find_base_attr(&opnd, &line, &col);
12576
12577 bd_idx = ATD_ARRAY_IDX(array_attr);
12578
12579
12580
12581
12582 idx = IL_IDX(list_idx1);
12583
12584 if (IR_OPR(idx) == Whole_Substring_Opr) {
12585 idx = IR_IDX_L(idx);
12586 }
12587
12588 il_idx = IR_IDX_R(idx);
12589 idx = IL_IDX(il_idx);
12590 idx = IR_IDX_L(idx);
12591
12592 OPND_FLD(base_opnd) = CN_Tbl_Idx;
12593 OPND_IDX(base_opnd) = CN_INTEGER_ZERO_IDX;
12594 OPND_LINE_NUM(base_opnd) = IR_LINE_NUM(ir_idx);
12595 OPND_COL_NUM(base_opnd) = IR_COL_NUM(ir_idx);
12596
12597 for (i = 1; i <= arg_info_list[info_idx1].ed.rank; i++) {
12598
12599 NTR_IR_LIST_TBL(arg1);
12600 IL_ARG_DESC_VARIANT(arg1) = TRUE;
12601 NTR_IR_LIST_TBL(arg2);
12602 IL_ARG_DESC_VARIANT(arg2) = TRUE;
12603 NTR_IR_LIST_TBL(arg3);
12604 IL_ARG_DESC_VARIANT(arg3) = TRUE;
12605
12606
12607 IL_NEXT_LIST_IDX(arg1) = arg2;
12608 IL_NEXT_LIST_IDX(arg2) = arg3;
12609
12610 select = gen_ir(IL_Tbl_Idx, arg1,
12611 Cvmgt_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12612 IR_COL_NUM(ir_idx),
12613 NO_Tbl_Idx, NULL_IDX);
12614
12615
12616 io_item_must_flatten = TRUE;
12617
12618 COPY_OPND(IL_OPND(arg1), IL_OPND(idx));
12619 il_idx = IL_NEXT_LIST_IDX(il_idx);
12620 idx = IL_IDX(il_idx);
12621 idx = IR_IDX_L(idx);
12622
12623 COPY_OPND(IL_OPND(arg2), base_opnd);
12624
12625 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i);
12626
12627 eq_idx = gen_ir(IL_FLD(list_idx2), IL_IDX(list_idx2),
12628 Eq_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12629 IR_COL_NUM(ir_idx),
12630 CN_Tbl_Idx, cn_idx);
12631
12632 IL_FLD(arg3) = IR_Tbl_Idx;
12633 IL_IDX(arg3) = eq_idx;
12634 IL_LINE_NUM(arg3) = IR_LINE_NUM(ir_idx);
12635 IL_COL_NUM(arg3) = IR_COL_NUM(ir_idx);
12636
12637 OPND_FLD(base_opnd) = IR_Tbl_Idx;
12638 OPND_IDX(base_opnd) = select;
12639 }
12640
12641
12642
12643 NTR_IR_LIST_TBL(arg1);
12644 IL_ARG_DESC_VARIANT(arg1) = TRUE;
12645
12646 NTR_IR_LIST_TBL(arg2);
12647 IL_ARG_DESC_VARIANT(arg2) = TRUE;
12648
12649 NTR_IR_LIST_TBL(arg3);
12650 IL_ARG_DESC_VARIANT(arg3) = TRUE;
12651
12652
12653 IL_NEXT_LIST_IDX(arg1) = arg2;
12654 IL_NEXT_LIST_IDX(arg2) = arg3;
12655
12656 IR_OPR(ir_idx) = Cvmgt_Opr;
12657 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
12658 IR_IDX_L(ir_idx) = arg1;
12659 IR_LIST_CNT_L(ir_idx) = 3;
12660
12661
12662 io_item_must_flatten = TRUE;
12663
12664
12665 IR_OPND_R(ir_idx) = null_opnd;
12666
12667 IL_FLD(arg1) = CN_Tbl_Idx;
12668 IL_IDX(arg1) = CN_INTEGER_ONE_IDX;
12669 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
12670 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
12671
12672 IL_FLD(arg2) = IR_Tbl_Idx;
12673 IL_IDX(arg2) = select;
12674
12675 save_arg3 = arg3;
12676
12677 OPND_FLD(base_opnd) = CN_Tbl_Idx;
12678 OPND_IDX(base_opnd) = CN_INTEGER_ZERO_IDX;
12679 OPND_LINE_NUM(base_opnd) = IR_LINE_NUM(ir_idx);
12680 OPND_COL_NUM(base_opnd) = IR_COL_NUM(ir_idx);
12681
12682 for (i = 1; i <= arg_info_list[info_idx1].ed.rank; i++) {
12683
12684 NTR_IR_LIST_TBL(arg1);
12685 IL_ARG_DESC_VARIANT(arg1) = TRUE;
12686 NTR_IR_LIST_TBL(arg2);
12687 IL_ARG_DESC_VARIANT(arg2) = TRUE;
12688 NTR_IR_LIST_TBL(arg3);
12689 IL_ARG_DESC_VARIANT(arg3) = TRUE;
12690
12691
12692 IL_NEXT_LIST_IDX(arg1) = arg2;
12693 IL_NEXT_LIST_IDX(arg2) = arg3;
12694
12695 select = gen_ir(IL_Tbl_Idx, arg1,
12696 Cvmgt_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12697 IR_COL_NUM(ir_idx),
12698 NO_Tbl_Idx, NULL_IDX);
12699
12700
12701 io_item_must_flatten = TRUE;
12702
12703 COPY_OPND(IL_OPND(arg1),
12704 arg_info_list[info_idx1].ed.shape[i-1]);
12705 COPY_OPND(IL_OPND(arg2), base_opnd);
12706
12707 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i);
12708
12709 eq_idx = gen_ir(IL_FLD(list_idx2), IL_IDX(list_idx2),
12710 Eq_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12711 IR_COL_NUM(ir_idx),
12712 CN_Tbl_Idx, cn_idx);
12713
12714 IL_FLD(arg3) = IR_Tbl_Idx;
12715 IL_IDX(arg3) = eq_idx;
12716 IL_LINE_NUM(arg3) = IR_LINE_NUM(ir_idx);
12717 IL_COL_NUM(arg3) = IR_COL_NUM(ir_idx);
12718
12719 OPND_FLD(base_opnd) = IR_Tbl_Idx;
12720 OPND_IDX(base_opnd) = select;
12721 }
12722
12723 le_idx = gen_ir(IR_Tbl_Idx, select,
12724 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12725 IR_COL_NUM(ir_idx),
12726 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
12727
12728 IL_FLD(save_arg3) = IR_Tbl_Idx;
12729 IL_IDX(save_arg3) = le_idx;
12730 }
12731 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
12732 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
12733 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
12734 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
12735
12736
12737
12738
12739
12740 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
12741 }
12742 else if (arg_info_list[info_idx1].ed.section ||
12743 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
12744 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
12745
12746 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
12747
12748 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
12749 CN_INTEGER_ONE_IDX :
12750 C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
12751
12752 OPND_IDX((*result_opnd)) = cn_idx;
12753 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
12754 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
12755 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
12756 res_exp_desc->constant = TRUE;
12757 res_exp_desc->foldable = TRUE;
12758 }
12759 }
12760
12761 #endif
12762
12763 }
12764 else {
12765
12766 # if 0
12767
12768 res_exp_desc->shape[0].fld = CN_Tbl_Idx;
12769 res_exp_desc->shape[0].idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
12770 res_exp_desc->rank);
12771 SHAPE_WILL_FOLD_LATER(res_exp_desc->shape[0]) = TRUE;
12772 SHAPE_FOLDABLE(res_exp_desc->shape[0]) = TRUE;
12773
12774 res_exp_desc->rank = 1;
12775
12776 if (IR_LIST_CNT_R(ir_idx) == 1) {
12777 IR_LIST_CNT_R(ir_idx) = 2;
12778 NTR_IR_LIST_TBL(new_idx);
12779 IL_INTRIN_PLACE_HOLDER(new_idx) = TRUE;
12780 IL_ARG_DESC_VARIANT(new_idx) = TRUE;
12781 IL_NEXT_LIST_IDX(IR_IDX_R(ir_idx)) = new_idx;
12782 }
12783
12784
12785 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
12786 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
12787 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
12788 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
12789 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
12790
12791
12792 COPY_OPND(opnd, IL_OPND(list_idx1));
12793 array_attr = find_base_attr(&opnd, &line, &col);
12794
12795 bd_idx = ATD_ARRAY_IDX(array_attr);
12796
12797
12798
12799
12800 idx = IL_IDX(list_idx1);
12801
12802 if (IR_OPR(idx) == Whole_Substring_Opr) {
12803 idx = IR_IDX_L(idx);
12804 }
12805
12806 idx = IR_IDX_R(idx);
12807
12808 res_exp_desc->will_fold_later = TRUE;
12809
12810 for (i = 0; i < BD_RANK(bd_idx); i++) {
12811
12812 idx2 = IL_IDX(idx);
12813 idx2 = IR_IDX_L(idx2);
12814
12815 if (arg_info_list[info_idx1].ed.shape[i].fld != CN_Tbl_Idx ||
12816 IL_FLD(idx2) != CN_Tbl_Idx) {
12817
12818 NTR_IR_LIST_TBL(arg1);
12819 IL_ARG_DESC_VARIANT(arg1) = TRUE;
12820 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
12821 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
12822 IL_FLD(arg1) = CN_Tbl_Idx;
12823
12824
12825
12826 cn_idx = (CG_INTEGER_DEFAULT_TYPE == INTEGER_DEFAULT_TYPE) ?
12827 CN_INTEGER_ONE_IDX :
12828 C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 1);
12829
12830 IL_IDX(arg1) = cn_idx;
12831
12832 NTR_IR_LIST_TBL(arg2);
12833 IL_ARG_DESC_VARIANT(arg2) = TRUE;
12834 IL_LINE_NUM(arg2) = IR_LINE_NUM(ir_idx);
12835 IL_COL_NUM(arg2) = IR_COL_NUM(ir_idx);
12836 IL_FLD(arg2) = IL_FLD(idx2);
12837 IL_IDX(arg2) = IL_IDX(idx2);
12838
12839 NTR_IR_LIST_TBL(arg3);
12840 IL_ARG_DESC_VARIANT(arg3) = TRUE;
12841
12842 le_idx = gen_ir(OPND_FLD(arg_info_list[info_idx1].ed.shape[i]),
12843 OPND_IDX(arg_info_list[info_idx1].ed.shape[i]),
12844 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12845 IR_COL_NUM(ir_idx),
12846 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
12847
12848 IL_FLD(arg3) = IR_Tbl_Idx;
12849 IL_IDX(arg3) = le_idx;
12850
12851
12852 IL_NEXT_LIST_IDX(arg1) = arg2;
12853 IL_NEXT_LIST_IDX(arg2) = arg3;
12854
12855 select = gen_ir(IL_Tbl_Idx, arg1,
12856 Cvmgt_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
12857 IR_COL_NUM(ir_idx),
12858 NO_Tbl_Idx, NULL_IDX);
12859
12860
12861 io_item_must_flatten = TRUE;
12862
12863 expr_IDX[i] = select;
12864 expr_FLD[i] = IR_Tbl_Idx;
12865 host_array[i] = 0;
12866 }
12867 else if (compare_cn_and_value(arg_info_list[info_idx1].ed.
12868 shape[i].idx,
12869 0,
12870 Le_Opr)) {
12871 host_array[i] = 1;
12872 }
12873 else {
12874 host_array[i] = CN_INT_TO_C(IL_IDX(idx2));
12875 }
12876
12877 idx = IL_NEXT_LIST_IDX(idx);
12878 }
12879 }
12880 else if (arg_info_list[info_idx1].ed.section ||
12881 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
12882 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
12883
12884 res_exp_desc->will_fold_later = TRUE;
12885
12886 for (i = 0; i < arg_info_list[info_idx1].ed.rank; i++) {
12887 host_array[i] = 1;
12888 }
12889 }
12890 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
12891 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
12892 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
12893 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
12894
12895
12896
12897 if (IL_FLD(list_idx1) == AT_Tbl_Idx) {
12898 attr_idx = IL_IDX(list_idx1);
12899 }
12900 else {
12901 attr_idx = IR_IDX_L(IL_IDX(list_idx1));
12902 }
12903
12904 bd_idx = ATD_ARRAY_IDX(attr_idx);
12905
12906 res_exp_desc->will_fold_later = TRUE;
12907
12908 for (i = 1; i < BD_RANK(bd_idx); i++) {
12909
12910 if (BD_LB_FLD(bd_idx, i) != CN_Tbl_Idx ||
12911 BD_XT_FLD(bd_idx, i) != CN_Tbl_Idx) {
12912
12913 res_exp_desc->will_fold_later = FALSE;
12914 break;
12915 }
12916 else if (compare_cn_and_value(BD_XT_IDX(bd_idx, i), 0, Le_Opr)) {
12917 host_array[(i-1)] = 1;
12918 }
12919 else {
12920 host_array[(i-1)] = CN_INT_TO_C(BD_LB_IDX(bd_idx,i));
12921 }
12922 }
12923
12924 if (BD_LB_FLD(bd_idx, BD_RANK(bd_idx)) != CN_Tbl_Idx) {
12925 res_exp_desc->will_fold_later = FALSE;
12926 }
12927 else {
12928 host_array[(BD_RANK(bd_idx)-1)] = CN_INT_TO_C(
12929 BD_LB_IDX(bd_idx, BD_RANK(bd_idx)));
12930 }
12931 }
12932
12933 if (res_exp_desc->will_fold_later) {
12934 make_const_tmp = TRUE;
12935 }
12936
12937 # endif
12938
12939 }
12940
12941 # if 0
12942
12943 if (make_const_tmp) {
12944 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
12945 bit_length = TARGET_BITS_PER_WORD * arg_info_list[info_idx1].ed.rank;
12946 # ifdef _WHIRL_HOST64_TARGET64
12947 bit_length >>= 1;
12948 # endif
12949
12950 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
12951 TYP_TYPE(TYP_WORK_IDX) = Typeless;
12952 TYP_BIT_LEN(TYP_WORK_IDX) = bit_length;
12953 constant_type_idx = ntr_type_tbl();
12954
12955 for (i = 0; i < MAX_NUM_DIMS; i++) {
12956
12957 # if defined(_TARGET32)
12958
12959
12960
12961
12962 if (INTEGER_DEFAULT_TYPE == Integer_8) {
12963
12964
12965 }
12966 # endif
12967
12968
12969
12970 const_array[i] = (long_type) host_array[i];
12971 }
12972
12973 the_cn_idx = ntr_const_tbl(constant_type_idx,
12974 FALSE,
12975 const_array);
12976
12977
12978 tmp_idx = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
12979 IR_COL_NUM(ir_idx),
12980 Shared, TRUE);
12981
12982 AT_SEMANTICS_DONE(tmp_idx) = TRUE;
12983 ATD_TYPE_IDX(tmp_idx) = CG_INTEGER_DEFAULT_TYPE;
12984
12985 loc_exp_desc = *res_exp_desc;
12986 loc_exp_desc.type_idx = CG_INTEGER_DEFAULT_TYPE;
12987 loc_exp_desc.type = Integer;
12988 loc_exp_desc.linear_type = CG_INTEGER_DEFAULT_TYPE;
12989
12990 ATD_ARRAY_IDX(tmp_idx) = create_bd_ntry_for_const(&loc_exp_desc,
12991 IR_LINE_NUM(ir_idx),
12992 IR_COL_NUM(ir_idx));
12993
12994 ATD_SAVED(tmp_idx) = TRUE;
12995 ATD_DATA_INIT(tmp_idx) = TRUE;
12996 ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_STATIC_INIT_IDX(curr_scp_idx);
12997 ATD_FLD(tmp_idx) = CN_Tbl_Idx;
12998 ATD_TMP_IDX(tmp_idx) = the_cn_idx;
12999 ATD_TMP_INIT_NOT_DONE(tmp_idx) = TRUE;
13000
13001 OPND_IDX((*result_opnd)) = tmp_idx;
13002 OPND_FLD((*result_opnd)) = AT_Tbl_Idx;
13003 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
13004 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
13005
13006 ok = gen_whole_subscript(result_opnd, res_exp_desc);
13007
13008 if (CG_INTEGER_DEFAULT_TYPE != INTEGER_DEFAULT_TYPE) {
13009 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
13010
13011 ok = fold_aggragate_expression(result_opnd,
13012 res_exp_desc,
13013 FALSE);
13014
13015 if (OPND_FLD((*result_opnd)) == IR_Tbl_Idx) {
13016 idx = OPND_IDX((*result_opnd));
13017 if (IR_FLD_L(idx) == AT_Tbl_Idx) {
13018 tmp_idx = IR_IDX_L(idx);
13019 }
13020 }
13021 }
13022
13023 AT_REFERENCED(tmp_idx) = Referenced;
13024 AT_DEFINED(tmp_idx) = TRUE;
13025
13026 res_exp_desc->foldable = TRUE;
13027 res_exp_desc->tmp_reference = TRUE;
13028 }
13029
13030
13031
13032
13033 for (i = 0; i < MAX_NUM_DIMS; i++) {
13034 if (expr_IDX[i] != NULL_IDX) {
13035 res_exp_desc->foldable = FALSE;
13036 res_exp_desc->will_fold_later = FALSE;
13037
13038 NTR_IR_LIST_TBL(idx);
13039 IL_FLD(idx) = CN_Tbl_Idx;
13040
13041 IL_IDX(idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i+1);
13042 IL_LINE_NUM(idx) = IR_LINE_NUM(ir_idx);
13043 IL_COL_NUM(idx) = IR_COL_NUM(ir_idx);
13044
13045 NTR_IR_TBL(subscript_idx);
13046 IR_TYPE_IDX(subscript_idx) = CG_INTEGER_DEFAULT_TYPE;
13047 IR_OPR(subscript_idx) = Subscript_Opr;
13048 IR_LINE_NUM(subscript_idx) = IR_LINE_NUM(ir_idx);
13049 IR_COL_NUM(subscript_idx) = IR_COL_NUM(ir_idx);
13050 IR_FLD_L(subscript_idx) = AT_Tbl_Idx;
13051 IR_IDX_L(subscript_idx) = tmp_idx;
13052 IR_LINE_NUM_L(subscript_idx) = IR_LINE_NUM(ir_idx);
13053 IR_COL_NUM_L(subscript_idx) = IR_COL_NUM(ir_idx);
13054 IR_FLD_R(subscript_idx) = IL_Tbl_Idx;
13055 IR_IDX_R(subscript_idx) = idx;
13056 IR_LINE_NUM_R(subscript_idx) = IR_LINE_NUM(ir_idx);
13057 IR_COL_NUM_R(subscript_idx) = IR_COL_NUM(ir_idx);
13058 IR_LIST_CNT_R(subscript_idx) = 1;
13059
13060 asg_idx = gen_ir(IR_Tbl_Idx, subscript_idx,
13061 Asg_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13062 IR_COL_NUM(ir_idx),
13063 expr_FLD[i], expr_IDX[i]);
13064
13065 gen_sh(Before,
13066 Assignment_Stmt,
13067 IR_LINE_NUM(ir_idx),
13068 IR_COL_NUM(ir_idx),
13069 FALSE,
13070 FALSE,
13071 TRUE);
13072
13073 SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
13074 SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
13075 }
13076 }
13077
13078 # endif
13079
13080 EXIT:
13081
13082 if (OPND_FLD((*result_opnd)) != IR_Tbl_Idx ||
13083 IR_OPR(OPND_IDX((*result_opnd))) != Call_Opr) {
13084
13085 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
13086 }
13087
13088 IR_TYPE_IDX(ir_idx) = INTEGER_DEFAULT_TYPE;
13089 IR_RANK(ir_idx) = res_exp_desc->rank;
13090
13091 res_exp_desc->foldable = FALSE;
13092 res_exp_desc->will_fold_later = FALSE;
13093
13094 TRACE (Func_Exit, "lbound_intrinsic", NULL);
13095
13096 }
13097
13098
13099
13100
13101
13102
13103
13104
13105
13106
13107
13108
13109
13110
13111
13112
13113
13114 void ubound_intrinsic(opnd_type *result_opnd,
13115 expr_arg_type *res_exp_desc,
13116 int *spec_idx)
13117 {
13118 int asg_idx;
13119 int attr_idx = NULL_IDX;
13120 int select;
13121 long64 bit_length;
13122 int constant_type_idx;
13123 long dim;
13124 int arg1;
13125 int arg2;
13126 int arg3;
13127 int ir_idx;
13128 int il_idx;
13129 int le_idx;
13130 int eq_idx;
13131 int array_attr;
13132 # ifdef _WHIRL_HOST64_TARGET64
13133 int const_array[MAX_NUM_DIMS];
13134 # else
13135 long_type const_array[MAX_NUM_DIMS];
13136 # endif
13137 long64 host_array[MAX_NUM_DIMS];
13138 int expr_IDX[MAX_NUM_DIMS];
13139 fld_type expr_FLD[MAX_NUM_DIMS];
13140 boolean ok;
13141 int idx;
13142 int idx2;
13143 int i;
13144 int bd_idx;
13145 int new_idx;
13146 int cn_idx;
13147 opnd_type opnd;
13148 opnd_type base_opnd;
13149 int info_idx1;
13150 int info_idx2;
13151 int list_idx1;
13152 int list_idx2;
13153 int line;
13154 int col;
13155 boolean make_const_tmp = FALSE;
13156 int the_cn_idx;
13157 int tmp_idx;
13158 int subscript_idx;
13159 expr_arg_type loc_exp_desc;
13160 int save_arg3;
13161
13162
13163 TRACE (Func_Entry, "ubound_intrinsic", NULL);
13164
13165 for (i = 0; i < MAX_NUM_DIMS; i++) {
13166 expr_IDX[i] = NULL_IDX;
13167 expr_FLD[i] = NO_Tbl_Idx;
13168 host_array[i] = 0;
13169 }
13170
13171 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
13172
13173 ir_idx = OPND_IDX((*result_opnd));
13174 list_idx1 = IR_IDX_R(ir_idx);
13175 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
13176 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
13177 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
13178
13179 if (arg_info_list[info_idx1].ed.reference) {
13180 attr_idx = find_base_attr(&IL_OPND(list_idx1), &line, &col);
13181 }
13182
13183 conform_check(0,
13184 ir_idx,
13185 res_exp_desc,
13186 spec_idx,
13187 TRUE);
13188
13189
13190 res_exp_desc->foldable = FALSE;
13191 res_exp_desc->will_fold_later = FALSE;
13192
13193 if (arg_info_list[info_idx1].ed.rank == 0) {
13194 PRINTMSG(arg_info_list[info_idx1].line, 640, Error,
13195 arg_info_list[info_idx1].col);
13196 }
13197
13198 if (list_idx2 != NULL_IDX && IL_IDX(list_idx2) != NULL_IDX) {
13199 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
13200
13201 if (IL_FLD(list_idx2) == CN_Tbl_Idx &&
13202 (compare_cn_and_value(IL_IDX(list_idx2), 1, Lt_Opr) ||
13203 compare_cn_and_value(IL_IDX(list_idx2),
13204 (long) arg_info_list[info_idx1].ed.rank,
13205 Gt_Opr))) {
13206
13207 find_opnd_line_and_column((opnd_type *) &IL_OPND(list_idx2),
13208 &line,
13209 &col);
13210 PRINTMSG(line, 1012, Error, col);
13211 goto EXIT;
13212 }
13213
13214
13215 if (arg_info_list[info_idx2].ed.rank != 0) {
13216 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
13217 arg_info_list[info_idx2].col);
13218 goto EXIT;
13219 }
13220
13221 res_exp_desc->rank = 0;
13222
13223 if (arg_info_list[info_idx2].ed.reference) {
13224 attr_idx = find_base_attr(&IL_OPND(list_idx2), &line, &col);
13225
13226 if (AT_OPTIONAL(attr_idx)) {
13227 PRINTMSG(arg_info_list[info_idx2].line, 875, Error,
13228 arg_info_list[info_idx2].col);
13229 }
13230 }
13231
13232 # if 0
13233
13234 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
13235 dim = (long) CN_INT_TO_C(IL_IDX(list_idx2));
13236
13237 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13238 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
13239 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13240 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
13241 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
13242
13243 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
13244
13245 idx = IL_IDX(list_idx1);
13246
13247 if (IR_OPR(idx) == Whole_Substring_Opr) {
13248 idx = IR_IDX_L(idx);
13249 }
13250
13251 bd_idx = idx;
13252 idx = IR_IDX_R(idx);
13253
13254 COPY_OPND(opnd, IR_OPND_L(bd_idx));
13255 array_attr = find_base_attr(&opnd, &line, &col);
13256
13257 bd_idx = ATD_ARRAY_IDX(array_attr);
13258
13259 for (i = 1; i < dim; i++) {
13260 idx = IL_NEXT_LIST_IDX(idx);
13261 }
13262 idx = IL_IDX(idx);
13263 idx = IR_IDX_L(idx);
13264 idx = IL_NEXT_LIST_IDX(idx);
13265
13266 if (arg_info_list[info_idx1].ed.shape[dim-1].fld == CN_Tbl_Idx) {
13267
13268 if (compare_cn_and_value(
13269 arg_info_list[info_idx1].ed.shape[dim-1].idx, 0, Le_Opr)) {
13270
13271
13272 OPND_IDX((*result_opnd)) = (CG_INTEGER_DEFAULT_TYPE ==
13273 INTEGER_DEFAULT_TYPE) ?
13274 CN_INTEGER_ZERO_IDX :
13275 C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 0);
13276 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
13277 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
13278 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
13279 }
13280 else {
13281
13282 COPY_OPND((*result_opnd), IL_OPND(idx));
13283 }
13284
13285 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
13286 res_exp_desc->constant = TRUE;
13287 res_exp_desc->foldable = TRUE;
13288 }
13289 }
13290 else {
13291
13292 NTR_IR_LIST_TBL(arg1);
13293 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13294
13295 NTR_IR_LIST_TBL(arg2);
13296 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13297
13298 NTR_IR_LIST_TBL(arg3);
13299 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13300
13301
13302 IL_NEXT_LIST_IDX(arg1) = arg2;
13303 IL_NEXT_LIST_IDX(arg2) = arg3;
13304
13305 IR_OPR(ir_idx) = Cvmgt_Opr;
13306 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
13307 IR_IDX_L(ir_idx) = arg1;
13308 IR_LIST_CNT_L(ir_idx) = 3;
13309
13310
13311 io_item_must_flatten = TRUE;
13312
13313
13314 IR_OPND_R(ir_idx) = null_opnd;
13315
13316 IL_FLD(arg1) = CN_Tbl_Idx;
13317 IL_IDX(arg1) = CN_INTEGER_ZERO_IDX;
13318 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
13319 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
13320
13321 COPY_OPND(IL_OPND(arg2), IL_OPND(idx));
13322
13323 le_idx=gen_ir(OPND_FLD(arg_info_list[info_idx1].ed.shape[dim-1]),
13324 OPND_IDX(arg_info_list[info_idx1].ed.shape[dim-1]),
13325 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13326 IR_COL_NUM(ir_idx),
13327 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
13328
13329 IL_FLD(arg3) = IR_Tbl_Idx;
13330 IL_IDX(arg3) = le_idx;
13331
13332
13333 }
13334 }
13335 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
13336 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
13337 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13338 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
13339
13340
13341
13342 if (IL_FLD(list_idx1) == AT_Tbl_Idx) {
13343 attr_idx = IL_IDX(list_idx1);
13344 }
13345 else {
13346 attr_idx = IR_IDX_L(IL_IDX(list_idx1));
13347 }
13348
13349 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
13350 bd_idx = ATD_ARRAY_IDX(attr_idx);
13351
13352 if (compare_cn_and_value(IL_IDX(list_idx2),
13353 (long) BD_RANK(bd_idx),
13354 Eq_Opr)) {
13355
13356 PRINTMSG(arg_info_list[info_idx1].line, 889, Error,
13357 arg_info_list[info_idx1].col);
13358 }
13359 else if (BD_XT_FLD(bd_idx, dim) == CN_Tbl_Idx) {
13360
13361 if (compare_cn_and_value(BD_XT_IDX(bd_idx, dim), 0, Le_Opr)) {
13362
13363 OPND_IDX((*result_opnd)) = CN_INTEGER_ZERO_IDX;
13364 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
13365 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
13366 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
13367 }
13368 else {
13369 OPND_IDX((*result_opnd)) = BD_UB_IDX(bd_idx, dim);
13370 OPND_FLD((*result_opnd)) = BD_UB_FLD(bd_idx, dim);
13371 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
13372 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
13373 }
13374
13375 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
13376 res_exp_desc->constant = TRUE;
13377 res_exp_desc->foldable = TRUE;
13378 }
13379 }
13380 else {
13381
13382
13383
13384 NTR_IR_LIST_TBL(arg1);
13385 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13386
13387 NTR_IR_LIST_TBL(arg2);
13388 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13389
13390 NTR_IR_LIST_TBL(arg3);
13391 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13392
13393
13394 IL_NEXT_LIST_IDX(arg1) = arg2;
13395 IL_NEXT_LIST_IDX(arg2) = arg3;
13396
13397 IR_OPR(ir_idx) = Cvmgt_Opr;
13398 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
13399 IR_IDX_L(ir_idx) = arg1;
13400 IR_LIST_CNT_L(ir_idx) = 3;
13401
13402
13403 io_item_must_flatten = TRUE;
13404
13405
13406 IR_OPND_R(ir_idx) = null_opnd;
13407
13408 IL_FLD(arg1) = CN_Tbl_Idx;
13409 IL_IDX(arg1) = CN_INTEGER_ONE_IDX;
13410 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
13411 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
13412
13413 IL_FLD(arg2) = BD_UB_FLD(bd_idx, dim);
13414 IL_IDX(arg2) = BD_UB_IDX(bd_idx, dim);
13415 IL_LINE_NUM(arg2) = IR_LINE_NUM(ir_idx);
13416 IL_COL_NUM(arg2) = IR_COL_NUM(ir_idx);
13417
13418 le_idx = gen_ir(BD_XT_FLD(bd_idx, dim), BD_XT_IDX(bd_idx, dim),
13419 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13420 IR_COL_NUM(ir_idx),
13421 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
13422
13423 IL_FLD(arg3) = IR_Tbl_Idx;
13424 IL_IDX(arg3) = le_idx;
13425 }
13426 }
13427 else if (arg_info_list[info_idx1].ed.section ||
13428 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13429 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
13430
13431 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
13432 COPY_OPND((*result_opnd),
13433 arg_info_list[info_idx1].ed.shape[dim-1]);
13434
13435 cast_opnd_to_type_idx(result_opnd, res_exp_desc->type_idx);
13436
13437 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
13438 res_exp_desc->constant = TRUE;
13439 res_exp_desc->foldable = TRUE;
13440 }
13441 else if (SHAPE_WILL_FOLD_LATER((*result_opnd)) ||
13442 SHAPE_FOLDABLE((*result_opnd))) {
13443
13444 res_exp_desc->will_fold_later = TRUE;
13445 }
13446
13447
13448 SHAPE_FOLDABLE((*result_opnd)) = FALSE;
13449 SHAPE_WILL_FOLD_LATER((*result_opnd)) = FALSE;
13450 }
13451 }
13452 else {
13453
13454
13455 COPY_OPND(opnd, IL_OPND(list_idx2));
13456 cast_to_cg_default(&opnd, &(arg_info_list[info_idx2].ed));
13457 COPY_OPND(IL_OPND(list_idx2), opnd);
13458
13459 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13460 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
13461 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13462 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
13463 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
13464
13465 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
13466
13467 idx = IL_IDX(list_idx1);
13468
13469 if (IR_OPR(idx) == Whole_Substring_Opr) {
13470 idx = IR_IDX_L(idx);
13471 }
13472
13473 bd_idx = idx;
13474 il_idx = IR_IDX_R(idx);
13475
13476 COPY_OPND(opnd, IR_OPND_L(bd_idx));
13477 array_attr = find_base_attr(&opnd, &line, &col);
13478
13479 bd_idx = ATD_ARRAY_IDX(array_attr);
13480
13481 idx = IL_IDX(il_idx);
13482 idx = IR_IDX_L(idx);
13483 idx = IL_NEXT_LIST_IDX(idx);
13484
13485 OPND_IDX(base_opnd) = CN_INTEGER_ZERO_IDX;
13486 OPND_FLD(base_opnd) = CN_Tbl_Idx;
13487 OPND_LINE_NUM(base_opnd) = IR_LINE_NUM(ir_idx);
13488 OPND_COL_NUM(base_opnd) = IR_COL_NUM(ir_idx);
13489
13490 for (i = 1; i <= arg_info_list[info_idx1].ed.rank; i++) {
13491
13492 NTR_IR_LIST_TBL(arg1);
13493 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13494 NTR_IR_LIST_TBL(arg2);
13495 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13496 NTR_IR_LIST_TBL(arg3);
13497 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13498
13499
13500 IL_NEXT_LIST_IDX(arg1) = arg2;
13501 IL_NEXT_LIST_IDX(arg2) = arg3;
13502
13503 select = gen_ir(IL_Tbl_Idx, arg1,
13504 Cvmgt_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13505 IR_COL_NUM(ir_idx),
13506 NO_Tbl_Idx, NULL_IDX);
13507
13508
13509 io_item_must_flatten = TRUE;
13510
13511 COPY_OPND(IL_OPND(arg1), IL_OPND(idx));
13512 il_idx = IL_NEXT_LIST_IDX(il_idx);
13513 idx = IL_IDX(il_idx);
13514 idx = IR_IDX_L(idx);
13515 idx = IL_NEXT_LIST_IDX(idx);
13516
13517 COPY_OPND(IL_OPND(arg2), base_opnd);
13518
13519 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i);
13520
13521 eq_idx = gen_ir(IL_FLD(list_idx2), IL_IDX(list_idx2),
13522 Eq_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13523 IR_COL_NUM(ir_idx),
13524 CN_Tbl_Idx, cn_idx);
13525
13526 IL_FLD(arg3) = IR_Tbl_Idx;
13527 IL_IDX(arg3) = eq_idx;
13528
13529 OPND_FLD(base_opnd) = IR_Tbl_Idx;
13530 OPND_IDX(base_opnd) = select;
13531 }
13532
13533
13534 NTR_IR_LIST_TBL(arg1);
13535 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13536 NTR_IR_LIST_TBL(arg2);
13537 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13538 NTR_IR_LIST_TBL(arg3);
13539 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13540
13541
13542 IL_NEXT_LIST_IDX(arg1) = arg2;
13543 IL_NEXT_LIST_IDX(arg2) = arg3;
13544
13545 IR_OPR(ir_idx) = Cvmgt_Opr;
13546 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
13547 IR_IDX_L(ir_idx) = arg1;
13548 IR_LIST_CNT_L(ir_idx) = 3;
13549
13550
13551 io_item_must_flatten = TRUE;
13552
13553
13554 IR_OPND_R(ir_idx) = null_opnd;
13555
13556 IL_FLD(arg1) = CN_Tbl_Idx;
13557 IL_IDX(arg1) = CN_INTEGER_ZERO_IDX;
13558 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
13559 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
13560
13561 IL_FLD(arg2) = IR_Tbl_Idx;
13562 IL_IDX(arg2) = select;
13563
13564 save_arg3 = arg3;
13565
13566 OPND_IDX(base_opnd) = CN_INTEGER_ZERO_IDX;
13567 OPND_FLD(base_opnd) = CN_Tbl_Idx;
13568 OPND_LINE_NUM(base_opnd) = IR_LINE_NUM(ir_idx);
13569 OPND_COL_NUM(base_opnd) = IR_COL_NUM(ir_idx);
13570
13571 for (i = 1; i <= arg_info_list[info_idx1].ed.rank; i++) {
13572
13573 NTR_IR_LIST_TBL(arg1);
13574 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13575 NTR_IR_LIST_TBL(arg2);
13576 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13577 NTR_IR_LIST_TBL(arg3);
13578 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13579
13580
13581 IL_NEXT_LIST_IDX(arg1) = arg2;
13582 IL_NEXT_LIST_IDX(arg2) = arg3;
13583
13584 select = gen_ir(IL_Tbl_Idx, arg1,
13585 Cvmgt_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13586 IR_COL_NUM(ir_idx),
13587 NO_Tbl_Idx, NULL_IDX);
13588
13589
13590 io_item_must_flatten = TRUE;
13591
13592 COPY_OPND(IL_OPND(arg1),
13593 arg_info_list[info_idx1].ed.shape[i-1]);
13594 COPY_OPND(IL_OPND(arg2), base_opnd);
13595
13596 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i);
13597
13598 eq_idx = gen_ir(IL_FLD(list_idx2), IL_IDX(list_idx2),
13599 Eq_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13600 IR_COL_NUM(ir_idx),
13601 CN_Tbl_Idx, cn_idx);
13602
13603 IL_FLD(arg3) = IR_Tbl_Idx;
13604 IL_IDX(arg3) = eq_idx;
13605
13606 OPND_FLD(base_opnd) = IR_Tbl_Idx;
13607 OPND_IDX(base_opnd) = select;
13608 }
13609
13610 le_idx = gen_ir(IR_Tbl_Idx, select,
13611 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13612 IR_COL_NUM(ir_idx),
13613 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
13614
13615 IL_FLD(save_arg3) = IR_Tbl_Idx;
13616 IL_IDX(save_arg3) = le_idx;
13617 }
13618 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
13619 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
13620 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13621 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
13622
13623
13624 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
13625 }
13626 else if (arg_info_list[info_idx1].ed.section ||
13627 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13628 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
13629
13630 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
13631 }
13632 }
13633
13634 # endif
13635
13636 }
13637 else {
13638
13639 # if 0
13640
13641 res_exp_desc->shape[0].fld = CN_Tbl_Idx;
13642 res_exp_desc->shape[0].idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
13643 res_exp_desc->rank);
13644 SHAPE_WILL_FOLD_LATER(res_exp_desc->shape[0]) = TRUE;
13645 SHAPE_FOLDABLE(res_exp_desc->shape[0]) = TRUE;
13646
13647 res_exp_desc->rank = 1;
13648
13649 if (IR_LIST_CNT_R(ir_idx) == 1) {
13650 IR_LIST_CNT_R(ir_idx) = 2;
13651 NTR_IR_LIST_TBL(new_idx);
13652 IL_INTRIN_PLACE_HOLDER(new_idx) = TRUE;
13653 IL_ARG_DESC_VARIANT(new_idx) = TRUE;
13654 IL_NEXT_LIST_IDX(IR_IDX_R(ir_idx)) = new_idx;
13655 }
13656
13657 # endif
13658
13659
13660
13661 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13662 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
13663 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13664 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
13665 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
13666
13667 # if 0
13668
13669 COPY_OPND(opnd, IL_OPND(list_idx1));
13670 array_attr = find_base_attr(&opnd, &line, &col);
13671
13672 bd_idx = ATD_ARRAY_IDX(array_attr);
13673
13674
13675
13676
13677 idx = IL_IDX(list_idx1);
13678
13679 if (IR_OPR(idx) == Whole_Substring_Opr) {
13680 idx = IR_IDX_L(idx);
13681 }
13682
13683 idx = IR_IDX_R(idx);
13684
13685 res_exp_desc->will_fold_later = TRUE;
13686
13687 for (i = 0; i < BD_RANK(bd_idx); i++) {
13688 idx2 = IL_IDX(idx);
13689 idx2 = IR_IDX_L(idx2);
13690 idx2 = IL_NEXT_LIST_IDX(idx2);
13691
13692 if (arg_info_list[info_idx1].ed.shape[i].fld != CN_Tbl_Idx ||
13693 IL_FLD(idx2) != CN_Tbl_Idx) {
13694
13695 NTR_IR_LIST_TBL(arg1);
13696 IL_ARG_DESC_VARIANT(arg1) = TRUE;
13697 IL_LINE_NUM(arg1) = IR_LINE_NUM(ir_idx);
13698 IL_COL_NUM(arg1) = IR_COL_NUM(ir_idx);
13699 IL_FLD(arg1) = CN_Tbl_Idx;
13700
13701
13702
13703 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, 0);
13704
13705 IL_IDX(arg1) = cn_idx;
13706
13707 NTR_IR_LIST_TBL(arg2);
13708 IL_ARG_DESC_VARIANT(arg2) = TRUE;
13709 IL_LINE_NUM(arg2) = IR_LINE_NUM(ir_idx);
13710 IL_COL_NUM(arg2) = IR_COL_NUM(ir_idx);
13711 IL_FLD(arg2) = IL_FLD(idx2);
13712 IL_IDX(arg2) = IL_IDX(idx2);
13713
13714 NTR_IR_LIST_TBL(arg3);
13715 IL_ARG_DESC_VARIANT(arg3) = TRUE;
13716
13717 le_idx = gen_ir(OPND_FLD(arg_info_list[info_idx1].ed.shape[i]),
13718 OPND_IDX(arg_info_list[info_idx1].ed.shape[i]),
13719 Le_Opr, LOGICAL_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13720 IR_COL_NUM(ir_idx),
13721 CN_Tbl_Idx, CN_INTEGER_ZERO_IDX);
13722
13723 IL_FLD(arg3) = IR_Tbl_Idx;
13724 IL_IDX(arg3) = le_idx;
13725
13726
13727 IL_NEXT_LIST_IDX(arg1) = arg2;
13728 IL_NEXT_LIST_IDX(arg2) = arg3;
13729
13730 select = gen_ir(IL_Tbl_Idx, arg1,
13731 Cvmgt_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13732 IR_COL_NUM(ir_idx),
13733 NO_Tbl_Idx, NULL_IDX);
13734
13735
13736 io_item_must_flatten = TRUE;
13737
13738 expr_IDX[i] = select;
13739 expr_FLD[i] = IR_Tbl_Idx;
13740 host_array[i] = 0;
13741 }
13742 else if (compare_cn_and_value(
13743 arg_info_list[info_idx1].ed.shape[i].idx, 0, Le_Opr)) {
13744 host_array[i] = 0;
13745 }
13746 else {
13747 host_array[i] = (long_type) CN_INT_TO_C(IL_IDX(idx2));
13748 }
13749
13750 idx = IL_NEXT_LIST_IDX(idx);
13751 }
13752
13753 if (res_exp_desc->will_fold_later) {
13754 make_const_tmp = TRUE;
13755 }
13756
13757 # endif
13758
13759 }
13760 else if (arg_info_list[info_idx1].ed.section ||
13761 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
13762 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
13763
13764 # if 0
13765
13766 res_exp_desc->will_fold_later = TRUE;
13767 res_exp_desc->foldable = TRUE;
13768
13769 for (i = 0; i < arg_info_list[info_idx1].ed.rank; i++) {
13770 if (arg_info_list[info_idx1].ed.shape[i].fld != CN_Tbl_Idx) {
13771 res_exp_desc->foldable = FALSE;
13772 }
13773 else {
13774 host_array[i] = (long_type)
13775 CN_INT_TO_C(arg_info_list[info_idx1].ed.shape[i].idx);
13776 }
13777
13778 if (! SHAPE_WILL_FOLD_LATER(arg_info_list[info_idx1].ed.shape[i])) {
13779 res_exp_desc->will_fold_later = FALSE;
13780 }
13781 }
13782
13783 if (res_exp_desc->foldable) {
13784 make_const_tmp = TRUE;
13785 }
13786 # endif
13787 }
13788 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
13789 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
13790 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
13791 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
13792
13793
13794 PRINTMSG(arg_info_list[info_idx1].line, 889, Error,
13795 arg_info_list[info_idx1].col);
13796 }
13797 }
13798
13799 # if 0
13800
13801 if (make_const_tmp) {
13802 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
13803 bit_length = TARGET_BITS_PER_WORD* (long)arg_info_list[info_idx1].ed.rank;
13804 # ifdef _WHIRL_HOST64_TARGET64
13805 bit_length >>= 1;
13806 # endif
13807
13808 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
13809 TYP_TYPE(TYP_WORK_IDX) = Typeless;
13810 TYP_BIT_LEN(TYP_WORK_IDX) = bit_length;
13811 constant_type_idx = ntr_type_tbl();
13812
13813 for (i = 0; i < MAX_NUM_DIMS; i++) {
13814
13815 # if defined(_TARGET32)
13816
13817
13818
13819
13820 if (INTEGER_DEFAULT_TYPE == Integer_8) {
13821
13822
13823 }
13824 # endif
13825
13826
13827
13828 const_array[i] = (long_type) host_array[i];
13829 }
13830
13831 the_cn_idx = ntr_const_tbl(constant_type_idx,
13832 FALSE,
13833 const_array);
13834
13835 tmp_idx = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
13836 IR_COL_NUM(ir_idx),
13837 Shared, TRUE);
13838
13839 AT_SEMANTICS_DONE(tmp_idx)= TRUE;
13840 ATD_TYPE_IDX(tmp_idx) = CG_INTEGER_DEFAULT_TYPE;
13841
13842 loc_exp_desc = *res_exp_desc;
13843 loc_exp_desc.type_idx = CG_INTEGER_DEFAULT_TYPE;
13844 loc_exp_desc.type = Integer;
13845 loc_exp_desc.linear_type = CG_INTEGER_DEFAULT_TYPE;
13846
13847 ATD_ARRAY_IDX(tmp_idx) = create_bd_ntry_for_const(&loc_exp_desc,
13848 IR_LINE_NUM(ir_idx),
13849 IR_COL_NUM(ir_idx));
13850
13851 ATD_SAVED(tmp_idx) = TRUE;
13852 ATD_DATA_INIT(tmp_idx) = TRUE;
13853 ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_STATIC_INIT_IDX(curr_scp_idx);
13854 ATD_FLD(tmp_idx) = CN_Tbl_Idx;
13855 ATD_TMP_IDX(tmp_idx) = the_cn_idx;
13856 ATD_TMP_INIT_NOT_DONE(tmp_idx) = TRUE;
13857
13858 OPND_IDX((*result_opnd)) = tmp_idx;
13859 OPND_FLD((*result_opnd)) = AT_Tbl_Idx;
13860 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
13861 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
13862
13863 ok = gen_whole_subscript(result_opnd, res_exp_desc);
13864
13865 if (CG_INTEGER_DEFAULT_TYPE != INTEGER_DEFAULT_TYPE) {
13866 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
13867
13868 ok = fold_aggragate_expression(result_opnd,
13869 res_exp_desc,
13870 FALSE);
13871
13872 if (OPND_FLD((*result_opnd)) == IR_Tbl_Idx) {
13873 idx = OPND_IDX((*result_opnd));
13874 if (IR_FLD_L(idx) == AT_Tbl_Idx) {
13875 tmp_idx = IR_IDX_L(idx);
13876 }
13877 }
13878 }
13879
13880 AT_REFERENCED(tmp_idx) = Referenced;
13881 AT_DEFINED(tmp_idx) = TRUE;
13882
13883 res_exp_desc->foldable = TRUE;
13884 res_exp_desc->tmp_reference = TRUE;
13885 }
13886
13887
13888
13889
13890 for (i = 0; i < MAX_NUM_DIMS; i++) {
13891 if (expr_IDX[i] != NULL_IDX) {
13892 res_exp_desc->foldable = FALSE;
13893 res_exp_desc->will_fold_later = FALSE;
13894
13895 NTR_IR_LIST_TBL(idx);
13896 IL_FLD(idx) = CN_Tbl_Idx;
13897
13898 IL_IDX(idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i+1);
13899
13900 IL_LINE_NUM(idx) = IR_LINE_NUM(ir_idx);
13901 IL_COL_NUM(idx) = IR_COL_NUM(ir_idx);
13902
13903 NTR_IR_TBL(subscript_idx);
13904 IR_TYPE_IDX(subscript_idx) = CG_INTEGER_DEFAULT_TYPE;
13905 IR_OPR(subscript_idx) = Subscript_Opr;
13906 IR_LINE_NUM(subscript_idx) = IR_LINE_NUM(ir_idx);
13907 IR_COL_NUM(subscript_idx) = IR_COL_NUM(ir_idx);
13908 IR_FLD_L(subscript_idx) = AT_Tbl_Idx;
13909 IR_IDX_L(subscript_idx) = tmp_idx;
13910 IR_LINE_NUM_L(subscript_idx) = IR_LINE_NUM(ir_idx);
13911 IR_COL_NUM_L(subscript_idx) = IR_COL_NUM(ir_idx);
13912 IR_FLD_R(subscript_idx) = IL_Tbl_Idx;
13913 IR_IDX_R(subscript_idx) = idx;
13914 IR_LINE_NUM_R(subscript_idx) = IR_LINE_NUM(ir_idx);
13915 IR_COL_NUM_R(subscript_idx) = IR_COL_NUM(ir_idx);
13916 IR_LIST_CNT_R(subscript_idx) = 1;
13917
13918 asg_idx = gen_ir(IR_Tbl_Idx, subscript_idx,
13919 Asg_Opr, INTEGER_DEFAULT_TYPE, IR_LINE_NUM(ir_idx),
13920 IR_COL_NUM(ir_idx),
13921 expr_FLD[i], expr_IDX[i]);
13922
13923 gen_sh(Before,
13924 Assignment_Stmt,
13925 IR_LINE_NUM(ir_idx),
13926 IR_COL_NUM(ir_idx),
13927 FALSE,
13928 FALSE,
13929 TRUE);
13930
13931 SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
13932 SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
13933 }
13934 }
13935
13936 # endif
13937
13938
13939 EXIT:
13940
13941 if (OPND_FLD((*result_opnd)) != IR_Tbl_Idx ||
13942 IR_OPR(OPND_IDX((*result_opnd))) != Call_Opr) {
13943
13944 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
13945 }
13946
13947 IR_TYPE_IDX(ir_idx) = INTEGER_DEFAULT_TYPE;
13948 IR_RANK(ir_idx) = res_exp_desc->rank;
13949
13950 res_exp_desc->foldable = FALSE;
13951 res_exp_desc->will_fold_later = FALSE;
13952
13953 TRACE (Func_Exit, "ubound_intrinsic", NULL);
13954
13955 }
13956
13957
13958
13959
13960
13961
13962
13963
13964
13965
13966
13967
13968
13969
13970
13971
13972
13973
13974
13975 void size_intrinsic(opnd_type *result_opnd,
13976 expr_arg_type *res_exp_desc,
13977 int *spec_idx)
13978 {
13979 long dim;
13980 int ir_idx;
13981 int array_attr;
13982 int attr_idx = NULL_IDX;
13983 boolean constant_result;
13984 int idx1;
13985 int idx2;
13986 int i;
13987 int bd_idx;
13988 int cn_idx;
13989 int new_idx;
13990 opnd_type opnd;
13991 int info_idx1;
13992 int info_idx2;
13993 int list_idx1;
13994 int list_idx2;
13995 int line;
13996 int col;
13997 boolean result_will_fold;
13998 long64 num;
13999
14000
14001 TRACE (Func_Entry, "size_intrinsic", NULL);
14002
14003 ATP_EXTERNAL_INTRIN(*spec_idx) = TRUE;
14004
14005 ir_idx = OPND_IDX((*result_opnd));
14006 list_idx1 = IR_IDX_R(ir_idx);
14007 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
14008 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
14009 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
14010
14011 if (arg_info_list[info_idx1].ed.reference) {
14012 attr_idx = find_base_attr(&IL_OPND(list_idx1), &line, &col);
14013 }
14014
14015 conform_check(0,
14016 ir_idx,
14017 res_exp_desc,
14018 spec_idx,
14019 TRUE);
14020
14021
14022
14023 res_exp_desc->foldable = FALSE;
14024 res_exp_desc->will_fold_later = FALSE;
14025
14026
14027 res_exp_desc->rank = 0;
14028
14029 if (arg_info_list[info_idx1].ed.rank == 0) {
14030 PRINTMSG(arg_info_list[info_idx1].line, 640, Error,
14031 arg_info_list[info_idx1].col);
14032 }
14033
14034 if (list_idx2 != NULL_IDX &&
14035 IL_FLD(list_idx2) == CN_Tbl_Idx &&
14036 (compare_cn_and_value(IL_IDX(list_idx2), 1, Lt_Opr) ||
14037 compare_cn_and_value(IL_IDX(list_idx2),
14038 (long) arg_info_list[info_idx1].ed.rank,
14039 Gt_Opr))) {
14040
14041 find_opnd_line_and_column((opnd_type *) &IL_OPND(list_idx2),
14042 &line,
14043 &col);
14044 PRINTMSG(line, 1012, Error, col);
14045 goto EXIT;
14046 }
14047
14048 if (list_idx2 != NULL_IDX && IL_IDX(list_idx2) != NULL_IDX) {
14049 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
14050
14051 if (arg_info_list[info_idx2].ed.rank != 0) {
14052 PRINTMSG(arg_info_list[info_idx2].line, 654, Error,
14053 arg_info_list[info_idx2].col);
14054 goto EXIT;
14055 }
14056
14057 res_exp_desc->rank = 0;
14058
14059 if (arg_info_list[info_idx2].ed.reference) {
14060 attr_idx = find_base_attr(&IL_OPND(list_idx2), &line, &col);
14061
14062 if (AT_OPTIONAL(attr_idx)) {
14063 PRINTMSG(arg_info_list[info_idx2].line, 875, Error,
14064 arg_info_list[info_idx2].col);
14065 }
14066 }
14067
14068 if (IL_FLD(list_idx2) == CN_Tbl_Idx) {
14069
14070 goto EXIT;
14071
14072 dim = (long) CN_INT_TO_C(IL_IDX(list_idx2));
14073 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
14074
14075 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
14076 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
14077 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
14078 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
14079 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
14080
14081 COPY_OPND((*result_opnd),
14082 arg_info_list[info_idx1].ed.shape[dim-1]);
14083
14084 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
14085 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
14086 res_exp_desc->linear_type =
14087 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
14088
14089 if (SHAPE_WILL_FOLD_LATER((*result_opnd)) ||
14090 SHAPE_FOLDABLE((*result_opnd))) {
14091 res_exp_desc->will_fold_later = TRUE;
14092 }
14093
14094
14095 SHAPE_FOLDABLE((*result_opnd)) = FALSE;
14096 SHAPE_WILL_FOLD_LATER((*result_opnd)) = FALSE;
14097
14098 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
14099 res_exp_desc->constant = TRUE;
14100 res_exp_desc->foldable = TRUE;
14101 }
14102 }
14103 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
14104 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
14105 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
14106 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
14107
14108
14109
14110 if (IL_FLD(list_idx1) == AT_Tbl_Idx) {
14111 attr_idx = IL_IDX(list_idx1);
14112 }
14113 else {
14114 attr_idx = IR_IDX_L(IL_IDX(list_idx1));
14115 }
14116
14117 if (dim == arg_info_list[info_idx1].ed.rank) {
14118 PRINTMSG(arg_info_list[info_idx1].line, 889, Error,
14119 arg_info_list[info_idx1].col);
14120 }
14121 else {
14122 OPND_FLD((*result_opnd)) =
14123 BD_XT_FLD(ATD_ARRAY_IDX(attr_idx), dim);
14124 OPND_IDX((*result_opnd)) =
14125 BD_XT_IDX(ATD_ARRAY_IDX(attr_idx), dim);
14126 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
14127 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
14128
14129 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
14130 res_exp_desc->constant = TRUE;
14131 res_exp_desc->foldable = TRUE;
14132 }
14133 }
14134 }
14135 else if (arg_info_list[info_idx1].ed.section ||
14136 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
14137 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
14138 NTR_IR_LIST_TBL(idx1);
14139 COPY_OPND(IL_OPND(idx1),
14140 arg_info_list[info_idx1].ed.shape[dim-1]);
14141
14142 NTR_IR_LIST_TBL(idx2);
14143 IL_NEXT_LIST_IDX(idx1) = idx2;
14144 IL_IDX(idx2) = CN_INTEGER_ZERO_IDX;
14145 IL_FLD(idx2) = CN_Tbl_Idx;
14146 IL_LINE_NUM(idx2) = IR_LINE_NUM(ir_idx);
14147 IL_COL_NUM(idx2) = IR_COL_NUM(ir_idx);
14148
14149 goto EXIT;
14150
14151 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
14152 IR_OPR(ir_idx) = Max_Opr;
14153
14154 IR_IDX_L(ir_idx) = idx1;
14155 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
14156 IR_LIST_CNT_L(ir_idx) = 2;
14157 IR_OPND_R(ir_idx) = null_opnd;
14158
14159 if (OPND_FLD((*result_opnd)) == CN_Tbl_Idx) {
14160 res_exp_desc->constant = TRUE;
14161 res_exp_desc->foldable = TRUE;
14162 }
14163 else if (SHAPE_WILL_FOLD_LATER((*result_opnd)) ||
14164 SHAPE_FOLDABLE((*result_opnd))) {
14165
14166 res_exp_desc->will_fold_later = TRUE;
14167 }
14168
14169
14170 SHAPE_FOLDABLE((*result_opnd)) = FALSE;
14171 SHAPE_WILL_FOLD_LATER((*result_opnd)) = FALSE;
14172 }
14173 }
14174 else {
14175
14176
14177 goto EXIT;
14178
14179 COPY_OPND(opnd, IL_OPND(list_idx2));
14180 cast_to_cg_default(&opnd, &(arg_info_list[info_idx2].ed));
14181 COPY_OPND(IL_OPND(list_idx2), opnd);
14182 }
14183 }
14184 else {
14185 goto EXIT;
14186 if (IR_LIST_CNT_R(ir_idx) == 1) {
14187 IR_LIST_CNT_R(ir_idx) = 2;
14188 NTR_IR_LIST_TBL(new_idx);
14189 IL_INTRIN_PLACE_HOLDER(new_idx) = TRUE;
14190 IL_ARG_DESC_VARIANT(new_idx) = TRUE;
14191 IL_NEXT_LIST_IDX(IR_IDX_R(ir_idx)) = new_idx;
14192 }
14193
14194
14195 if ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
14196 (IR_OPR(IL_IDX(list_idx1)) == Whole_Subscript_Opr ||
14197 (IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
14198 IR_FLD_L(IL_IDX(list_idx1)) == IR_Tbl_Idx &&
14199 IR_OPR(IR_IDX_L(IL_IDX(list_idx1))) == Whole_Subscript_Opr))) {
14200
14201 COPY_OPND(opnd, IL_OPND(list_idx1));
14202 array_attr = find_base_attr(&opnd, &line, &col);
14203
14204 bd_idx = ATD_ARRAY_IDX(array_attr);
14205
14206 constant_result = TRUE;
14207
14208 num = 1;
14209
14210 for (i = 0; i < BD_RANK(bd_idx); i++) {
14211
14212 if (arg_info_list[info_idx1].ed.shape[i].fld != CN_Tbl_Idx) {
14213 constant_result = FALSE;
14214 break;
14215 }
14216 else {
14217 num *= CN_INT_TO_C(arg_info_list[info_idx1].ed.shape[i].idx);
14218 }
14219 }
14220
14221 if (constant_result) {
14222 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
14223 res_exp_desc->constant = TRUE;
14224 res_exp_desc->foldable = TRUE;
14225
14226 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
14227
14228 OPND_IDX((*result_opnd)) = cn_idx;
14229 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
14230 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
14231 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
14232 }
14233 }
14234 else if (arg_info_list[info_idx1].ed.section ||
14235 ((IL_FLD(list_idx1) == IR_Tbl_Idx) &&
14236 (IR_OPR(IL_IDX(list_idx1)) != Whole_Subscript_Opr))) {
14237 goto EXIT;
14238
14239 constant_result = TRUE;
14240 result_will_fold = TRUE;
14241 num = 1;
14242 for (i = 0; i < arg_info_list[info_idx1].ed.rank; i++) {
14243
14244 if (arg_info_list[info_idx1].ed.shape[i].fld != CN_Tbl_Idx) {
14245 constant_result = FALSE;
14246
14247 if (! SHAPE_FOLDABLE(arg_info_list[info_idx1].ed.shape[i]) &&
14248 ! SHAPE_WILL_FOLD_LATER(arg_info_list[info_idx1].ed.shape[i])) {
14249
14250 result_will_fold = FALSE;
14251 }
14252 }
14253 else {
14254 num *= CN_INT_TO_C(arg_info_list[info_idx1].ed.shape[i].idx);
14255 }
14256 }
14257
14258 if (constant_result) {
14259 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
14260 res_exp_desc->constant = TRUE;
14261 res_exp_desc->foldable = TRUE;
14262
14263 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
14264
14265 OPND_IDX((*result_opnd)) = cn_idx;
14266 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
14267 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
14268 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
14269 }
14270 else if (result_will_fold) {
14271 res_exp_desc->will_fold_later = TRUE;
14272 }
14273 }
14274 else if (IL_FLD(list_idx1) == AT_Tbl_Idx ||
14275 (IL_FLD(list_idx1) == IR_Tbl_Idx &&
14276 IR_OPR(IL_IDX(list_idx1)) == Whole_Substring_Opr &&
14277 IR_FLD_L(IL_IDX(list_idx1)) == AT_Tbl_Idx)) {
14278
14279
14280 PRINTMSG(arg_info_list[info_idx1].line, 889, Error,
14281 arg_info_list[info_idx1].col);
14282 }
14283 }
14284
14285
14286 EXIT:
14287 if (OPND_FLD((*result_opnd)) != IR_Tbl_Idx ||
14288 IR_OPR(OPND_IDX((*result_opnd))) != Call_Opr) {
14289
14290 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
14291 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
14292 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
14293 }
14294
14295 IR_TYPE_IDX(ir_idx) = INTEGER_DEFAULT_TYPE;
14296 IR_RANK(ir_idx) = res_exp_desc->rank;
14297
14298 res_exp_desc->foldable = FALSE;
14299 res_exp_desc->will_fold_later = FALSE;
14300
14301 TRACE (Func_Exit, "size_intrinsic", NULL);
14302
14303 }
14304
14305
14306
14307
14308
14309
14310
14311
14312
14313
14314
14315
14316
14317
14318
14319
14320
14321
14322 void shape_intrinsic(opnd_type *result_opnd,
14323 expr_arg_type *res_exp_desc,
14324 int *spec_idx)
14325 {
14326 int asg_idx;
14327 int subscript_idx;
14328 int triplet_idx;
14329 long64 bit_length;
14330 int constant_type_idx;
14331 # ifdef _WHIRL_HOST64_TARGET64
14332 int const_array[MAX_NUM_DIMS];
14333 # else
14334 long_type const_array[MAX_NUM_DIMS];
14335 # endif
14336 long64 host_array[MAX_NUM_DIMS];
14337 int ir_idx;
14338 int cn_idx;
14339 int info_idx1;
14340 int i;
14341 boolean ok;
14342 int list_idx1;
14343 int list_idx;
14344 int the_cn_idx;
14345 int tmp_idx;
14346 expr_arg_type loc_exp_desc;
14347
14348
14349 TRACE (Func_Entry, "shape_intrinsic", NULL);
14350
14351 for (i = 0; i < MAX_NUM_DIMS; i++) {
14352 host_array[i] = 0;
14353 }
14354
14355 ir_idx = OPND_IDX((*result_opnd));
14356 list_idx1 = IR_IDX_R(ir_idx);
14357 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
14358
14359 conform_check(0,
14360 ir_idx,
14361 res_exp_desc,
14362 spec_idx,
14363 FALSE);
14364
14365 # if 0
14366
14367 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
14368 res_exp_desc->type = TYP_TYPE(res_exp_desc->type_idx);
14369 res_exp_desc->linear_type = TYP_LINEAR(res_exp_desc->type_idx);
14370
14371 res_exp_desc->rank = 1;
14372 IR_TYPE_IDX(ir_idx) = INTEGER_DEFAULT_TYPE;
14373 IR_RANK(ir_idx) = res_exp_desc->rank;
14374
14375 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
14376
14377 res_exp_desc->shape[0].fld = CN_Tbl_Idx;
14378 res_exp_desc->shape[0].idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
14379 arg_info_list[info_idx1].ed.rank);
14380
14381 SHAPE_WILL_FOLD_LATER(res_exp_desc->shape[0]) = TRUE;
14382 SHAPE_FOLDABLE(res_exp_desc->shape[0]) = TRUE;
14383
14384 res_exp_desc->foldable = TRUE;
14385 res_exp_desc->will_fold_later = TRUE;
14386
14387 for (i = 0; i < arg_info_list[info_idx1].ed.rank; i++) {
14388
14389 if (arg_info_list[info_idx1].ed.shape[i].fld != CN_Tbl_Idx) {
14390 res_exp_desc->foldable = FALSE;
14391 }
14392 else {
14393 host_array[i] = CN_CONST(arg_info_list[info_idx1].ed.shape[i].idx);
14394 }
14395
14396 if (! SHAPE_FOLDABLE(arg_info_list[info_idx1].ed.shape[i]) &&
14397 ! SHAPE_WILL_FOLD_LATER(arg_info_list[info_idx1].ed.shape[i])) {
14398 res_exp_desc->will_fold_later = FALSE;
14399 }
14400 }
14401
14402 ATP_EXTERNAL_INTRIN(*spec_idx) = FALSE;
14403
14404 if (res_exp_desc->foldable) {
14405 bit_length = TARGET_BITS_PER_WORD* (long)arg_info_list[info_idx1].ed.rank;
14406 # ifdef _WHIRL_HOST64_TARGET64
14407 bit_length >>= 1;
14408 # endif
14409
14410 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
14411 TYP_TYPE(TYP_WORK_IDX) = Typeless;
14412 TYP_BIT_LEN(TYP_WORK_IDX) = bit_length;
14413 constant_type_idx = ntr_type_tbl();
14414
14415 for (i = 0; i < MAX_NUM_DIMS; i++) {
14416
14417 # if defined(_TARGET32)
14418
14419
14420
14421
14422 if (INTEGER_DEFAULT_TYPE == Integer_8) {
14423
14424
14425 }
14426 # endif
14427
14428
14429
14430 const_array[i] = (long_type) host_array[i];
14431 }
14432
14433 the_cn_idx = ntr_const_tbl(constant_type_idx,
14434 FALSE,
14435 const_array);
14436
14437 tmp_idx = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
14438 IR_COL_NUM(ir_idx),
14439 Shared, TRUE);
14440
14441 ATD_TYPE_IDX(tmp_idx) = CG_INTEGER_DEFAULT_TYPE;
14442 AT_SEMANTICS_DONE(tmp_idx)= TRUE;
14443
14444 loc_exp_desc = *res_exp_desc;
14445 loc_exp_desc.type_idx = CG_INTEGER_DEFAULT_TYPE;
14446 loc_exp_desc.type = Integer;
14447 loc_exp_desc.linear_type = CG_INTEGER_DEFAULT_TYPE;
14448
14449 ATD_ARRAY_IDX(tmp_idx) = create_bd_ntry_for_const(&loc_exp_desc,
14450 IR_LINE_NUM(ir_idx),
14451 IR_COL_NUM(ir_idx));
14452
14453 ATD_SAVED(tmp_idx) = TRUE;
14454 ATD_DATA_INIT(tmp_idx) = TRUE;
14455 ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_STATIC_INIT_IDX(curr_scp_idx);
14456 ATD_FLD(tmp_idx) = CN_Tbl_Idx;
14457 ATD_TMP_IDX(tmp_idx) = the_cn_idx;
14458 ATD_TMP_INIT_NOT_DONE(tmp_idx) = TRUE;
14459
14460 OPND_IDX((*result_opnd)) = tmp_idx;
14461 OPND_FLD((*result_opnd)) = AT_Tbl_Idx;
14462 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
14463 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
14464
14465 ok = gen_whole_subscript(result_opnd, res_exp_desc);
14466
14467 if (CG_INTEGER_DEFAULT_TYPE != INTEGER_DEFAULT_TYPE) {
14468 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
14469
14470 ok = fold_aggragate_expression(result_opnd,
14471 res_exp_desc,
14472 FALSE);
14473 }
14474
14475
14476 AT_REFERENCED(tmp_idx) = Referenced;
14477 AT_DEFINED(tmp_idx) = TRUE;
14478
14479 res_exp_desc->foldable = TRUE;
14480 res_exp_desc->tmp_reference = TRUE;
14481 }
14482 else {
14483 io_item_must_flatten = TRUE;
14484 tmp_idx = gen_compiler_tmp(IR_LINE_NUM(ir_idx),
14485 IR_COL_NUM(ir_idx),
14486 Priv, TRUE);
14487
14488 ATD_TYPE_IDX(tmp_idx) = INTEGER_DEFAULT_TYPE;
14489 AT_SEMANTICS_DONE(tmp_idx) = TRUE;
14490
14491 loc_exp_desc = *res_exp_desc;
14492 loc_exp_desc.type_idx = INTEGER_DEFAULT_TYPE;
14493 loc_exp_desc.type = Integer;
14494 loc_exp_desc.linear_type = TYP_LINEAR(INTEGER_DEFAULT_TYPE);
14495
14496 ATD_ARRAY_IDX(tmp_idx) = create_bd_ntry_for_const(&loc_exp_desc,
14497 IR_LINE_NUM(ir_idx),
14498 IR_COL_NUM(ir_idx));
14499
14500 ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_STACK_IDX(curr_scp_idx);
14501
14502 for (i = 0; i < arg_info_list[info_idx1].ed.rank; i++) {
14503
14504 NTR_IR_TBL(subscript_idx);
14505 IR_TYPE_IDX(subscript_idx) = INTEGER_DEFAULT_TYPE;
14506 IR_OPR(subscript_idx) = Subscript_Opr;
14507 IR_LINE_NUM(subscript_idx) = IR_LINE_NUM(ir_idx);
14508 IR_COL_NUM(subscript_idx) = IR_COL_NUM(ir_idx);
14509
14510 asg_idx = gen_ir(IR_Tbl_Idx, subscript_idx,
14511 Asg_Opr,
14512 INTEGER_DEFAULT_TYPE,
14513 IR_LINE_NUM(ir_idx),
14514 IR_COL_NUM(ir_idx),
14515 OPND_FLD(arg_info_list[info_idx1].ed.shape[i]),
14516 OPND_IDX(arg_info_list[info_idx1].ed.shape[i]));
14517
14518 IR_FLD_L(subscript_idx) = AT_Tbl_Idx;
14519 IR_IDX_L(subscript_idx) = tmp_idx;
14520 IR_LINE_NUM_L(subscript_idx) = IR_LINE_NUM(ir_idx);
14521 IR_COL_NUM_L(subscript_idx) = IR_COL_NUM(ir_idx);
14522
14523 NTR_IR_LIST_TBL(list_idx);
14524 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i+1);
14525
14526 IL_FLD(list_idx) = CN_Tbl_Idx;
14527 IL_IDX(list_idx) = cn_idx;
14528 IL_LINE_NUM(list_idx) = IR_LINE_NUM(ir_idx);
14529 IL_COL_NUM(list_idx) = IR_COL_NUM(ir_idx);
14530
14531 IR_LIST_CNT_R(subscript_idx) = 1;
14532 IR_FLD_R(subscript_idx) = IL_Tbl_Idx;
14533 IR_IDX_R(subscript_idx) = list_idx;
14534
14535 gen_sh(Before,
14536 Assignment_Stmt,
14537 IR_LINE_NUM(ir_idx),
14538 IR_COL_NUM(ir_idx),
14539 FALSE,
14540 FALSE,
14541 TRUE);
14542
14543 SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
14544 SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
14545 }
14546
14547 IR_OPR(ir_idx) = Whole_Subscript_Opr;
14548 IR_FLD_L(ir_idx) = AT_Tbl_Idx;
14549 IR_IDX_L(ir_idx) = tmp_idx;
14550 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
14551 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
14552
14553 NTR_IR_LIST_TBL(list_idx);
14554 IR_FLD_R(ir_idx) = IL_Tbl_Idx;
14555 IR_IDX_R(ir_idx) = list_idx;
14556 IR_LIST_CNT_R(ir_idx) = 1;
14557
14558 NTR_IR_TBL(triplet_idx);
14559 IR_TYPE_IDX(triplet_idx) = CG_INTEGER_DEFAULT_TYPE;
14560 IR_OPR(triplet_idx) = Triplet_Opr;
14561 IR_LINE_NUM(triplet_idx) = IR_LINE_NUM(ir_idx);
14562 IR_COL_NUM(triplet_idx) = IR_COL_NUM(ir_idx);
14563
14564 IL_FLD(list_idx) = IR_Tbl_Idx;
14565 IL_IDX(list_idx) = triplet_idx;
14566
14567 NTR_IR_LIST_TBL(list_idx);
14568 IR_FLD_L(triplet_idx) = IL_Tbl_Idx;
14569 IR_IDX_L(triplet_idx) = list_idx;
14570 IR_LIST_CNT_L(triplet_idx) = 3;
14571
14572 cn_idx = CN_INTEGER_ONE_IDX;
14573
14574 IL_FLD(list_idx) = CN_Tbl_Idx;
14575 IL_IDX(list_idx) = cn_idx;
14576 IL_LINE_NUM(list_idx) = IR_LINE_NUM(ir_idx);
14577 IL_COL_NUM(list_idx) = IR_COL_NUM(ir_idx);
14578
14579 NTR_IR_LIST_TBL(tmp_idx);
14580 IL_NEXT_LIST_IDX(list_idx) = tmp_idx;
14581
14582 cn_idx = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, i);
14583
14584 IL_FLD(tmp_idx) = CN_Tbl_Idx;
14585 IL_IDX(tmp_idx) = cn_idx;
14586 IL_LINE_NUM(tmp_idx) = IR_LINE_NUM(ir_idx);
14587 IL_COL_NUM(tmp_idx) = IR_COL_NUM(ir_idx);
14588
14589 NTR_IR_LIST_TBL(list_idx);
14590 IL_NEXT_LIST_IDX(tmp_idx) = list_idx;
14591
14592 cn_idx = CN_INTEGER_ONE_IDX;
14593
14594 IL_FLD(list_idx) = CN_Tbl_Idx;
14595 IL_IDX(list_idx) = cn_idx;
14596 IL_LINE_NUM(list_idx) = IR_LINE_NUM(ir_idx);
14597 IL_COL_NUM(list_idx) = IR_COL_NUM(ir_idx);
14598
14599
14600
14601
14602
14603 res_exp_desc->foldable = FALSE;
14604 res_exp_desc->will_fold_later = FALSE;
14605 }
14606
14607 # endif
14608
14609 if (OPND_FLD((*result_opnd)) != IR_Tbl_Idx ||
14610 IR_OPR(OPND_IDX((*result_opnd))) != Call_Opr) {
14611
14612 cast_opnd_to_type_idx(result_opnd, INTEGER_DEFAULT_TYPE);
14613 }
14614
14615 res_exp_desc->foldable = FALSE;
14616 res_exp_desc->will_fold_later = FALSE;
14617
14618 TRACE (Func_Exit, "shape_intrinsic", NULL);
14619
14620 }
14621
14622
14623
14624
14625
14626
14627
14628
14629
14630
14631
14632
14633
14634
14635
14636
14637
14638
14639 void present_intrinsic(opnd_type *result_opnd,
14640 expr_arg_type *res_exp_desc,
14641 int *spec_idx)
14642 {
14643 int attr_idx;
14644 int info_idx1;
14645 int ir_idx;
14646 int list_idx;
14647 opnd_type opnd;
14648
14649
14650 TRACE (Func_Entry, "present_intrinsic", NULL);
14651
14652 has_present_opr = TRUE;
14653
14654 ir_idx = OPND_IDX((*result_opnd));
14655 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
14656 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
14657
14658 conform_check(0,
14659 ir_idx,
14660 res_exp_desc,
14661 spec_idx,
14662 TRUE);
14663
14664 res_exp_desc->type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
14665 res_exp_desc->type = Logical;
14666 res_exp_desc->linear_type =
14667 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)));
14668 res_exp_desc->rank = 0;
14669 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
14670 IR_RANK(ir_idx) = res_exp_desc->rank;
14671 # if 0
14672 list_idx = IR_IDX_R(ir_idx);
14673
14674
14675
14676
14677 COPY_OPND(opnd, IL_OPND(list_idx));
14678
14679 if (IL_FLD(list_idx) == AT_Tbl_Idx) {
14680
14681 attr_idx = IL_IDX(list_idx);
14682
14683 if (AT_OBJ_CLASS(attr_idx) == Data_Obj &&
14684 ATD_CLASS(attr_idx) == Compiler_Tmp &&
14685 ATD_COPY_ASSUMED_SHAPE(attr_idx) &&
14686 ATD_TMP_IDX(attr_idx) != NULL_IDX) {
14687
14688 attr_idx = ATD_TMP_IDX(attr_idx);
14689 }
14690
14691 if ((!AT_IS_DARG(attr_idx)) || (!AT_OPTIONAL(attr_idx))) {
14692 PRINTMSG(arg_info_list[info_idx1].line, 777, Error,
14693 arg_info_list[info_idx1].col);
14694 }
14695 }
14696 else {
14697
14698 if (OPND_FLD(opnd) == IR_Tbl_Idx) {
14699
14700 while (OPND_FLD(opnd) == IR_Tbl_Idx &&
14701 (IR_OPR(OPND_IDX(opnd)) == Whole_Substring_Opr ||
14702 IR_OPR(OPND_IDX(opnd)) == Whole_Subscript_Opr ||
14703 IR_OPR(OPND_IDX(opnd)) == Dv_Deref_Opr)) {
14704
14705 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
14706 }
14707
14708 if (OPND_FLD(opnd) != AT_Tbl_Idx) {
14709 PRINTMSG(arg_info_list[info_idx1].line, 1080, Error,
14710 arg_info_list[info_idx1].col);
14711 }
14712 }
14713
14714 while (OPND_FLD(opnd) == IR_Tbl_Idx) {
14715 COPY_OPND(opnd, IR_OPND_L(OPND_IDX(opnd)));
14716 }
14717
14718 attr_idx = OPND_IDX(opnd);
14719
14720 if (AT_OBJ_CLASS(attr_idx) == Data_Obj &&
14721 ATD_CLASS(attr_idx) == Compiler_Tmp &&
14722 ATD_COPY_ASSUMED_SHAPE(attr_idx) &&
14723 ATD_TMP_IDX(attr_idx) != NULL_IDX) {
14724
14725 attr_idx = ATD_TMP_IDX(attr_idx);
14726 OPND_IDX(opnd) = attr_idx;
14727 }
14728
14729 if ((OPND_FLD(opnd) != AT_Tbl_Idx) ||
14730 (!AT_IS_DARG(OPND_IDX(opnd))) ||
14731 (!AT_OPTIONAL(OPND_IDX(opnd)))) {
14732 PRINTMSG(arg_info_list[info_idx1].line, 777, Error,
14733 arg_info_list[info_idx1].col);
14734 }
14735 }
14736
14737
14738 IR_OPR(ir_idx) = Present_Opr;
14739 IR_TYPE_IDX(ir_idx) = LOGICAL_DEFAULT_TYPE;
14740
14741
14742 IR_IDX_L(ir_idx) = attr_idx;
14743 IR_FLD_L(ir_idx) = AT_Tbl_Idx;
14744 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
14745 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
14746 IR_OPND_R(ir_idx) = null_opnd;
14747
14748 # endif
14749
14750
14751
14752
14753 res_exp_desc->foldable = FALSE;
14754 res_exp_desc->will_fold_later = FALSE;
14755
14756 TRACE (Func_Exit, "present_intrinsic", NULL);
14757
14758 }
14759
14760
14761
14762
14763
14764
14765
14766
14767
14768
14769
14770
14771
14772
14773
14774
14775
14776
14777 void logical_intrinsic(opnd_type *result_opnd,
14778 expr_arg_type *res_exp_desc,
14779 int *spec_idx)
14780 {
14781 int info_idx2;
14782 int ir_idx;
14783 int list_idx1;
14784 int list_idx2;
14785
14786
14787 TRACE (Func_Entry, "logical_intrinsic", NULL);
14788
14789 ir_idx = OPND_IDX((*result_opnd));
14790 list_idx1 = IR_IDX_R(ir_idx);
14791 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
14792
14793 if ((list_idx2 != NULL_IDX) && (IL_IDX(list_idx2) != NULL_IDX)) {
14794 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
14795 kind_to_linear_type(&((IL_OPND(list_idx2))),
14796 ATP_RSLT_IDX(*spec_idx),
14797 arg_info_list[info_idx2].ed.kind0seen,
14798 arg_info_list[info_idx2].ed.kind0E0seen,
14799 arg_info_list[info_idx2].ed.kind0D0seen,
14800 ! arg_info_list[info_idx2].ed.kindnotconst);
14801 }
14802 else {
14803 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = LOGICAL_DEFAULT_TYPE;
14804 }
14805
14806 conform_check(0,
14807 ir_idx,
14808 res_exp_desc,
14809 spec_idx,
14810 FALSE);
14811
14812 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
14813 IR_RANK(ir_idx) = res_exp_desc->rank;
14814
14815 # if 0
14816
14817 IR_OPR(ir_idx) = Logical_Opr;
14818
14819 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
14820 IR_OPND_R(ir_idx) = null_opnd;
14821 IR_LIST_CNT_L(ir_idx) = 1;
14822 IL_NEXT_LIST_IDX(list_idx1) = NULL_IDX;
14823
14824 # endif
14825
14826
14827
14828
14829 res_exp_desc->foldable = FALSE;
14830 res_exp_desc->will_fold_later = FALSE;
14831
14832
14833 TRACE (Func_Exit, "logical_intrinsic", NULL);
14834
14835 }
14836
14837
14838
14839
14840
14841
14842
14843
14844
14845
14846
14847
14848
14849
14850
14851
14852
14853
14854 void len_trim_intrinsic(opnd_type *result_opnd,
14855 expr_arg_type *res_exp_desc,
14856 int *spec_idx)
14857 {
14858 int ir_idx;
14859 int list_idx1;
14860 long_type folded_const[MAX_WORDS_FOR_NUMERIC];
14861 int type_idx;
14862 int info_idx1;
14863
14864
14865 TRACE (Func_Entry, "len_trim_intrinsic", NULL);
14866
14867 ir_idx = OPND_IDX((*result_opnd));
14868 list_idx1 = IR_IDX_R(ir_idx);
14869 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
14870 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = INTEGER_DEFAULT_TYPE;
14871 type_idx = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
14872
14873 conform_check(0,
14874 ir_idx,
14875 res_exp_desc,
14876 spec_idx,
14877 FALSE);
14878 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
14879 IR_RANK(ir_idx) = res_exp_desc->rank;
14880
14881 # if 0
14882
14883 res_exp_desc->type_idx = type_idx;
14884 res_exp_desc->linear_type = TYP_LINEAR(type_idx);
14885 if ( IL_FLD(list_idx1) == CN_Tbl_Idx &&
14886 folder_driver((char *)&CN_CONST(IL_IDX(list_idx1)),
14887 arg_info_list[info_idx1].ed.type_idx,
14888 NULL,
14889 NULL_IDX,
14890 folded_const,
14891 &type_idx,
14892 IR_LINE_NUM(ir_idx),
14893 IR_COL_NUM(ir_idx),
14894 1,
14895 Len_Trim_Opr)) {
14896 OPND_FLD((*result_opnd)) = CN_Tbl_Idx;
14897 OPND_IDX((*result_opnd)) = ntr_const_tbl(type_idx,
14898 FALSE,
14899 folded_const);
14900 OPND_LINE_NUM((*result_opnd)) = IR_LINE_NUM(ir_idx);
14901 OPND_COL_NUM((*result_opnd)) = IR_COL_NUM(ir_idx);
14902 res_exp_desc->constant = TRUE;
14903 res_exp_desc->foldable = TRUE;
14904 }
14905 else {
14906 IR_OPR(ir_idx) = Len_Trim_Opr;
14907 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
14908 IR_OPND_R(ir_idx) = null_opnd;
14909 }
14910
14911 # endif
14912
14913 res_exp_desc->foldable = FALSE;
14914 res_exp_desc->will_fold_later = FALSE;
14915
14916 TRACE (Func_Exit, "len_trim_intrinsic", NULL);
14917
14918 }
14919
14920
14921
14922
14923
14924
14925
14926
14927
14928
14929
14930
14931
14932
14933
14934
14935
14936
14937 void nearest_intrinsic(opnd_type *result_opnd,
14938 expr_arg_type *res_exp_desc,
14939 int *spec_idx)
14940 {
14941 int ir_idx;
14942 int cn_idx;
14943 int list_idx1;
14944 int list_idx2;
14945 int list_idx3;
14946 int info_idx1;
14947 int num;
14948
14949
14950 TRACE (Func_Entry, "nearest_intrinsic", NULL);
14951
14952 ir_idx = OPND_IDX((*result_opnd));
14953 list_idx1 = IR_IDX_R(ir_idx);
14954 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
14955 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
14956 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
14957
14958 conform_check(0,
14959 ir_idx,
14960 res_exp_desc,
14961 spec_idx,
14962 FALSE);
14963
14964 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
14965 IR_RANK(ir_idx) = res_exp_desc->rank;
14966
14967 # if 0
14968
14969 IR_OPR(ir_idx) = Nearest_Opr;
14970 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
14971 IR_LIST_CNT_L(ir_idx) = 3;
14972
14973 switch (arg_info_list[info_idx1].ed.linear_type) {
14974 case Real_4:
14975 num = DIGITS_REAL4_F90;
14976 break;
14977
14978 case Real_8:
14979 num = DIGITS_REAL8_F90;
14980 break;
14981
14982 case Real_16:
14983 num = DIGITS_REAL16_F90;
14984 break;
14985 }
14986
14987 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
14988
14989 NTR_IR_LIST_TBL(list_idx3);
14990 IL_ARG_DESC_VARIANT(list_idx3) = TRUE;
14991
14992
14993 IL_NEXT_LIST_IDX(list_idx2) = list_idx3;
14994
14995 IL_IDX(list_idx3) = cn_idx;
14996 IL_FLD(list_idx3) = CN_Tbl_Idx;
14997 IL_LINE_NUM(list_idx3) = IR_LINE_NUM(ir_idx);
14998 IL_COL_NUM(list_idx3) = IR_COL_NUM(ir_idx);
14999
15000 IL_LINE_NUM(list_idx3) = IL_LINE_NUM(list_idx1);
15001 IL_COL_NUM(list_idx3) = IL_COL_NUM(list_idx1);
15002
15003 IR_OPND_R(ir_idx) = null_opnd;
15004
15005
15006
15007
15008
15009 # endif
15010
15011 res_exp_desc->foldable = FALSE;
15012 res_exp_desc->will_fold_later = FALSE;
15013
15014 TRACE (Func_Exit, "nearest_intrinsic", NULL);
15015
15016 }
15017
15018
15019
15020
15021
15022
15023
15024
15025
15026
15027
15028
15029
15030
15031
15032
15033
15034
15035 void rrspacing_intrinsic(opnd_type *result_opnd,
15036 expr_arg_type *res_exp_desc,
15037 int *spec_idx)
15038 {
15039 int ir_idx;
15040 int cn_idx;
15041 int info_idx1;
15042 int list_idx1;
15043 int list_idx2;
15044 int num;
15045
15046
15047 TRACE (Func_Entry, "rrspacing_intrinsic", NULL);
15048
15049 ir_idx = OPND_IDX((*result_opnd));
15050 list_idx1 = IR_IDX_R(ir_idx);
15051 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
15052 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
15053
15054 conform_check(0,
15055 ir_idx,
15056 res_exp_desc,
15057 spec_idx,
15058 FALSE);
15059
15060 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15061 IR_RANK(ir_idx) = res_exp_desc->rank;
15062
15063 # if 0
15064
15065 IR_OPR(ir_idx) = Rrspacing_Opr;
15066 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
15067 IR_LIST_CNT_L(ir_idx) = 2;
15068
15069 switch (arg_info_list[info_idx1].ed.linear_type) {
15070 case Real_4:
15071 num = DIGITS_REAL4_F90;
15072 break;
15073
15074 case Real_8:
15075 num = DIGITS_REAL8_F90;
15076 break;
15077
15078 case Real_16:
15079 num = DIGITS_REAL16_F90;
15080 break;
15081 }
15082
15083 cn_idx = C_INT_TO_CN(INTEGER_DEFAULT_TYPE, num);
15084
15085 NTR_IR_LIST_TBL(list_idx2);
15086 IL_ARG_DESC_VARIANT(list_idx2) = TRUE;
15087
15088
15089 IL_NEXT_LIST_IDX(list_idx1) = list_idx2;
15090
15091 IL_IDX(list_idx2) = cn_idx;
15092 IL_FLD(list_idx2) = CN_Tbl_Idx;
15093
15094 IL_LINE_NUM(list_idx2) = IR_LINE_NUM(ir_idx);
15095 IL_COL_NUM(list_idx2) = IR_COL_NUM(ir_idx);
15096
15097 IR_OPND_R(ir_idx) = null_opnd;
15098
15099
15100
15101
15102 # endif
15103
15104 res_exp_desc->foldable = FALSE;
15105 res_exp_desc->will_fold_later = FALSE;
15106
15107 TRACE (Func_Exit, "rrspacing_intrinsic", NULL);
15108
15109 }
15110
15111
15112
15113
15114
15115
15116
15117
15118
15119
15120
15121
15122
15123
15124
15125
15126
15127
15128 void scale_intrinsic(opnd_type *result_opnd,
15129 expr_arg_type *res_exp_desc,
15130 int *spec_idx)
15131 {
15132 int ir_idx;
15133 int info_idx1;
15134
15135
15136 TRACE (Func_Entry, "scale_intrinsic", NULL);
15137
15138 ir_idx = OPND_IDX((*result_opnd));
15139 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
15140 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
15141
15142 conform_check(0,
15143 ir_idx,
15144 res_exp_desc,
15145 spec_idx,
15146 FALSE);
15147
15148 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15149 IR_RANK(ir_idx) = res_exp_desc->rank;
15150
15151 # if 0
15152
15153 IR_OPR(ir_idx) = Scale_Opr;
15154 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
15155 IR_OPND_R(ir_idx) = null_opnd;
15156
15157
15158
15159 # endif
15160
15161 res_exp_desc->foldable = FALSE;
15162 res_exp_desc->will_fold_later = FALSE;
15163
15164 TRACE (Func_Exit, "scale_intrinsic", NULL);
15165
15166 }
15167
15168
15169
15170
15171
15172
15173
15174
15175
15176
15177
15178
15179
15180
15181
15182
15183
15184
15185 void set_exponent_intrinsic(opnd_type *result_opnd,
15186 expr_arg_type *res_exp_desc,
15187 int *spec_idx)
15188 {
15189 int ir_idx;
15190 int info_idx1;
15191
15192
15193 TRACE (Func_Entry, "set_exponent_intrinsic", NULL);
15194
15195 ir_idx = OPND_IDX((*result_opnd));
15196 info_idx1 = IL_ARG_DESC_IDX(IR_IDX_R(ir_idx));
15197 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
15198
15199 conform_check(0,
15200 ir_idx,
15201 res_exp_desc,
15202 spec_idx,
15203 FALSE);
15204
15205 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15206 IR_RANK(ir_idx) = res_exp_desc->rank;
15207
15208 # if 0
15209
15210 IR_OPR(ir_idx) = Set_Exponent_Opr;
15211 COPY_OPND(IR_OPND_L(ir_idx), IR_OPND_R(ir_idx));
15212 IR_OPND_R(ir_idx) = null_opnd;
15213
15214 #endif
15215
15216
15217
15218 res_exp_desc->foldable = FALSE;
15219 res_exp_desc->will_fold_later = FALSE;
15220
15221 TRACE (Func_Exit, "set_exponent_intrinsic", NULL);
15222
15223 }
15224
15225
15226
15227
15228
15229
15230
15231
15232
15233
15234
15235
15236
15237
15238
15239
15240
15241
15242
15243 void dshiftl_intrinsic(opnd_type *result_opnd,
15244 expr_arg_type *res_exp_desc,
15245 int *spec_idx)
15246 {
15247 int ir_idx;
15248 int cn_idx;
15249 int info_idx1;
15250 int info_idx2;
15251 int list_idx1;
15252 int list_idx2;
15253 int list_idx3;
15254 int minus_idx;
15255 int mask_idx;
15256 int shiftl_idx;
15257 int shiftr_idx;
15258 int first_idx;
15259 int second_idx;
15260 int band_idx;
15261 int typeless_idx;
15262 opnd_type opnd;
15263 int line;
15264 long num;
15265 int column;
15266
15267
15268 TRACE (Func_Entry, "dshiftl_intrinsic", NULL);
15269
15270 ir_idx = OPND_IDX((*result_opnd));
15271 list_idx1 = IR_IDX_R(ir_idx);
15272 list_idx2 = IL_NEXT_LIST_IDX(list_idx1);
15273 list_idx3 = IL_NEXT_LIST_IDX(list_idx2);
15274 info_idx1 = IL_ARG_DESC_IDX(list_idx1);
15275 info_idx2 = IL_ARG_DESC_IDX(list_idx2);
15276
15277 line = IR_LINE_NUM(ir_idx);
15278 column = IR_COL_NUM(ir_idx);
15279
15280 ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx)) = arg_info_list[info_idx1].ed.type_idx;
15281
15282 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_8) {
15283 typeless_idx = Typeless_8;
15284 }
15285 else {
15286 typeless_idx = TYPELESS_DEFAULT_TYPE;
15287 }
15288
15289 # ifdef _TARGET_OS_MAX
15290 if (TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_1 ||
15291 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_2 ||
15292 TYP_LINEAR(ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx))) == Integer_4) {
15293 typeless_idx = Typeless_4;
15294 }
15295 # endif
15296
15297 conform_check(0,
15298 ir_idx,
15299 res_exp_desc,
15300 spec_idx,
15301 FALSE);
15302
15303 if (arg_info_list[info_idx1].ed.linear_type !=
15304 arg_info_list[info_idx2].ed.linear_type) {
15305 PRINTMSG(arg_info_list[info_idx2].line, 774, Error,
15306 arg_info_list[info_idx2].col);
15307 }
15308
15309
15310 IR_TYPE_IDX(ir_idx) = ATD_TYPE_IDX(ATP_RSLT_IDX(*spec_idx));
15311 IR_RANK(ir_idx) = res_exp_desc->rank;
15312
15313 # if 0
15314
1531