s_intrin.c

Go to the documentation of this file.
00001 /*
00002 
00003   Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.
00004 
00005   This program is free software; you can redistribute it and/or modify it
00006   under the terms of version 2 of the GNU General Public License as
00007   published by the Free Software Foundation.
00008 
00009   This program is distributed in the hope that it would be useful, but
00010   WITHOUT ANY WARRANTY; without even the implied warranty of
00011   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
00012 
00013   Further, this software is distributed without any warranty that it is
00014   free of the rightful claim of any third person regarding infringement 
00015   or the like.  Any license provided herein, whether implied or 
00016   otherwise, applies only to this software file.  Patent licenses, if 
00017   any, provided herein do not apply to combinations of this program with 
00018   other software, or any other product whatsoever.  
00019 
00020   You should have received a copy of the GNU General Public License along
00021   with this program; if not, write the Free Software Foundation, Inc., 59
00022   Temple Place - Suite 330, Boston MA 02111-1307, USA.
00023 
00024   Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00025   Mountain View, CA 94043, or:
00026 
00027   http://www.sgi.com
00028 
00029   For further information regarding this notice, see:
00030 
00031   http://oss.sgi.com/projects/GenInfo/NoticeExplan
00032 
00033 */
00034 
00035 
00036 
00037 static char USMID[] = "\n@(#)5.0_pl/sources/s_intrin.c  5.31    10/27/99 16:50:34\n";
00038 
00039 # include "defines.h"           /* Machine dependent ifdefs */
00040 # include "host.m"              /* Host machine dependent macros.*/
00041 # include "host.h"              /* Host machine dependent header.*/
00042 # include "target.m"            /* Target machine dependent macros.*/
00043 # include "target.h"            /* Target machine dependent header.*/
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 |* Description:                                                               *|
00067 |*      generate an array constructor of lower and upper bounds from a bd ntry*|
00068 |*                                                                            *|
00069 |* Input parameters:                                                          *|
00070 |*      NONE                                                                  *|
00071 |*                                                                            *|
00072 |* Output parameters:                                                         *|
00073 |*      NONE                                                                  *|
00074 |*                                                                            *|
00075 |* Returns:                                                                   *|
00076 |*      NOTHING                                                               *|
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 }  /* generate_bounds_list */
00164 
00165 
00166 
00167 /******************************************************************************\
00168 |*                                                                            *|
00169 |* Description:                                                               *|
00170 |*      <description>                                                         *|
00171 |*                                                                            *|
00172 |* Input parameters:                                                          *|
00173 |*      NONE                                                                  *|
00174 |*                                                                            *|
00175 |* Output parameters:                                                         *|
00176 |*      NONE                                                                  *|
00177 |*                                                                            *|
00178 |* Returns:                                                                   *|
00179 |*      NOTHING                                                               *|
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 }  /* cri_ptr_type */
00234 
00235 
00236 /******************************************************************************\
00237 |*                                                                            *|
00238 |* Description:                                                               *|
00239 |*      <description>                                                         *|
00240 |*                                                                            *|
00241 |* Input parameters:                                                          *|
00242 |*      NONE                                                                  *|
00243 |*                                                                            *|
00244 |* Output parameters:                                                         *|
00245 |*      NONE                                                                  *|
00246 |*                                                                            *|
00247 |* Returns:                                                                   *|
00248 |*      NOTHING                                                               *|
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       /* Work around 7.2.1.2 optimizer bug */
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             /* not a reference, this would be a copy in anyway */
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             /* intentionally blank */
00434          }
00435    
00436          type_idx = cri_ptr_type(exp_desc1.type_idx);
00437 
00438          /* generate the ptr/pointee pair */
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          /* generate assignment to ptr */
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 }  /* optimize_reshape */
00524 
00525 
00526 /******************************************************************************\
00527 |*                                                                            *|
00528 |* Description:                                                               *|
00529 |*      Check conformance of the operands to an elemental intrinsic.          *|
00530 |*      Also, return the index of the argument to extract the rank/shape from.*|
00531 |*                                                                            *|
00532 |* Input parameters:                                                          *|
00533 |*      NONE                                                                  *|
00534 |*                                                                            *|
00535 |* Output parameters:                                                         *|
00536 |*      NONE                                                                  *|
00537 |*                                                                            *|
00538 |* Returns:                                                                   *|
00539 |*      NOTHING                                                               *|
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) {  /* are there any arguments */
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 }  /* conform_check */
00650 
00651 
00652 /******************************************************************************\
00653 |*                                                                            *|
00654 |* Description:                                                               *|
00655 |*      Function    SIN(X) intrinsic.                                         *|
00656 |*      Function    DSIN(X) intrinsic.                                        *|
00657 |*      Function    QSIN(X) intrinsic.                                        *|
00658 |*      Function    CSIN(X) intrinsic.                                        *|
00659 |*      Function    CDSIN(X) intrinsic.                                       *|
00660 |*      Function    CQSIN(X) intrinsic.                                       *|
00661 |*      Function    SIND(X) intrinsic.                                        *|
00662 |*      Function    DSIND(X) intrinsic.                                       *|
00663 |*      Function    QSIND(X) intrinsic.                                       *|
00664 |*      Function    SINH(X) intrinsic.                                        *|
00665 |*      Function    DSINH(X) intrinsic.                                       *|
00666 |*      Function    QSINH(X) intrinsic.                                       *|
00667 |*      Function    ASIN(X) intrinsic.                                        *|
00668 |*      Function    DASIN(X) intrinsic.                                       *|
00669 |*      Function    QASIN(X) intrinsic.                                       *|
00670 |*      Function    ASIND(X) intrinsic.                                       *|
00671 |*      Function    DASIND(X) intrinsic.                                      *|
00672 |*      Function    QASIND(X) intrinsic.                                      *|
00673 |*      Function    COS(X) intrinsic.                                         *|
00674 |*      Function    DCOS(X) intrinsic.                                        *|
00675 |*      Function    QCOS(X) intrinsic.                                        *|
00676 |*      Function    CCOS(X) intrinsic.                                        *|
00677 |*      Function    CDCOS(X) intrinsic.                                       *|
00678 |*      Function    CQCOS(X) intrinsic.                                       *|
00679 |*      Function    COSD(X) intrinsic.                                        *|
00680 |*      Function    DCOSD(X) intrinsic.                                       *|
00681 |*      Function    QCOSD(X) intrinsic.                                       *|
00682 |*      Function    COSH(X) intrinsic.                                        *|
00683 |*      Function    DCOSH(X) intrinsic.                                       *|
00684 |*      Function    QCOSH(X) intrinsic.                                       *|
00685 |*      Function    ACOS(X) intrinsic.                                        *|
00686 |*      Function    DACOS(X) intrinsic.                                       *|
00687 |*      Function    QACOS(X) intrinsic.                                       *|
00688 |*      Function    ACOSD(X) intrinsic.                                       *|
00689 |*      Function    DACOSD(X) intrinsic.                                      *|
00690 |*      Function    QACOSD(X) intrinsic.                                      *|
00691 |*      Function    TAN(X) intrinsic.                                         *|
00692 |*      Function    DTAN(X) intrinsic.                                        *|
00693 |*      Function    QTAN(X) intrinsic.                                        *|
00694 |*      Function    TAND(X) intrinsic.                                        *|
00695 |*      Function    DTAND(X) intrinsic.                                       *|
00696 |*      Function    QTAND(X) intrinsic.                                       *|
00697 |*      Function    TANH(X) intrinsic.                                        *|
00698 |*      Function    DTANH(X) intrinsic.                                       *|
00699 |*      Function    QTANH(X) intrinsic.                                       *|
00700 |*      Function    ATAN(X) intrinsic.                                        *|
00701 |*      Function    DATAN(X) intrinsic.                                       *|
00702 |*      Function    QATAN(X) intrinsic.                                       *|
00703 |*      Function    ATAND(X) intrinsic.                                       *|
00704 |*      Function    DATAND(X) intrinsic.                                      *|
00705 |*      Function    QATAND(X) intrinsic.                                      *|
00706 |*      Function    LOG(X) intrinsic.                                         *|
00707 |*      Function    DLOG(X) intrinsic.                                        *|
00708 |*      Function    QLOG(X) intrinsic.                                        *|
00709 |*      Function    CDLOG(X) intrinsic.                                       *|
00710 |*      Function    CQLOG(X) intrinsic.                                       *|
00711 |*      Function    LOG10(X) intrinsic.                                       *|
00712 |*      Function    DLOG10(X) intrinsic.                                      *|
00713 |*      Function    QLOG10(X) intrinsic.                                      *|
00714 |*      Function    EXP(X) intrinsic.                                         *|
00715 |*      Function    DEXP(X) intrinsic.                                        *|
00716 |*      Function    QEXP(X) intrinsic.                                        *|
00717 |*      Function    CEXP(X) intrinsic.                                        *|
00718 |*      Function    CDEXP(X) intrinsic.                                       *|
00719 |*      Function    CQEXP(X) intrinsic.                                       *|
00720 |*      Function    COT(X) intrinsic.                                         *|
00721 |*      Function    DCOT(X) intrinsic.                                        *|
00722 |*      Function    QCOT(X) intrinsic.                                        *|
00723 |*      Function    SQRT(X) intrinsic.                                        *|
00724 |*      Function    DSQRT(X) intrinsic.                                       *|
00725 |*      Function    QSQRT(X) intrinsic.                                       *|
00726 |*      Function    CSQRT(X) intrinsic.                                       *|
00727 |*      Function    CDSQRT(X) intrinsic.                                      *|
00728 |*      Function    CQSQRT(X) intrinsic.                                      *|
00729 |*                                                                            *|
00730 |* Input parameters:                                                          *|
00731 |*      NONE                                                                  *|
00732 |*                                                                            *|
00733 |* Output parameters:                                                         *|
00734 |*      NONE                                                                  *|
00735 |*                                                                            *|
00736 |* Returns:                                                                   *|
00737 |*      NOTHING                                                               *|
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 /*         IR_OPR(ir_idx) = Sin_Opr; */
00776          break;
00777 
00778       case Sind_Intrinsic:
00779       case Dsind_Intrinsic:
00780       case Qsind_Intrinsic:
00781 /*         IR_OPR(ir_idx) = Sind_Opr; */
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 /*         IR_OPR(ir_idx) = Cos_Opr; */
00791          break;
00792 
00793       case Cosd_Intrinsic:
00794       case Dcosd_Intrinsic:
00795       case Qcosd_Intrinsic:
00796 /*         IR_OPR(ir_idx) = Cosd_Opr; */
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 /*         IR_OPR(ir_idx) = Log_E_Opr; */
00819          break;
00820 
00821       case Log10_Intrinsic:
00822       case Alog10_Intrinsic:
00823       case Dlog10_Intrinsic:
00824       case Qlog10_Intrinsic:
00825 /*         IR_OPR(ir_idx) = Log_10_Opr; */
00826          break;
00827 
00828       case Tan_Intrinsic:
00829       case Dtan_Intrinsic:
00830       case Qtan_Intrinsic:
00831 /*         IR_OPR(ir_idx) = Tan_Opr; */
00832          break;
00833 
00834       case Tand_Intrinsic:
00835       case Dtand_Intrinsic:
00836       case Qtand_Intrinsic:
00837 /*         IR_OPR(ir_idx) = Tand_Opr; */
00838          break;
00839 
00840       case Tanh_Intrinsic:
00841       case Dtanh_Intrinsic:
00842       case Qtanh_Intrinsic:
00843 /*         IR_OPR(ir_idx) = Tanh_Opr; */
00844          break;
00845 
00846       case Sinh_Intrinsic:
00847       case Dsinh_Intrinsic:
00848       case Qsinh_Intrinsic:
00849 /*         IR_OPR(ir_idx) = Sinh_Opr; */
00850          break;
00851 
00852       case Cosh_Intrinsic:
00853       case Dcosh_Intrinsic:
00854       case Qcosh_Intrinsic:
00855 /*         IR_OPR(ir_idx) = Cosh_Opr; */
00856          break;
00857 
00858       case Acos_Intrinsic:
00859       case Dacos_Intrinsic:
00860       case Qacos_Intrinsic:
00861 /*         IR_OPR(ir_idx) = Acos_Opr; */
00862          break;
00863 
00864       case Acosd_Intrinsic:
00865       case Dacosd_Intrinsic:
00866       case Qacosd_Intrinsic:
00867 /*         IR_OPR(ir_idx) = Acosd_Opr; */
00868          break;
00869 
00870       case Asin_Intrinsic:
00871       case Dasin_Intrinsic:
00872       case Qasin_Intrinsic:
00873 /*         IR_OPR(ir_idx) = Asin_Opr; */
00874          break;
00875 
00876       case Asind_Intrinsic:
00877       case Dasind_Intrinsic:
00878       case Qasind_Intrinsic:
00879 /*         IR_OPR(ir_idx) = Asind_Opr; */
00880          break;
00881 
00882       case Atan_Intrinsic:
00883       case Datan_Intrinsic:
00884       case Qatan_Intrinsic:
00885 /*         IR_OPR(ir_idx) = Atan_Opr; */
00886          break;
00887 
00888       case Atand_Intrinsic:
00889       case Datand_Intrinsic:
00890       case Qatand_Intrinsic:
00891 /*         IR_OPR(ir_idx) = Atand_Opr; */
00892          break;
00893 
00894       case Cot_Intrinsic:
00895       case Dcot_Intrinsic:
00896       case Qcot_Intrinsic:
00897 /*         IR_OPR(ir_idx) = Cot_Opr; */
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 /*         IR_OPR(ir_idx) = Exp_Opr; */
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 /*         IR_OPR(ir_idx) = Sqrt_Opr; */
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    /* must reset foldable and will_fold_later because there is no */
00942    /* folder for this intrinsic in constructors.                  */
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    /* set this flag so this opr is pulled off io lists */
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 }  /* sin_intrinsic */
00964 
00965 
00966 /******************************************************************************\
00967 |*                                                                            *|
00968 |* Description:                                                               *|
00969 |*      Function    ABS(A) intrinsic.                                         *|
00970 |*                                                                            *|
00971 |* Input parameters:                                                          *|
00972 |*      NONE                                                                  *|
00973 |*                                                                            *|
00974 |* Output parameters:                                                         *|
00975 |*      NONE                                                                  *|
00976 |*                                                                            *|
00977 |* Returns:                                                                   *|
00978 |*      NOTHING                                                               *|
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; /* April try */
01033 
01034 /**************************/
01035 /* some kind of intrinsic functions keep shape in expressions
01036   others not */
01037 
01038 # if 0 /* April */
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          /* must reset foldable and will_fold_later because there is no */
01069          /* folder for this intrinsic in constructors.                  */
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 }  /* abs_intrinsic */
01084 
01085 
01086 /******************************************************************************\
01087 |*                                                                            *|
01088 |* Description:                                                               *|
01089 |*      Function    ATAN2(Y, X) intrinsic.                                    *|
01090 |*      Function    ATAN2D(Y, X) intrinsic.                                   *|
01091 |*                                                                            *|
01092 |* Input parameters:                                                          *|
01093 |*      NONE                                                                  *|
01094 |*                                                                            *|
01095 |* Output parameters:                                                         *|
01096 |*      NONE                                                                  *|
01097 |*                                                                            *|
01098 |* Returns:                                                                   *|
01099 |*      NOTHING                                                               *|
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 /*         IR_OPR(ir_idx) = Atan2_Opr; */
01143          break;
01144 
01145       case Atan2d_Intrinsic:
01146       case Datan2d_Intrinsic:
01147       case Qatan2d_Intrinsic:
01148 /*         IR_OPR(ir_idx) = Atan2d_Opr; */
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    /* must reset foldable and will_fold_later because there is no */
01163    /* folder for this intrinsic in constructors.                  */
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 }  /* atan2_intrinsic */
01173 
01174 
01175 /******************************************************************************\
01176 |*                                                                            *|
01177 |* Description:                                                               *|
01178 |*      Function    AIMAG(Z) intrinsic.                                       *|
01179 |*                                                                            *|
01180 |* Input parameters:                                                          *|
01181 |*      NONE                                                                  *|
01182 |*                                                                            *|
01183 |* Output parameters:                                                         *|
01184 |*      NONE                                                                  *|
01185 |*                                                                            *|
01186 |* Returns:                                                                   *|
01187 |*      NOTHING                                                               *|
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    /* must reset foldable and will_fold_later because there is no */
01231    /* folder for this intrinsic in constructors.                  */
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 }  /* aimag_intrinsic */
01242 
01243 
01244 
01245 /******************************************************************************\
01246 |*                                                                            *|
01247 |* Description:                                                               *|
01248 |*      Function    SHORT(A) intrinsic.                                       *|
01249 |*      Function    LONG(A) intrinsic.                                        *|
01250 |*      Function    IDINT(A) intrinsic.                                       *|
01251 |*      Function    IIDINT(A) intrinsic.                                      *|
01252 |*      Function    JIDINT(A) intrinsic.                                      *|
01253 |*      Function    KIDINT(A) intrinsic.                                      *|
01254 |*      Function    IQINT(A) intrinsic.                                       *|
01255 |*      Function    IIQINT(A) intrinsic.                                      *|
01256 |*      Function    JIQINT(A) intrinsic.                                      *|
01257 |*      Function    KIQINT(A) intrinsic.                                      *|
01258 |*      Function    INT(A, KIND) intrinsic.                                   *|
01259 |*      Function    INT1(A) intrinsic.                                        *|
01260 |*      Function    INT2(A) intrinsic.                                        *|
01261 |*      Function    INT4(A) intrinsic.                                        *|
01262 |*      Function    INT8(A) intrinsic.                                        *|
01263 |*      Function    IINT(A) intrinsic.                                        *|
01264 |*      Function    JINT(A) intrinsic.                                        *|
01265 |*      Function    KINT(A) intrinsic.                                        *|
01266 |*      Function    IFIX(A) intrinsic.                                        *|
01267 |*      Function    IIFIX(A) intrinsic.                                       *|
01268 |*      Function    JIFIX(A) intrinsic.                                       *|
01269 |*      Function    KIFIX(A) intrinsic.                                       *|
01270 |*                                                                            *|
01271 |* Input parameters:                                                          *|
01272 |*      NONE                                                                  *|
01273 |*                                                                            *|
01274 |* Output parameters:                                                         *|
01275 |*      NONE                                                                  *|
01276 |*                                                                            *|
01277 |* Returns:                                                                   *|
01278 |*      NOTHING                                                               *|
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 }  /* int_intrinsic */
01399 
01400 
01401 /******************************************************************************\
01402 |*                                                                            *|
01403 |* Description:                                                               *|
01404 |*      Function    IAND(I, J) intrinsic.                                     *|
01405 |*      Function    IIAND(I, J) intrinsic.                                    *|
01406 |*      Function    JIAND(I, J) intrinsic.                                    *|
01407 |*      Function    KIAND(I, J) intrinsic.                                    *|
01408 |*      Function    AND(I, J) intrinsic.                                      *|
01409 |*      Function    IEOR(I, J) intrinsic.                                     *|
01410 |*      Function    IIEOR(I, J) intrinsic.                                    *|
01411 |*      Function    JIEOR(I, J) intrinsic.                                    *|
01412 |*      Function    KIEOR(I, J) intrinsic.                                    *|
01413 |*      Function    NEQV(I, J) intrinsic.                                     *|
01414 |*      Function    XOR(I, J) intrinsic.                                      *|
01415 |*      Function    IOR(I, J) intrinsic.                                      *|
01416 |*      Function    IIOR(I, J) intrinsic.                                     *|
01417 |*      Function    JIOR(I, J) intrinsic.                                     *|
01418 |*      Function    KIOR(I, J) intrinsic.                                     *|
01419 |*      Function    OR(I, J) intrinsic.                                       *|
01420 |*      Function    EQV(I, J) intrinsic.                                      *|
01421 |*                                                                            *|
01422 |* Input parameters:                                                          *|
01423 |*      NONE                                                                  *|
01424 |*                                                                            *|
01425 |* Output parameters:                                                         *|
01426 |*      NONE                                                                  *|
01427 |*                                                                            *|
01428 |* Returns:                                                                   *|
01429 |*      NOTHING                                                               *|
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 /* # if 0  */
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 /* # endif  */
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 }  /* iand_intrinsic */
01850 
01851 
01852 /******************************************************************************\
01853 |*                                                                            *|
01854 |* Description:                                                               *|
01855 |*      Function    MOD(A, P) intrinsic.                                      *|
01856 |*                                                                            *|
01857 |* Input parameters:                                                          *|
01858 |*      NONE                                                                  *|
01859 |*                                                                            *|
01860 |* Output parameters:                                                         *|
01861 |*      NONE                                                                  *|
01862 |*                                                                            *|
01863 |* Returns:                                                                   *|
01864 |*      NOTHING                                                               *|
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          /* must reset foldable and will_fold_later because there is no */
01939          /* folder for this intrinsic in constructors.                  */
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 }  /* mod_intrinsic */
01950 
01951 
01952 /******************************************************************************\
01953 |*                                                                            *|
01954 |* Description:                                                               *|
01955 |*      Subroutine  FREE(P) intrinsic.                                        *|
01956 |*      Subroutine  TIME(BUF) intrinsic.                                      *|
01957 |*                                                                            *|
01958 |* Input parameters:                                                          *|
01959 |*      NONE                                                                  *|
01960 |*                                                                            *|
01961 |* Output parameters:                                                         *|
01962 |*      NONE                                                                  *|
01963 |*                                                                            *|
01964 |* Returns:                                                                   *|
01965 |*      NOTHING                                                               *|
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    /* must reset foldable and will_fold_later because there is no */
01998    /* folder for this intrinsic in constructors.                  */
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 }  /* free_intrinsic */
02008 
02009 
02010 /******************************************************************************\
02011 |*                                                                            *|
02012 |* Description:                                                               *|
02013 |*      Function    MALLOC(P) intrinsic.                                      *|
02014 |*                                                                            *|
02015 |* Input parameters:                                                          *|
02016 |*      NONE                                                                  *|
02017 |*                                                                            *|
02018 |* Output parameters:                                                         *|
02019 |*      NONE                                                                  *|
02020 |*                                                                            *|
02021 |* Returns:                                                                   *|
02022 |*      NOTHING                                                               *|
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    /* must reset foldable and will_fold_later because there is no */
02060    /* folder for this intrinsic in constructors.                  */
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 }  /* malloc_intrinsic */
02070 
02071 
02072 
02073 /******************************************************************************\
02074 |*                                                                            *|
02075 |* Description:                                                               *|
02076 |*      Function    NULL(MOLD) intrinsic.                                     *|
02077 |*                                                                            *|
02078 |* Input parameters:                                                          *|
02079 |*      NONE                                                                  *|
02080 |*                                                                            *|
02081 |* Output parameters:                                                         *|
02082 |*      NONE                                                                  *|
02083 |*                                                                            *|
02084 |* Returns:                                                                   *|
02085 |*      NOTHING                                                               *|
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 /*      ATD_POINTER(ATP_RSLT_IDX(*spec_idx)) = TRUE; */
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 }  /* null_intrinsic */
02222 
02223 
02224 
02225 /******************************************************************************\
02226 |*                                                                            *|
02227 |* Description:                                                               *|
02228 |*      Function    ANINT(A, KIND) intrinsic.                                 *|
02229 |*                                                                            *|
02230 |* Input parameters:                                                          *|
02231 |*      NONE                                                                  *|
02232 |*                                                                            *|
02233 |* Output parameters:                                                         *|
02234 |*      NONE                                                                  *|
02235 |*                                                                            *|
02236 |* Returns:                                                                   *|
02237 |*      NOTHING                                                               *|
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    /* must reset foldable and will_fold_later because there is no */
02292    /* folder for this intrinsic in constructors.                  */
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 }  /* anint_intrinsic */
02300 
02301 
02302 /******************************************************************************\
02303 |*                                                                            *|
02304 |* Description:                                                               *|
02305 |*      Function    NINT(A, KIND) intrinsic.                                  *|
02306 |*      Function    ININT(A) intrinsic.                                       *|
02307 |*      Function    JNINT(A) intrinsic.                                       *|
02308 |*      Function    KNINT(A) intrinsic.                                       *|
02309 |*                                                                            *|
02310 |* Input parameters:                                                          *|
02311 |*      NONE                                                                  *|
02312 |*                                                                            *|
02313 |* Output parameters:                                                         *|
02314 |*      NONE                                                                  *|
02315 |*                                                                            *|
02316 |* Returns:                                                                   *|
02317 |*      NOTHING                                                               *|
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 }  /* nint_intrinsic */
02416 
02417 
02418 /******************************************************************************\
02419 |*                                                                            *|
02420 |* Description:                                                               *|
02421 |*      Function    SIGN(A, B) intrinsic.                                     *|
02422 |*      Function    ISIGN(A, B) intrinsic.                                    *|
02423 |*      Function    IISIGN(A, B) intrinsic.                                   *|
02424 |*      Function    JISIGN(A, B) intrinsic.                                   *|
02425 |*      Function    KISIGN(A, B) intrinsic.                                   *|
02426 |*      Function    DSIGN(A, B) intrinsic.                                    *|
02427 |*      Function    QSIGN(A, B) intrinsic.                                    *|
02428 |*                                                                            *|
02429 |* Input parameters:                                                          *|
02430 |*      NONE                                                                  *|
02431 |*                                                                            *|
02432 |* Output parameters:                                                         *|
02433 |*      NONE                                                                  *|
02434 |*                                                                            *|
02435 |* Returns:                                                                   *|
02436 |*      NOTHING                                                               *|
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             /* must reset foldable and will_fold_later because there is no */
02530             /* folder for this intrinsic in constructors.                  */
02531 
02532             res_exp_desc->foldable = FALSE;
02533             res_exp_desc->will_fold_later = FALSE;
02534          }
02535       }
02536    }
02537    else {
02538       /* must reset foldable and will_fold_later because there is no */
02539       /* folder for this intrinsic in constructors.                  */
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 }  /* sign_intrinsic */
02553 
02554 
02555 /******************************************************************************\
02556 |*                                                                            *|
02557 |* Description:                                                               *|
02558 |*      Function    MODULO(A, P) intrinsic.                                   *|
02559 |*                                                                            *|
02560 |* Input parameters:                                                          *|
02561 |*      NONE                                                                  *|
02562 |*                                                                            *|
02563 |* Output parameters:                                                         *|
02564 |*      NONE                                                                  *|
02565 |*                                                                            *|
02566 |* Returns:                                                                   *|
02567 |*      NOTHING                                                               *|
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          /* must reset foldable and will_fold_later because there is no */
02644          /* folder for this intrinsic in constructors.                  */
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 }  /* modulo_intrinsic */
02658 
02659 
02660 /******************************************************************************\
02661 |*                                                                            *|
02662 |* Description:                                                               *|
02663 |*      Function    SHIFT(I, J) intrinsic.                                    *|
02664 |*      Function    SHIFTL(I, J) intrinsic.                                   *|
02665 |*      Function    LSHIFT(I, POSITIVE_SHIFT) intrinsic.                      *|
02666 |*      Function    SHIFTR(I, J) intrinsic.                                   *|
02667 |*      Function    RSHIFT(I, NEGATIVE_SHIFT) intrinsic.                      *|
02668 |*      Function    SHIFTA(I, J) intrinsic.                                   *|
02669 |*                                                                            *|
02670 |* Input parameters:                                                          *|
02671 |*      NONE                                                                  *|
02672 |*                                                                            *|
02673 |* Output parameters:                                                         *|
02674 |*      NONE                                                                  *|
02675 |*                                                                            *|
02676 |* Returns:                                                                   *|
02677 |*      NOTHING                                                               *|
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          /* must reset foldable and will_fold_later because there is no */
02922          /* folder for this intrinsic in constructors.                  */
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 }  /* shift_intrinsic */
02936 
02937 /******************************************************************************\
02938 |*                                                                            *|
02939 |* Description:                                                               *|
02940 |*      Function    NUM_IMAGES() intrinsic.                                   *|
02941 |*      Function    REM_IMAGES() intrinsic.                                   *|
02942 |*      Function    LOG2_IMAGES() intrinsic.                                  *|
02943 |*      Function    THIS_IMAGE([array[,dim]]) intrinsic.                      *|
02944 |*      Subroutine  SYNC_IMAGES([image]) intrinsic.                           *|
02945 |*                                                                            *|
02946 |* Input parameters:                                                          *|
02947 |*      NONE                                                                  *|
02948 |*                                                                            *|
02949 |* Output parameters:                                                         *|
02950 |*      NONE                                                                  *|
02951 |*                                                                            *|
02952 |* Returns:                                                                   *|
02953 |*      NOTHING                                                               *|
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 /* JEFFL - Do we need to convert endian? - BRIANJ */
03016 /* We could call arith to do 1/2 and then we would have it correct for sure. */
03017 
03018 /* JBL - this won't work when float is not the same as REAL_DEFAULT_TYPE - BHJ*/
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                /* change to this_image3 with dim == 1 */
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             /* error, not a co-array */
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                /* error, not a co-array */
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    /* must reset foldable and will_fold_later because there is no */
03214    /* folder for this intrinsic in constructors.                  */
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 }  /* num_images_intrinsic */
03223 
03224 
03225 /******************************************************************************\
03226 |*                                                                            *|
03227 |* Description:                                                               *|
03228 |*      Function    LEADZ(I) intrinsic.                                       *|
03229 |*      Function    POPCNT(I) intrinsic.                                      *|
03230 |*      Function    POPPAR(I) intrinsic.                                      *|
03231 |*                                                                            *|
03232 |* Input parameters:                                                          *|
03233 |*      NONE                                                                  *|
03234 |*                                                                            *|
03235 |* Output parameters:                                                         *|
03236 |*      NONE                                                                  *|
03237 |*                                                                            *|
03238 |* Returns:                                                                   *|
03239 |*      NOTHING                                                               *|
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    /* must reset foldable and will_fold_later because there is no */
03290    /* folder for this intrinsic in constructors.                  */
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 }  /* leadz_intrinsic */
03300 
03301 
03302 /******************************************************************************\
03303 |*                                                                            *|
03304 |* Description:                                                               *|
03305 |*      Function    NOT(I) intrinsic.                                         *|
03306 |*      Function    INOT(I) intrinsic.                                        *|
03307 |*      Function    JNOT(I) intrinsic.                                        *|
03308 |*      Function    KNOT(I) intrinsic.                                        *|
03309 |*      Function    COMPL(I) intrinsic.                                       *|
03310 |*                                                                            *|
03311 |* Input parameters:                                                          *|
03312 |*      NONE                                                                  *|
03313 |*                                                                            *|
03314 |* Output parameters:                                                         *|
03315 |*      NONE                                                                  *|
03316 |*                                                                            *|
03317 |* Returns:                                                                   *|
03318 |*      NOTHING                                                               *|
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