Open64: osprey/crayf90/fe90/p_asg

00001 /*
00002  *  Copyright (C) 2006. QLogic Corporation. All Rights Reserved.
00003  */
00004 
00005 /*
00006 
00007   Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.
00008 
00009   This program is free software; you can redistribute it and/or modify it
00010   under the terms of version 2 of the GNU General Public License as
00011   published by the Free Software Foundation.
00012 
00013   This program is distributed in the hope that it would be useful, but
00014   WITHOUT ANY WARRANTY; without even the implied warranty of
00015   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
00016 
00017   Further, this software is distributed without any warranty that it is
00018   free of the rightful claim of any third person regarding infringement 
00019   or the like.  Any license provided herein, whether implied or 
00020   otherwise, applies only to this software file.  Patent licenses, if 
00021   any, provided herein do not apply to combinations of this program with 
00022   other software, or any other product whatsoever.  
00023 
00024   You should have received a copy of the GNU General Public License along
00025   with this program; if not, write the Free Software Foundation, Inc., 59
00026   Temple Place - Suite 330, Boston MA 02111-1307, USA.
00027 
00028   Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00029   Mountain View, CA 94043, or:
00030 
00031   http://www.sgi.com
00032 
00033   For further information regarding this notice, see:
00034 
00035   http://oss.sgi.com/projects/GenInfo/NoticeExplan
00036 
00037 */
00038 
00039 
00040 
00041 static char USMID[] = "\n@(#)5.0_pl/sources/p_asg_expr.c  5.3 06/17/99 09:28:10\n";
00042 
00043 # include "defines.h"   /* Machine dependent ifdefs */
00044 
00045 # include "host.m"    /* Host machine dependent macros.*/
00046 # include "host.h"    /* Host machine dependent header.*/
00047 # include "target.m"    /* Target machine dependent macros.*/
00048 # include "target.h"    /* Target machine dependent header.*/
00049 
00050 # include "globals.m"
00051 # include "tokens.m"
00052 # include "sytb.m"
00053 # include "p_globals.m"
00054 # include "debug.m"
00055 
00056 # include "globals.h"
00057 # include "tokens.h"
00058 # include "sytb.h"
00059 # include "p_globals.h"
00060 
00061 
00062 /*****************************************************************\
00063 |* function prototypes of static functions declared in this file *|
00064 \*****************************************************************/
00065 
00066 boolean parse_level_1 (opnd_type *);
00067 boolean parse_mult_opnd (opnd_type *);
00068 boolean parse_add_opnd (opnd_type *);
00069 boolean parse_level_2 (opnd_type *);
00070 boolean parse_level_3 (opnd_type *);
00071 boolean parse_level_4 (opnd_type *);
00072 boolean parse_and_opnd (opnd_type *);
00073 boolean parse_or_opnd (opnd_type *);
00074 boolean parse_equiv_opnd (opnd_type *);
00075 boolean parse_level_5 (opnd_type *);
00076 boolean parse_lhs (opnd_type *, int);
00077 
00078 
00079 /******************************************************************************\
00080 |*                        *|
00081 |* Description:                     *|
00082 |*  BRIEF DESCRIPTION OF THIS FUNCTION'S PURPOSE            *|
00083 |*                        *|
00084 |* Input parameters:                    *|
00085 |*  NONE                      *|
00086 |*                        *|
00087 |* Output parameters:                   *|
00088 |*  NONE                      *|
00089 |*                        *|
00090 |* Returns:                     *|
00091 |*  NONE                      *|
00092 |*                        *|
00093 \******************************************************************************/
00094 
00095 void parse_assignment_stmt (void)
00096 
00097 {
00098    int      attr_idx;
00099    int      buf_idx;
00100    int      col;
00101    int            host_attr_idx;
00102    int            host_name_idx;
00103    int      ir_idx;
00104    int            line;
00105    int            name_idx;
00106    opnd_type      opnd = INIT_OPND_TYPE;
00107    stmt_category_type save_curr_stmt_category;
00108    char     str[2];
00109    int      stmt_num;
00110 
00111 
00112    TRACE (Func_Entry, "parse_assignment_stmt", NULL);
00113 
00114 
00115    attr_idx = srch_sym_tbl (TOKEN_STR(token), TOKEN_LEN(token), &name_idx);
00116 
00117    if (attr_idx == NULL_IDX) {       /* search host sym tab */
00118       host_attr_idx = srch_host_sym_tbl(TOKEN_STR(token), 
00119                                         TOKEN_LEN(token),
00120                                         &host_name_idx,
00121                                         FALSE);
00122 
00123       if (host_attr_idx != NULL_IDX && IS_STMT_ENTITY(host_attr_idx)) {
00124 
00125          /* do not hook up to host stmt entities */
00126          host_attr_idx = NULL_IDX;
00127       }
00128 
00129       if (host_attr_idx != NULL_IDX) {
00130 
00131          /* Make entry in local name table for this item.  Make a new attr    */
00132          /* and attr_link them together.                                      */
00133 
00134          attr_idx = ntr_host_in_sym_tbl(&token, name_idx, host_attr_idx,
00135                                         host_name_idx, TRUE);
00136       }
00137       else {     /* enter attr in local symbol table */
00138          attr_idx = ntr_sym_tbl(&token, name_idx);
00139          SET_IMPL_TYPE(attr_idx);
00140       }
00141    }
00142 
00143    if (AT_OBJ_CLASS(attr_idx) == Data_Obj) {
00144       ATD_SEEN_OUTSIDE_IMP_DO(attr_idx) = TRUE;
00145    }
00146 
00147    if (curr_stmt_category < Executable_Stmt_Cat                  && 
00148        LA_CH_VALUE             == LPAREN                         &&
00149        AT_ATTR_LINK(attr_idx)  == NULL_IDX                       && 
00150        AT_OBJ_CLASS(attr_idx)  == Data_Obj                       &&
00151        ATD_ARRAY_IDX(attr_idx) == NULL_IDX                       &&
00152        (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) != Character ||
00153         ! is_substring_ref())) {
00154 
00155       parse_stmt_func_stmt(attr_idx, name_idx);
00156       goto EXIT;
00157    }
00158 
00159    /* The WHERE block is marked as not allowing executables, because the only */
00160    /* statement allowed in a WHERE block is the assignment statement.  So if  */
00161    /* CURR_BLK_NO_EXEC is set, have to check that this isn't a WHERE block.   */
00162 
00163 
00164    /* Likewise, the FORALL block is marked as not allowing executables,       */
00165    /* because the only statements allowed in a FORALL construct are:          */
00166    /*   * assignment statement (including pointer assignment statement)       */
00167    /*   * WHERE statement or WHERE construct              */
00168    /*   * another FORALL construct or FORALL statement            */
00169    /* So if CURR_BLK_NO_EXEC is set, also have to check that this isn't a     */
00170    /* FORALL block.                     */
00171 
00172    if (CURR_BLK_NO_EXEC &&
00173        CURR_BLK != Where_Else_Blk && 
00174        CURR_BLK != Where_Then_Blk &&
00175        CURR_BLK != Where_Else_Mask_Blk && 
00176        CURR_BLK != Forall_Blk) {
00177 
00178       if (iss_blk_stk_err()) {
00179          parse_err_flush(Find_EOS, NULL);
00180          goto EXIT;
00181       }
00182    }
00183 
00184    save_curr_stmt_category = curr_stmt_category;
00185    curr_stmt_category = Executable_Stmt_Cat;
00186    NTR_IR_TBL(ir_idx);
00187    SH_IR_IDX(curr_stmt_sh_idx)  = ir_idx;
00188 
00189    if (!parse_lhs(&opnd, attr_idx)) {
00190       parse_err_flush(Find_EOS, NULL);
00191       goto EXIT;
00192    }
00193 
00194    COPY_OPND(IR_OPND_L(ir_idx), opnd);
00195 
00196    IR_LINE_NUM(ir_idx)    = LA_CH_LINE;
00197    IR_COL_NUM(ir_idx)   = LA_CH_COLUMN;
00198 
00199    line = LA_CH_LINE;
00200    col  = LA_CH_COLUMN;
00201    buf_idx = LA_CH_BUF_IDX;
00202    stmt_num = LA_CH_STMT_NUM;
00203 
00204    if (LA_CH_VALUE == EOS) {
00205       PRINTMSG(line, 724, Error, col, EOS_STR);
00206       curr_stmt_category = save_curr_stmt_category;
00207    }
00208    else if (MATCHED_TOKEN_CLASS(Tok_Class_Punct) &&
00209             (TOKEN_VALUE(token) == Tok_Punct_Eq ||
00210              TOKEN_VALUE(token) == Tok_Punct_Rename)) {
00211       IR_OPR(ir_idx) = (TOKEN_VALUE(token) == Tok_Punct_Eq) ? Asg_Opr :
00212                                                               Ptr_Asg_Opr;
00213       parse_expr(&opnd);
00214       COPY_OPND(IR_OPND_R(ir_idx), opnd);
00215    }
00216    else {
00217       reset_lex(buf_idx, stmt_num);
00218       str[0] = LA_CH_VALUE;
00219       str[1] = '\0';
00220       PRINTMSG(line, 724, Error, col, str);
00221       parse_err_flush(Find_EOS, NULL);
00222       curr_stmt_category = save_curr_stmt_category;
00223    }
00224 
00225    if (LA_CH_VALUE != EOS) {
00226       parse_err_flush(Find_EOS, "operator or " EOS_STR);
00227    }
00228 
00229 EXIT:
00230 
00231    NEXT_LA_CH;
00232 
00233    TRACE (Func_Exit, "parse_assignment_stmt", NULL);
00234 
00235    return;
00236 
00237 }  /* parse_assignment_stmt */
00238 
00239 
00240 /******************************************************************************\
00241 |*                        *|
00242 |* Description:                     *|
00243 |*  BNF level-5-expr { defined-binary-op level-5-expr }               *|
00244 |*                        *|
00245 |* Input parameters:                    *|
00246 |*  NONE                      *|
00247 |*                        *|
00248 |* Output parameters:                   *|
00249 |*  NONE                                      *|
00250 |*                        *|
00251 |* Returns:                     *|
00252 |*                        *|
00253 \******************************************************************************/
00254 
00255 boolean parse_expr (opnd_type *result)
00256 
00257 {
00258    int       attr_idx;
00259    int       host_attr_idx;
00260    int       host_name_idx;
00261    int       ir_idx;
00262    int       list1_idx;
00263    int       list2_idx;
00264    int       name_idx;
00265    opnd_type opnd = INIT_OPND_TYPE;
00266    boolean   parsed_ok = TRUE;
00267 
00268    TRACE (Func_Entry, "parse_expr", NULL);
00269 
00270 
00271    parsed_ok = parse_level_5(&opnd);
00272 
00273    while (TOKEN_VALUE(token) == Tok_Op_Defined) {
00274 
00275       NTR_IR_TBL(ir_idx);
00276       IR_OPR(ir_idx)      = Defined_Bin_Opr;
00277 
00278       attr_idx = srch_sym_tbl (TOKEN_STR(token), TOKEN_LEN(token), &name_idx);
00279       host_attr_idx = attr_idx;
00280       
00281       if (attr_idx == NULL_IDX) {
00282          host_attr_idx = srch_host_sym_tbl(TOKEN_STR(token), 
00283                                            TOKEN_LEN(token),
00284                                            &host_name_idx,
00285                                            TRUE);
00286 
00287          if (host_attr_idx) {
00288             attr_idx = ntr_host_in_sym_tbl(&token,
00289                                            name_idx,
00290                                            host_attr_idx,
00291                                            host_name_idx,
00292                                            TRUE);
00293 
00294             attr_idx = host_attr_idx;
00295          }
00296 #ifdef KEY /* Bug 12636 */
00297          while (AT_ATTR_LINK(host_attr_idx)) {
00298             host_attr_idx = AT_ATTR_LINK(attr_idx);
00299          }
00300 #endif /* KEY Bug 12636 */
00301       }
00302       else if (AT_ATTR_LINK(attr_idx)) {
00303          host_attr_idx = AT_ATTR_LINK(attr_idx);
00304          while (AT_ATTR_LINK(host_attr_idx)) {
00305             host_attr_idx = AT_ATTR_LINK(attr_idx);
00306          }
00307       }
00308 
00309       if (attr_idx == NULL_IDX || AT_OBJ_CLASS(host_attr_idx) != Interface) {
00310 
00311          /* error .. no defined opr */
00312 
00313          PRINTMSG(TOKEN_LINE(token), 318, Error, TOKEN_COLUMN(token),
00314                   TOKEN_STR(token));
00315          parsed_ok = FALSE;
00316       }
00317       else if (AT_NOT_VISIBLE(host_attr_idx)) {
00318          PRINTMSG(TOKEN_LINE(token), 486, Error,
00319                   TOKEN_COLUMN(token),
00320                   AT_OBJ_NAME_PTR(host_attr_idx),
00321                   AT_OBJ_NAME_PTR(AT_MODULE_IDX((host_attr_idx))));
00322          parsed_ok = FALSE;
00323       }
00324      
00325       IR_FLD_L(ir_idx)   = AT_Tbl_Idx;
00326       IR_IDX_L(ir_idx)   = attr_idx;
00327          
00328       IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token);
00329       IR_COL_NUM_L(ir_idx)  = TOKEN_COLUMN(token);
00330       IR_LINE_NUM(ir_idx)   = TOKEN_LINE(token);
00331       IR_COL_NUM(ir_idx)    = TOKEN_COLUMN(token);
00332 
00333 
00334       NTR_IR_LIST_TBL(list1_idx);
00335       NTR_IR_LIST_TBL(list2_idx);
00336       IR_FLD_R(ir_idx)            = IL_Tbl_Idx;
00337       IR_LIST_CNT_R(ir_idx)       = 2;
00338       IR_IDX_R(ir_idx)            = list1_idx;
00339       IL_NEXT_LIST_IDX(list1_idx) = list2_idx;
00340       IL_PREV_LIST_IDX(list2_idx) = list1_idx;
00341 
00342       COPY_OPND(IL_OPND(list1_idx), opnd);
00343    
00344       parsed_ok = parse_level_5(&opnd) && parsed_ok; 
00345 
00346       COPY_OPND(IL_OPND(list2_idx), opnd);
00347 
00348       OPND_FLD(opnd) = IR_Tbl_Idx;
00349       OPND_IDX(opnd) = ir_idx;
00350    }
00351 
00352    COPY_OPND((*result), opnd);
00353 
00354    TRACE (Func_Exit, "parse_expr", NULL);
00355 
00356    return(parsed_ok);
00357 } /* parse_expr */
00358 
00359 /******************************************************************************\
00360 |*                                                                            *|
00361 |* Description:                                                               *|
00362 |*      BNF [defined_unary_op] primary                                    *|
00363 |*                                                                            *|
00364 |* Input parameters:                                                          *|
00365 |*      NONE                                                                  *|
00366 |*                                                                            *|
00367 |* Output parameters:                                                         *|
00368 |*      NONE                                                                  *|
00369 |*                                                                            *|
00370 |* Returns:                                                                   *|
00371 |*      NOTHING                                                               *|
00372 |*                                                                            *|
00373 \******************************************************************************/
00374 
00375 boolean parse_level_1(opnd_type *result)
00376 
00377 {
00378    int       attr_idx;
00379    int       def_idx = NULL_IDX;
00380    int       host_attr_idx;
00381    int       host_name_idx;
00382    int       name_idx;
00383    opnd_type opnd = INIT_OPND_TYPE;
00384    boolean   parsed_ok = TRUE;
00385 
00386    TRACE (Func_Entry, "parse_level_1", NULL);
00387 
00388    if (LA_CH_VALUE == DOT && matched_specific_token(Tok_Op_Defined, 
00389                                                     Tok_Class_Op)) {
00390       /* have defined_unary_op */
00391 
00392       NTR_IR_TBL(def_idx);
00393       IR_OPR(def_idx) = Defined_Un_Opr;
00394       attr_idx = srch_sym_tbl (TOKEN_STR(token), TOKEN_LEN(token), &name_idx);
00395       host_attr_idx = attr_idx;
00396 
00397       if (attr_idx == NULL_IDX) {
00398          host_attr_idx = srch_host_sym_tbl(TOKEN_STR(token), 
00399                                            TOKEN_LEN(token),
00400                                            &host_name_idx,
00401                                            TRUE);
00402 
00403          if (host_attr_idx) {
00404             attr_idx = ntr_host_in_sym_tbl(&token,
00405                                            name_idx,
00406                                            host_attr_idx,
00407                                            host_name_idx,
00408                                            TRUE);
00409 
00410             attr_idx = host_attr_idx;
00411          }
00412       }
00413       else if (AT_ATTR_LINK(attr_idx)) {
00414          host_attr_idx = AT_ATTR_LINK(attr_idx);
00415          while (AT_ATTR_LINK(host_attr_idx)) {
00416             host_attr_idx = AT_ATTR_LINK(attr_idx);
00417          }
00418       }
00419 
00420       if (attr_idx == NULL_IDX || AT_OBJ_CLASS(host_attr_idx) != Interface) {
00421 
00422          /* error .. no defined opr */
00423 
00424          PRINTMSG(TOKEN_LINE(token), 318, Error, TOKEN_COLUMN(token),
00425                   TOKEN_STR(token));
00426          parsed_ok = FALSE;
00427       }
00428       else if (AT_NOT_VISIBLE(host_attr_idx)) {
00429          PRINTMSG(TOKEN_LINE(token), 486, Error,
00430                   TOKEN_COLUMN(token),
00431                   AT_OBJ_NAME_PTR(host_attr_idx),
00432                   AT_OBJ_NAME_PTR(AT_MODULE_IDX((host_attr_idx))));
00433          parsed_ok = FALSE;
00434       }
00435       else {
00436 
00437          IR_FLD_L(def_idx)   = AT_Tbl_Idx;
00438          IR_IDX_L(def_idx)   = attr_idx;
00439 
00440          IR_LINE_NUM_L(def_idx) = TOKEN_LINE(token);
00441          IR_COL_NUM_L(def_idx)  = TOKEN_COLUMN(token);
00442          IR_LINE_NUM(def_idx)   = TOKEN_LINE(token);
00443          IR_COL_NUM(def_idx)    = TOKEN_COLUMN(token);
00444       }
00445    }
00446 
00447    parsed_ok = parse_operand(&opnd) && parsed_ok;
00448 
00449    if (def_idx) {
00450       COPY_OPND(IR_OPND_R(def_idx), opnd);
00451       OPND_FLD((*result)) = IR_Tbl_Idx;
00452       OPND_IDX((*result)) = def_idx;
00453    }
00454    else {
00455       COPY_OPND((*result), opnd);
00456    }
00457    TRACE (Func_Exit, "parse_level_1", NULL);
00458 
00459    return(parsed_ok);
00460 } /* parse_level_1 */
00461 
00462 /******************************************************************************\
00463 |*                                                                            *|
00464 |* Description:                                                               *|
00465 |*      BNF level-1-expr [** mult_opnd]                                   *|
00466 |*                                                                            *|
00467 |* Input parameters:                                                          *|
00468 |*      NONE                                                                  *|
00469 |*                                                                            *|
00470 |* Output parameters:                                                         *|
00471 |*      NONE                                                                  *|
00472 |*                                                                            *|
00473 |* Returns:                                                                   *|
00474 |*      NOTHING                                                               *|
00475 |*                                                                            *|
00476 \******************************************************************************/
00477 
00478 boolean parse_mult_opnd(opnd_type *result)
00479 
00480 {
00481    int       ir_idx;
00482    opnd_type opnd = INIT_OPND_TYPE;
00483    boolean   parsed_ok = TRUE;
00484 
00485 
00486    TRACE (Func_Entry, "parse_mult_opnd", NULL);
00487 
00488    parsed_ok = parse_level_1(&opnd);
00489 
00490    if (MATCHED_TOKEN_CLASS(Tok_Class_Op)) {
00491 
00492       if (TOKEN_VALUE(token) == Tok_Op_Power) {
00493 
00494          NTR_IR_TBL(ir_idx);
00495          IR_OPR(ir_idx)      = Power_Opr;
00496          IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
00497          IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);
00498 
00499          COPY_OPND(IR_OPND_L(ir_idx), opnd);
00500 
00501          parsed_ok = parse_mult_opnd(&opnd) && parsed_ok;
00502 
00503          COPY_OPND(IR_OPND_R(ir_idx), opnd);
00504 
00505          OPND_FLD((*result)) = IR_Tbl_Idx;
00506          OPND_IDX((*result)) = ir_idx;
00507       }
00508       else if (TOKEN_VALUE(token) == Tok_Const_True ||
00509                TOKEN_VALUE(token) == Tok_Const_False) {
00510       
00511          PRINTMSG(TOKEN_LINE(token), 197, Error, TOKEN_COLUMN(token),
00512                   "operator", "logical literal constant");
00513          parse_err_flush(Find_Expr_End, NULL);
00514          parsed_ok = FALSE;
00515       }
00516       else if (TOKEN_VALUE(token) == Tok_Op_Assign      ||
00517                TOKEN_VALUE(token) == Tok_Op_Deref       ||
00518                TOKEN_VALUE(token) == Tok_Op_Ptr_Assign  ||
00519                TOKEN_VALUE(token) == Tok_Op_Not)        {
00520 
00521          reset_lex(TOKEN_BUF_IDX(token), TOKEN_STMT_NUM(token));
00522          COPY_OPND((*result),opnd);
00523       }
00524       else {
00525          COPY_OPND((*result),opnd);
00526       }
00527    }
00528    else {
00529       COPY_OPND((*result),opnd);
00530    }
00531 
00532    TRACE (Func_Exit, "parse_mult_opnd", NULL);
00533 
00534    return(parsed_ok);
00535 } /* parse_mult_opnd */
00536 
00537 /******************************************************************************\
00538 |*                                                                            *|
00539 |* Description:                                                               *|
00540 |*      BNF mult_opnd {mult-op mult_opnd}                                 *|
00541 |*                                                                            *|
00542 |* Input parameters:                                                          *|
00543 |*      NONE                                                                  *|
00544 |*                                                                            *|
00545 |* Output parameters:                                                         *|
00546 |*      NONE                                                                  *|
00547 |*                                                                            *|
00548 |* Returns:                                                                   *|
00549 |*      NOTHING                                                               *|
00550 |*                                                                            *|
00551 \******************************************************************************/
00552 
00553 boolean parse_add_opnd(opnd_type *result)
00554 
00555 {
00556    int       ir_idx;
00557    opnd_type opnd = INIT_OPND_TYPE;
00558    boolean   parsed_ok = TRUE;
00559 
00560    TRACE (Func_Entry, "parse_add_opnd", NULL);
00561 
00562    parsed_ok = parse_mult_opnd(&opnd);
00563 
00564    while (TOKEN_VALUE(token) == Tok_Op_Mult || 
00565           TOKEN_VALUE(token) == Tok_Op_Div) {
00566 
00567       NTR_IR_TBL(ir_idx);
00568       switch (TOKEN_VALUE(token)) {
00569          case Tok_Op_Mult :
00570             IR_OPR(ir_idx) = Mult_Opr;
00571             break;
00572          case Tok_Op_Div  :
00573             IR_OPR(ir_idx) = Div_Opr;
00574       }
00575       IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
00576       IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);
00577 
00578       COPY_OPND(IR_OPND_L(ir_idx), opnd);
00579       
00580       parsed_ok = parse_mult_opnd(&opnd) && parsed_ok;
00581 
00582       COPY_OPND(IR_OPND_R(ir_idx), opnd);
00583 
00584       OPND_FLD(opnd) = IR_Tbl_Idx;
00585       OPND_IDX(opnd) = ir_idx;
00586    }
00587 
00588    COPY_OPND((*result), opnd);
00589 
00590    TRACE (Func_Exit, "parse_add_opnd", NULL);
00591 
00592    return(parsed_ok);
00593 } /* parse_add_opnd */
00594 
00595 /******************************************************************************\
00596 |*                                                                            *|
00597 |* Description:                                                               *|
00598 |*      BNF [add-op] add-opnd {add-op add-opnd}                           *|
00599 |*                                                                            *|
00600 |* Input parameters:                                                          *|
00601 |*      NONE                                                                  *|
00602 |*                                                                            *|
00603 |* Output parameters:                                                         *|
00604 |*      NONE                                                                  *|
00605 |*                                                                            *|
00606 |* Returns:                                                                   *|
00607 |*      NOTHING                                                               *|
00608 |*                                                                            *|
00609 \******************************************************************************/
00610 
00611 boolean parse_level_2(opnd_type *result)
00612 
00613 {
00614    int       ir_idx = NULL_IDX;
00615    opnd_type opnd = INIT_OPND_TYPE;
00616    boolean   parsed_ok = TRUE;
00617 
00618    TRACE (Func_Entry, "parse_level_2", NULL);
00619 
00620    if (LA_CH_VALUE == PLUS || LA_CH_VALUE == MINUS) {
00621       NTR_IR_TBL(ir_idx);
00622       switch (LA_CH_VALUE) {
00623          case PLUS  :
00624             IR_OPR(ir_idx) = Uplus_Opr;
00625             break;
00626          case MINUS :
00627             IR_OPR(ir_idx) = Uminus_Opr;
00628       }
00629       IR_LINE_NUM(ir_idx) = LA_CH_LINE;
00630       IR_COL_NUM(ir_idx)  = LA_CH_COLUMN;
00631       NEXT_LA_CH;
00632    }
00633 
00634    parsed_ok = parse_add_opnd(&opnd);
00635    
00636    if (ir_idx) {
00637       COPY_OPND(IR_OPND_L(ir_idx), opnd);
00638       OPND_FLD(opnd) = IR_Tbl_Idx;
00639       OPND_IDX(opnd) = ir_idx;
00640    }
00641 
00642    while (TOKEN_VALUE(token) == Tok_Op_Add ||
00643           TOKEN_VALUE(token) == Tok_Op_Sub) {
00644 
00645       NTR_IR_TBL(ir_idx);
00646       switch (TOKEN_VALUE(token)) {
00647          case Tok_Op_Add :
00648             IR_OPR(ir_idx) = Plus_Opr;
00649             break;
00650          case Tok_Op_Sub :
00651             IR_OPR(ir_idx) = Minus_Opr;
00652       }
00653       IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
00654       IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);
00655 
00656       COPY_OPND(IR_OPND_L(ir_idx), opnd);
00657 
00658       parsed_ok = parse_add_opnd(&opnd) && parsed_ok;
00659 
00660       COPY_OPND(IR_OPND_R(ir_idx), opnd);
00661 
00662       OPND_FLD(opnd) = IR_Tbl_Idx;
00663       OPND_IDX(opnd) = ir_idx;
00664    }
00665 
00666    COPY_OPND((*result), opnd);
00667 
00668    TRACE (Func_Exit, "parse_level_2", NULL);
00669 
00670    return(parsed_ok);
00671 } /* parse_level_2 */
00672 
00673 /******************************************************************************\
00674 |*                                                                            *|
00675 |* Description:                                                               *|
00676 |*      BNF level-2-expr { // level-2-expr }                              *|
00677 |*                                                                            *|
00678 |* Input parameters:                                                          *|
00679 |*      NONE                                                                  *|
00680 |*                                                                            *|
00681 |* Output parameters:                                                         *|
00682 |*      NONE                                                                  *|
00683 |*                                                                            *|
00684 |* Returns:                                                                   *|
00685 |*      NOTHING                                                               *|
00686 |*                                                                            *|
00687 \******************************************************************************/
00688 
00689 boolean parse_level_3(opnd_type *result)
00690 
00691 {
00692    int       ir_idx;
00693    opnd_type opnd = INIT_OPND_TYPE;
00694    boolean   parsed_ok = TRUE;
00695 
00696    TRACE (Func_Entry, "parse_level_3", NULL);
00697 
00698    parsed_ok = parse_level_2(&opnd);
00699 
00700    while (TOKEN_VALUE(token) == Tok_Op_Concat) {
00701    
00702       NTR_IR_TBL(ir_idx);
00703       IR_OPR(ir_idx)      = Concat_Opr;
00704       IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
00705       IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);
00706 
00707       COPY_OPND(IR_OPND_L(ir_idx), opnd);
00708       
00709       parsed_ok = parse_level_2(&opnd) && parsed_ok;
00710 
00711       COPY_OPND(IR_OPND_R(ir_idx), opnd);
00712 
00713       OPND_FLD(opnd) = IR_Tbl_Idx;
00714       OPND_IDX(opnd) = ir_idx;
00715    }
00716 
00717    COPY_OPND((*result), opnd);
00718 
00719    TRACE (Func_Exit, "parse_level_3", NULL);
00720 
00721    return(parsed_ok);
00722 } /* parse_level_3 */
00723 
00724 /******************************************************************************\
00725 |*                                                                            *|
00726 |* Description:                                                               *|
00727 |*      BNF [level-3-expr rel-op] level-3-expr                            *|
00728 |*                                                                            *|
00729 |* Input parameters:                                                          *|
00730 |*      NONE                                                                  *|
00731 |*                                                                            *|
00732 |* Output parameters:                                                         *|
00733 |*      NONE                                                                  *|
00734 |*                                                                            *|
00735 |* Returns:                                                                   *|
00736 |*      NOTHING                                                               *|
00737 |*                                                                            *|
00738 \******************************************************************************/
00739 
00740 boolean parse_level_4(opnd_type *result)
00741 
00742 {
00743    int       ir_idx;
00744    opnd_type opnd = INIT_OPND_TYPE;
00745    boolean   parsed_ok = TRUE;
00746 
00747    TRACE (Func_Entry, "parse_level_4", NULL);
00748 
00749    parsed_ok = parse_level_3(&opnd);
00750 
00751    if (TOKEN_VALUE(token) == Tok_Op_Eq ||
00752        TOKEN_VALUE(token) == Tok_Op_Ne ||
00753        TOKEN_VALUE(token) == Tok_Op_Ge ||
00754        TOKEN_VALUE(token) == Tok_Op_Gt ||
00755        TOKEN_VALUE(token) == Tok_Op_Le ||
00756        TOKEN_VALUE(token) == Tok_Op_Lt ||
00757        TOKEN_VALUE(token) == Tok_Op_Lg) {
00758 
00759       NTR_IR_TBL(ir_idx);
00760       switch (TOKEN_VALUE(token)) {
00761          case Tok_Op_Eq :
00762             IR_OPR(ir_idx) = Eq_Opr;
00763             break;
00764          case Tok_Op_Ne :
00765             IR_OPR(ir_idx) = Ne_Opr;
00766             break;
00767          case Tok_Op_Ge :
00768             IR_OPR(ir_idx) = Ge_Opr;
00769             break;
00770          case Tok_Op_Gt :
00771             IR_OPR(ir_idx) = Gt_Opr;
00772             break;
00773          case Tok_Op_Le :
00774             IR_OPR(ir_idx) = Le_Opr;
00775             break;
00776          case Tok_Op_Lt :
00777             IR_OPR(ir_idx) = Lt_Opr;
00778             break;
00779          case Tok_Op_Lg :
00780             IR_OPR(ir_idx) = Lg_Opr;
00781             PRINTMSG(TOKEN_LINE(token), 1243, Ansi, TOKEN_COLUMN(token));
00782             break;
00783       }
00784       IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
00785       IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);
00786 
00787       COPY_OPND(IR_OPND_L(ir_idx), opnd);
00788 
00789       parsed_ok = parse_level_3(&opnd) && parsed_ok;
00790 
00791       COPY_OPND(IR_OPND_R(ir_idx), opnd);
00792 
00793       OPND_FLD(opnd) = IR_Tbl_Idx;
00794       OPND_IDX(opnd) = ir_idx;
00795    }
00796 
00797    COPY_OPND((*result), opnd);
00798 
00799    TRACE (Func_Exit, "parse_level_4", NULL);
00800 
00801    return(parsed_ok);
00802 } /* parse_level_4 */
00803 
00804 /******************************************************************************\
00805 |*                                                                            *|
00806 |* Description:                                                               *|
00807 |*      BNF [not-op] level-4-expr                                         *|
00808 |*                                                                            *|
00809 |* Input parameters:                                                          *|
00810 |*      NONE                                                                  *|
00811 |*                                                                            *|
00812 |* Output parameters:                                                         *|
00813 |*      NONE                                                                  *|
00814 |*                                                                            *|
00815 |* Returns:                                                                   *|
00816 |*      NOTHING                                                               *|
00817 |*                                                                            *|
00818 \******************************************************************************/
00819 
00820 boolean parse_and_opnd(opnd_type *result)
00821 
00822 {
00823    int       buf_idx;
00824    int       i;
00825    int       ir_idx = NULL_IDX;
00826    char      op[8];
00827    opnd_type opnd = INIT_OPND_TYPE;
00828    boolean   parsed_ok = TRUE;
00829    int       stmt_num;
00830 
00831 
00832    TRACE (Func_Entry, "parse_and_opnd", NULL);
00833 
00834    if (LA_CH_VALUE == DOT) {
00835       buf_idx = LA_CH_BUF_IDX;
00836       stmt_num = LA_CH_STMT_NUM;
00837 
00838       NEXT_LA_CH;
00839 
00840       for (i = 0; i < 4; i++) {
00841          op[i] = LA_CH_VALUE;
00842 
00843          if (LA_CH_VALUE == DOT ||
00844              LA_CH_VALUE == EOS) {
00845             break;
00846          }
00847          NEXT_LA_CH;
00848       }
00849 
00850       reset_lex(buf_idx, stmt_num);
00851 
00852       if (((i == 1 && strncmp(op, "N.", 2) == 0)    ||
00853            (i == 3 && strncmp(op, "NOT.", 4) == 0))    &&
00854           matched_specific_token(Tok_Op_Not, Tok_Class_Op)) {
00855 
00856          NTR_IR_TBL(ir_idx);
00857          OPND_FLD((*result)) = IR_Tbl_Idx;
00858          OPND_IDX((*result)) = ir_idx;
00859          IR_OPR(ir_idx)      = Not_Opr;
00860          IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
00861          IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);
00862       }
00863    }
00864 
00865    parsed_ok = parse_level_4(&opnd);
00866 
00867    if (ir_idx) {
00868       COPY_OPND(IR_OPND_L(ir_idx), opnd);
00869    }
00870    else {
00871       COPY_OPND((*result), opnd);
00872    }
00873 
00874    TRACE (Func_Exit, "parse_and_opnd", NULL);
00875 
00876    return(parsed_ok);
00877 } /* parse_and_opnd */
00878 
00879 /******************************************************************************\
00880 |*                                                                            *|
00881 |* Description:                                                               *|
00882 |*      BNF and_opnd { and_op and_opnd }                                  *|
00883 |*                                                                            *|
00884 |* Input parameters:                                                          *|
00885 |*      NONE                                                                  *|
00886 |*                                                                            *|
00887 |* Output parameters:                                                         *|
00888 |*      NONE                                                                  *|
00889 |*                                                                            *|
00890 |* Returns:                                                                   *|
00891 |*      NOTHING                                                               *|
00892 |*                                                                            *|
00893 \******************************************************************************/
00894 
00895 boolean parse_or_opnd(opnd_type *result)
00896 
00897 {
00898    int       ir_idx;
00899    opnd_type opnd = INIT_OPND_TYPE;
00900    boolean   parsed_ok = TRUE;
00901 
00902    TRACE (Func_Entry, "parse_or_opnd", NULL);
00903 
00904    parsed_ok = parse_and_opnd(&opnd);
00905 
00906    while (TOKEN_VALUE(token) == Tok_Op_And) {
00907 
00908       NTR_IR_TBL(ir_idx);
00909       IR_OPR(ir_idx)      = And_Opr;
00910       IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
00911       IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);
00912 
00913       COPY_OPND(IR_OPND_L(ir_idx), opnd);
00914   
00915       parsed_ok = parse_and_opnd(&opnd) && parsed_ok;
00916 
00917       COPY_OPND(IR_OPND_R(ir_idx), opnd);
00918 
00919       OPND_FLD(opnd) = IR_Tbl_Idx;
00920       OPND_IDX(opnd) = ir_idx;
00921    }
00922 
00923    COPY_OPND((*result), opnd);
00924 
00925    TRACE (Func_Exit, "parse_or_opnd", NULL);
00926 
00927    return(parsed_ok);
00928 } /* parse_or_opnd */
00929 
00930 /******************************************************************************\
00931 |*                                                                            *|
00932 |* Description:                                                               *|
00933 |*      BNF or_opnd { or_op or_opnd }                                     *|
00934 |*                                                                            *|
00935 |* Input parameters:                                                          *|
00936 |*      NONE                                                                  *|
00937 |*                                                                            *|
00938 |* Output parameters:                                                         *|
00939 |*      NONE                                                                  *|
00940 |*                                                                            *|
00941 |* Returns:                                                                   *|
00942 |*      NOTHING                                                               *|
00943 |*                                                                            *|
00944 \******************************************************************************/
00945 
00946 boolean parse_equiv_opnd(opnd_type *result)
00947 
00948 {
00949    int       ir_idx;
00950    opnd_type opnd = INIT_OPND_TYPE;
00951    boolean   parsed_ok = TRUE;
00952 
00953    TRACE (Func_Entry, "parse_equiv_opnd", NULL);
00954 
00955    parsed_ok = parse_or_opnd(&opnd);
00956 
00957    while (TOKEN_VALUE(token) == Tok_Op_Or) {
00958       
00959       NTR_IR_TBL(ir_idx);
00960       IR_OPR(ir_idx)      = Or_Opr;
00961       IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
00962       IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);
00963 
00964       COPY_OPND(IR_OPND_L(ir_idx), opnd);
00965 
00966       parsed_ok = parse_or_opnd(&opnd) && parsed_ok;
00967 
00968       COPY_OPND(IR_OPND_R(ir_idx), opnd);
00969 
00970       OPND_FLD(opnd) = IR_Tbl_Idx;
00971       OPND_IDX(opnd) = ir_idx;
00972    }
00973 
00974    COPY_OPND((*result), opnd);
00975 
00976    TRACE (Func_Exit, "parse_equiv_opnd", NULL);
00977 
00978    return(parsed_ok);
00979 } /* parse_equiv_opnd */
00980 
00981 /******************************************************************************\
00982 |*                                                                            *|
00983 |* Description:                                                               *|
00984 |*      BNF equiv-opnd { equiv-op equiv-opnd }                            *|
00985 |*                                                                            *|
00986 |* Input parameters:                                                          *|
00987 |*      NONE                                                                  *|
00988 |*                                                                            *|
00989 |* Output parameters:                                                         *|
00990 |*      NONE                                                                  *|
00991 |*                                                                            *|
00992 |* Returns:                                                                   *|
00993 |*      NOTHING                                                               *|
00994 |*                                                                            *|
00995 \******************************************************************************/
00996 
00997 boolean parse_level_5(opnd_type *result)
00998 
00999 {
01000    int       ir_idx;
01001    opnd_type opnd = INIT_OPND_TYPE;
01002    boolean   parsed_ok = TRUE;
01003 
01004    TRACE (Func_Entry, "parse_level_5", NULL);
01005 
01006    parsed_ok = parse_equiv_opnd(&opnd);
01007 
01008    while (TOKEN_VALUE(token) == Tok_Op_Eqv   ||
01009           TOKEN_VALUE(token) == Tok_Op_Neqv) {
01010       
01011       NTR_IR_TBL(ir_idx);
01012       switch (TOKEN_VALUE(token)) {
01013          case Tok_Op_Eqv  :
01014             IR_OPR(ir_idx) = Eqv_Opr;
01015             break;
01016          case Tok_Op_Neqv :
01017             IR_OPR(ir_idx) = Neqv_Opr;
01018       }
01019       IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
01020       IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);
01021 
01022       COPY_OPND(IR_OPND_L(ir_idx), opnd);
01023 
01024       parsed_ok = parse_equiv_opnd(&opnd) && parsed_ok; 
01025 
01026       COPY_OPND(IR_OPND_R(ir_idx), opnd);
01027 
01028       OPND_FLD(opnd) = IR_Tbl_Idx;
01029       OPND_IDX(opnd) = ir_idx;
01030    }
01031 
01032    COPY_OPND((*result), opnd);
01033 
01034    TRACE (Func_Exit, "parse_level_5", NULL);
01035 
01036    return(parsed_ok);
01037 } /* parse_level_5 */
01038 
01039 
01040 #ifdef KEY /* Bug 8004 */
01041 /*
01042  * Do the parsing of an array constructor.
01043  * parsed_ok  Indicates whether we have encountered an error so far; we
01044  *    update this.
01045  * the_opnd Operand to be created by parsing
01046  */
01047 static void do_array_constructor(boolean *parsed_ok, opnd_type *the_opnd) {
01048   int ir_idx = NULL_IDX;
01049   opnd_type opnd = INIT_OPND_TYPE;
01050 
01051   NTR_IR_TBL(ir_idx);
01052   IR_OPR(ir_idx) = Array_Construct_Opr;
01053   IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
01054   IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);
01055   OPND_FLD((*the_opnd)) = IR_Tbl_Idx;
01056   OPND_IDX((*the_opnd)) = ir_idx;
01057 
01058   boolean save_in_constructor = in_constructor;
01059   in_constructor = TRUE;
01060   *parsed_ok = parse_io_list(&opnd) && *parsed_ok;
01061   in_constructor = save_in_constructor;
01062 
01063   COPY_OPND(IR_OPND_R(ir_idx), opnd);
01064 }
01065 
01066 #endif /* KEY Bug 8004 */
01067 /******************************************************************************\
01068 |*                        *|
01069 |* Description:                     *|
01070 |*  <description>                   *|
01071 |*                        *|
01072 |* Input parameters:                    *|
01073 |*  NONE                      *|
01074 |*                        *|
01075 |* Output parameters:                   *|
01076 |*  NONE                      *|
01077 |*                        *|
01078 |* Returns:                     *|
01079 |*  NOTHING                     *|
01080 |*                        *|
01081 \******************************************************************************/
01082 boolean parse_operand (opnd_type *the_opnd)
01083 
01084 {
01085    opnd_type    cmplx_opnd  = INIT_OPND_TYPE;
01086    int      cmplx_lin_type;
01087    int      cmplx_dcl_val;
01088    int      cmplx_desc;
01089    int      col;
01090    int      cx_l    = NULL_IDX;
01091    int      cx_r    = NULL_IDX;
01092    long_type    constant[MAX_WORDS_FOR_NUMERIC];
01093    expr_arg_type  exp_desc;
01094    int      ir_idx;
01095    int      line;
01096    int      list_idx;
01097    int      list2_idx;
01098    opnd_type    opnd    = INIT_OPND_TYPE;
01099    boolean    parsed_ok = TRUE;
01100    boolean    save_in_constructor;
01101    int      type_idx;
01102    int      type_l;
01103    int      type_r;
01104 
01105 
01106    TRACE (Func_Entry, "parse_operand", NULL);
01107 
01108    if (LA_CH_VALUE == LPAREN && matched_specific_token(Tok_Punct_Lparen,
01109                                                        Tok_Class_Punct)) {
01110 
01111       line = TOKEN_LINE(token);
01112       col  = TOKEN_COLUMN(token);
01113 
01114       if (!parse_expr(the_opnd)) {
01115          parsed_ok = FALSE;
01116       }
01117       else if (LA_CH_VALUE == RPAREN) {
01118          /* insert paren_opr */
01119          NTR_IR_TBL(ir_idx);
01120          IR_OPR(ir_idx) = Paren_Opr;
01121          COPY_OPND(IR_OPND_L(ir_idx), (*the_opnd));
01122          OPND_FLD((*the_opnd)) = IR_Tbl_Idx;
01123          OPND_IDX((*the_opnd)) = ir_idx;
01124          IR_LINE_NUM(ir_idx)   = line;
01125          IR_COL_NUM(ir_idx)    = col;
01126          
01127          NEXT_LA_CH;
01128          goto EXIT;
01129       }
01130       /* Assume complex constant - Try to fold */
01131       else if (OPND_FLD((*the_opnd)) == CN_Tbl_Idx) {
01132          cx_l = OPND_IDX((*the_opnd));
01133       }
01134       else if (OPND_FLD((*the_opnd))               == AT_Tbl_Idx &&
01135                AT_OBJ_CLASS(OPND_IDX((*the_opnd))) == Data_Obj   &&
01136                ATD_CLASS(OPND_IDX((*the_opnd)))    == Constant   &&
01137                ATD_FLD(OPND_IDX((*the_opnd)))      == CN_Tbl_Idx) {
01138 
01139          cx_l = ATD_CONST_IDX(OPND_IDX((*the_opnd)));
01140       }
01141       else if (OPND_FLD((*the_opnd))               == IR_Tbl_Idx  &&
01142                (IR_OPR(OPND_IDX((*the_opnd)))      == Uplus_Opr ||
01143                 IR_OPR(OPND_IDX((*the_opnd)))      == Uminus_Opr) &&
01144                (IR_FLD_L(OPND_IDX((*the_opnd)))    == CN_Tbl_Idx ||
01145                 (IR_FLD_L(OPND_IDX((*the_opnd)))    == AT_Tbl_Idx &&
01146                  AT_OBJ_CLASS(IR_IDX_L(OPND_IDX((*the_opnd)))) == Data_Obj &&
01147                  ATD_CLASS(IR_IDX_L(OPND_IDX((*the_opnd))))    == Constant &&
01148                  ATD_FLD(IR_IDX_L(OPND_IDX((*the_opnd)))) == CN_Tbl_Idx))) {
01149 
01150          exp_desc.rank = 0;
01151          xref_state    = CIF_No_Usage_Rec;
01152          comp_gen_expr = TRUE;
01153          parsed_ok = expr_semantics(the_opnd, &exp_desc);
01154          comp_gen_expr = FALSE;
01155 
01156          if (OPND_FLD((*the_opnd)) == CN_Tbl_Idx) {
01157             cx_l = OPND_IDX((*the_opnd));
01158          }
01159       }
01160 
01161       if (cx_l                            &&
01162           (TYP_TYPE(CN_TYPE_IDX(cx_l)) == Real ||
01163            TYP_TYPE(CN_TYPE_IDX(cx_l)) == Integer) &&
01164           LA_CH_VALUE == COMMA                             ) {  
01165          /* Have complex const */
01166          NEXT_LA_CH;
01167             
01168          if (!parse_expr(&cmplx_opnd)) {
01169             parsed_ok = FALSE;
01170          }
01171          else {
01172 
01173             if (OPND_FLD(cmplx_opnd) == CN_Tbl_Idx) {
01174                cx_r = OPND_IDX(cmplx_opnd);
01175             }
01176             else if (OPND_FLD(cmplx_opnd)               == AT_Tbl_Idx &&
01177                      AT_OBJ_CLASS(OPND_IDX(cmplx_opnd)) == Data_Obj   &&
01178                      ATD_CLASS(OPND_IDX(cmplx_opnd))    == Constant   &&
01179                      ATD_FLD(OPND_IDX(cmplx_opnd))      == CN_Tbl_Idx) {
01180 
01181                cx_r = ATD_CONST_IDX(OPND_IDX(cmplx_opnd));
01182             }
01183             else if (OPND_FLD(cmplx_opnd)               == IR_Tbl_Idx  &&
01184                      (IR_OPR(OPND_IDX(cmplx_opnd))      == Uplus_Opr ||
01185                       IR_OPR(OPND_IDX(cmplx_opnd))      == Uminus_Opr) &&
01186                      (IR_FLD_L(OPND_IDX(cmplx_opnd))    == CN_Tbl_Idx ||
01187                       (IR_FLD_L(OPND_IDX(cmplx_opnd))    == AT_Tbl_Idx &&
01188                        AT_OBJ_CLASS(IR_IDX_L(OPND_IDX(cmplx_opnd)))==Data_Obj &&
01189                        ATD_CLASS(IR_IDX_L(OPND_IDX(cmplx_opnd))) == Constant &&
01190                        ATD_FLD(IR_IDX_L(OPND_IDX(cmplx_opnd))) == CN_Tbl_Idx))){
01191 
01192                exp_desc.rank = 0;
01193                xref_state    = CIF_No_Usage_Rec;
01194                comp_gen_expr = TRUE;
01195                parsed_ok = expr_semantics(&cmplx_opnd, &exp_desc);
01196                comp_gen_expr = FALSE;
01197       
01198                if (OPND_FLD(cmplx_opnd) == CN_Tbl_Idx) {
01199                   cx_r = OPND_IDX(cmplx_opnd);
01200                }
01201             }
01202 
01203 
01204             if (cx_r                               &&
01205                 (TYP_TYPE(CN_TYPE_IDX(cx_r)) == Real ||
01206                  TYP_TYPE(CN_TYPE_IDX(cx_r)) == Integer)) {
01207                type_r = CN_TYPE_IDX(cx_r);
01208                type_l = CN_TYPE_IDX(cx_l);
01209            
01210                if (TYP_TYPE(type_l) == Real && 
01211                    TYP_TYPE(type_r) == Real) {
01212 
01213                   if (TYP_LINEAR(type_l) > TYP_LINEAR(type_r)) {
01214                      cmplx_lin_type = TYP_LINEAR(type_l);
01215                      cmplx_dcl_val  = TYP_DCL_VALUE(type_l);
01216                      cmplx_desc     = TYP_DESC(type_l);
01217                   }
01218                   else {
01219                      cmplx_lin_type = TYP_LINEAR(type_r);
01220                      cmplx_dcl_val  = TYP_DCL_VALUE(type_r);
01221                      cmplx_desc     = TYP_DESC(type_r);
01222                   }
01223                }
01224                else if (TYP_TYPE(type_l) == Real     && 
01225                         TYP_TYPE(type_r) == Integer) {
01226                   cmplx_lin_type = TYP_LINEAR(type_l);
01227                   cmplx_dcl_val  = TYP_DCL_VALUE(type_l);
01228                   cmplx_desc     = TYP_DESC(type_l);
01229 
01230                }
01231                else if (TYP_TYPE(type_l) == Integer && 
01232                         TYP_TYPE(type_r) == Real)   {
01233                   cmplx_lin_type = TYP_LINEAR(type_r);
01234                   cmplx_dcl_val  = TYP_DCL_VALUE(type_r);
01235                   cmplx_desc     = TYP_DESC(type_r);
01236 
01237                } 
01238                else { /* both integer */
01239                   cmplx_lin_type = REAL_DEFAULT_TYPE;
01240                   cmplx_dcl_val  = 0;
01241                   cmplx_desc     = 0;
01242                }
01243 
01244                type_idx = cmplx_lin_type;
01245                parsed_ok = folder_driver((char *)&CN_CONST(cx_l),
01246                                          type_l,
01247                                          NULL,
01248                                          NULL_IDX,
01249                                          constant,
01250                                          &type_idx,
01251                                           line,
01252                                           col,
01253                                           1,
01254                                           Cvrt_Opr) && parsed_ok;
01255 
01256                type_idx = cmplx_lin_type;
01257                parsed_ok = folder_driver((char *)&CN_CONST(cx_r),
01258                                          type_r,
01259                                          NULL,
01260                                          NULL_IDX,
01261                                     &(constant[num_host_wds[cmplx_lin_type]]),
01262                                          &type_idx,
01263                                           line,
01264                                           col,
01265                                           1,
01266                                           Cvrt_Opr) && parsed_ok;
01267 
01268                switch(cmplx_lin_type) {
01269                   case Real_4 :
01270                      cmplx_lin_type = Complex_4;
01271 # if defined(_WHIRL_HOST64_TARGET64)
01272                      {
01273                        float *p = (float *)&constant;
01274                        p[1] = p[2];
01275                      }
01276 # endif
01277                      break;
01278 
01279                   case Real_8 :
01280                      cmplx_lin_type = Complex_8;
01281                      break;
01282 
01283                   case Real_16 :
01284                      cmplx_lin_type = Complex_16;
01285                      break;
01286 
01287                }
01288 
01289                OPND_FLD((*the_opnd)) = CN_Tbl_Idx;
01290 
01291                CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
01292                TYP_TYPE(TYP_WORK_IDX) = Complex;
01293                TYP_LINEAR(TYP_WORK_IDX) = (linear_type_type) cmplx_lin_type;
01294                TYP_DCL_VALUE(TYP_WORK_IDX)  = cmplx_dcl_val;
01295                TYP_DESC(TYP_WORK_IDX)   = (type_desc_type) cmplx_desc;
01296                type_idx       = ntr_type_tbl();
01297 
01298                OPND_IDX((*the_opnd)) = ntr_const_tbl(type_idx, 
01299                                                      FALSE,
01300                                                      constant);
01301             }
01302             else {
01303                parse_err_flush(Find_Rparen, "CONSTANT");
01304                parsed_ok = FALSE;
01305             }
01306          }
01307       }
01308 
01309       if (LA_CH_VALUE == RPAREN) {
01310          NEXT_LA_CH;
01311       }
01312       else if (parse_err_flush(Find_Rparen, ")")) {
01313          NEXT_LA_CH;
01314          parsed_ok = FALSE;
01315       }
01316       else {
01317          parsed_ok = FALSE;
01318       }
01319       goto EXIT;
01320    }
01321    else if (LA_CH_CLASS == Ch_Class_Digit  ||
01322             LA_CH_CLASS == Ch_Class_Letter ||
01323             LA_CH_VALUE == DOT             ||
01324             LA_CH_VALUE == QUOTE           ||
01325             LA_CH_VALUE == DBL_QUOTE)      {
01326 
01327       if (MATCHED_TOKEN_CLASS(Tok_Class_Opnd)) {
01328          OPND_LINE_NUM((*the_opnd)) = TOKEN_LINE(token);
01329          OPND_COL_NUM((*the_opnd))  = TOKEN_COLUMN(token);
01330          OPND_FLD((*the_opnd))      = CN_Tbl_Idx;
01331 
01332          switch (TOKEN_VALUE(token)) {
01333 
01334             case Tok_Id :
01335 
01336             if (! parse_deref(the_opnd, NULL_IDX)) {
01337                parsed_ok = FALSE;
01338             }
01339             break;
01340 
01341             case Tok_Const_Char :
01342             
01343                if (LA_CH_VALUE == LPAREN && is_substring_ref ()) {
01344                   NTR_IR_TBL(ir_idx);
01345                   IR_OPR(ir_idx)              = Substring_Opr;
01346                   IR_LINE_NUM(ir_idx)         = LA_CH_LINE;
01347                   IR_COL_NUM(ir_idx)          = LA_CH_COLUMN;
01348                   OPND_FLD((*the_opnd))       = IR_Tbl_Idx;
01349                   OPND_IDX((*the_opnd))       = ir_idx;
01350                   IR_FLD_L(ir_idx)            = CN_Tbl_Idx;
01351                   IR_IDX_L(ir_idx)            = TOKEN_CONST_TBL_IDX(token);
01352                   IR_LINE_NUM_L(ir_idx)       = TOKEN_LINE(token);
01353                   IR_COL_NUM_L(ir_idx)        = TOKEN_COLUMN(token);
01354    
01355                   IR_FLD_R(ir_idx)            = IL_Tbl_Idx;
01356                   IR_LIST_CNT_R(ir_idx)       = 2;
01357                   NTR_IR_LIST_TBL(list_idx);
01358                   NTR_IR_LIST_TBL(list2_idx);
01359                   IR_IDX_R(ir_idx)            = list_idx;
01360                   IL_NEXT_LIST_IDX(list_idx)  = list2_idx;
01361                   IL_PREV_LIST_IDX(list2_idx) = list_idx;
01362    
01363                   /* consume ( */
01364                   NEXT_LA_CH;
01365       
01366                   if (LA_CH_VALUE != COLON) {
01367                      parsed_ok = parse_expr(&opnd) && parsed_ok;
01368                      COPY_OPND(IL_OPND(list_idx), opnd);
01369                   }
01370       
01371                   if (LA_CH_VALUE != COLON) {
01372                      if (parse_err_flush(Find_Rparen, ":")) {
01373                         NEXT_LA_CH;
01374                      }
01375                      parsed_ok = FALSE;
01376                      goto EXIT;
01377                   }
01378                   else {
01379                      NEXT_LA_CH;
01380                   }
01381                   if (LA_CH_VALUE != RPAREN) {
01382                      parsed_ok = parse_expr(&opnd) && parsed_ok;
01383                      COPY_OPND(IL_OPND(list2_idx), opnd);
01384                   }
01385       
01386                   if (LA_CH_VALUE != RPAREN) {
01387       
01388                      if (parse_err_flush(Find_Rparen, ")")) {
01389                         NEXT_LA_CH;
01390                      }
01391                      parsed_ok = FALSE;
01392                   }
01393                   else {
01394                      NEXT_LA_CH;
01395                   }
01396                }
01397                else {
01398                   OPND_IDX((*the_opnd)) = TOKEN_CONST_TBL_IDX(token);
01399                }
01400                break;
01401    
01402             case Tok_Const_Hollerith :
01403             case Tok_Const_Boolean   :
01404             case Tok_Const_Boz :
01405             case Tok_Const_Int :
01406             case Tok_Const_Real :
01407             case Tok_Const_Dbl :
01408             case Tok_Const_Quad :
01409             case Tok_Const_False :
01410             case Tok_Const_True :
01411    
01412                OPND_IDX((*the_opnd)) = TOKEN_CONST_TBL_IDX(token);
01413                break;
01414          }
01415       }
01416       else if (TOKEN_VALUE(token) == Tok_Unknown) {
01417          parsed_ok = FALSE;
01418          parse_err_flush(Find_Expr_End, parse_operand_insert);
01419       }
01420       else {
01421          parsed_ok = FALSE;
01422          parse_err_flush(Find_Expr_End, NULL);
01423       }
01424    }
01425 #ifdef KEY /* Bug 8004 */
01426    else if (LA_CH_VALUE == LBRKT) {
01427       NEXT_LA_CH;
01428 
01429       do_array_constructor(&parsed_ok, the_opnd);
01430 
01431       if (LA_CH_VALUE == RBRKT) {
01432          NEXT_LA_CH;
01433       }
01434       else {
01435          parse_err_flush(Find_EOS, "]");
01436          parsed_ok = FALSE;
01437       }
01438    }
01439 #endif /* KEY Bug 8004 */
01440    else if (LA_CH_VALUE == LPAREN && matched_specific_token(Tok_Punct_Lbrkt,
01441                                                             Tok_Class_Punct)) {
01442 
01443       do_array_constructor(&parsed_ok, the_opnd);
01444 
01445       if (LA_CH_VALUE == SLASH && matched_specific_token(Tok_Punct_Rbrkt,
01446                                                          Tok_Class_Punct)) {
01447 
01448          /* intentionally blank */
01449       }
01450       else {
01451          parse_err_flush(Find_EOS, "/)");
01452          parsed_ok = FALSE;
01453       }
01454    }
01455    else {
01456       parsed_ok = FALSE;
01457       parse_err_flush(Find_Expr_End, parse_operand_insert);
01458 
01459       if (LA_CH_VALUE == EOS) {
01460          TOKEN_STR_WD(token, 0)   = 0;
01461          TOKEN_VALUE(token)       = Tok_EOS;
01462          TOKEN_KIND_STR(token)[0] = EOS;
01463          TOKEN_KIND_LEN(token)    = 0;
01464          TOKEN_LEN(token)         = 0;
01465          TOKEN_LINE(token)        = LA_CH_LINE;
01466          TOKEN_COLUMN(token)      = LA_CH_COLUMN;
01467       }
01468    }
01469 
01470 EXIT:
01471    TRACE (Func_Exit, "parse_operand", NULL);
01472 
01473    return(parsed_ok);
01474 
01475 }  /* parse_operand */
01476 
01477 /******************************************************************************\
01478 |*                                                                            *|
01479 |* Description:                                                               *|
01480 |*      Parse structure/array dereference on lhs of assignment.               *|
01481 |*                                                                            *|
01482 |* Input parameters:                                                          *|
01483 |*      NONE                                                                  *|
01484 |*                                                                            *|
01485 |* Output parameters:                                                         *|
01486 |*      result_opnd - opnd_type, points to root of tree returned.             *|
01487 |*                                                                            *|
01488 |* Returns:                                                                   *|
01489 |*      TRUE if parsed ok                                                     *|
01490 |*                                                                            *|
01491 \******************************************************************************/
01492 
01493 boolean parse_lhs (opnd_type *result_opnd,
01494                    int        attr_idx)
01495 
01496 {
01497 
01498    int           array_idx;
01499    int           amb_attr_idx;
01500    token_type    attr_name;
01501    int           col;
01502    int           ir_idx;
01503    int           line;
01504    int           list_idx;
01505    int           list2_idx;
01506    int           list3_idx;
01507    opnd_type     opnd = INIT_OPND_TYPE;
01508    boolean       parsed_ok = TRUE;
01509    int           rank;
01510    int           subs_idx = NULL_IDX;
01511    int           substring_idx;
01512    int           trip_idx;
01513 
01514 
01515    TRACE (Func_Entry, "parse_lhs", NULL);
01516 
01517    attr_name = token;
01518 
01519    amb_attr_idx = attr_idx;
01520 
01521    while (AT_ATTR_LINK(amb_attr_idx)) {
01522       amb_attr_idx = AT_ATTR_LINK(amb_attr_idx);
01523    }
01524 
01525    /* if local attr has problem, quit */
01526 
01527    if (AT_DCL_ERR(attr_idx)) {
01528       SH_ERR_FLG(curr_stmt_sh_idx) = TRUE;
01529 
01530       parse_err_flush(Find_Ref_End, NULL);
01531       parsed_ok = FALSE;
01532       goto EXIT;
01533    }
01534 
01535    /* Now lets see what this attr is */
01536 
01537    switch (AT_OBJ_CLASS(amb_attr_idx)) {
01538       case Data_Obj :
01539 
01540          break;
01541 
01542       case Pgm_Unit :
01543          /* must be result var of local or host function, not interface or */
01544          /* other external                                                 */
01545 
01546          if (ATP_PGM_UNIT(amb_attr_idx) == Function  &&
01547              ATP_SCP_ALIVE(amb_attr_idx))            {
01548 
01549             if (ATP_RSLT_NAME(amb_attr_idx)) {
01550 
01551                /* error .. assigned function name not result name */
01552 
01553                PRINTMSG(TOKEN_LINE(token), 299, Error, 
01554                         TOKEN_COLUMN(token));
01555                parse_err_flush(Find_Ref_End, NULL);
01556                parsed_ok = FALSE;
01557                goto EXIT;
01558             }
01559             else {
01560                attr_idx = ATP_RSLT_IDX(amb_attr_idx);
01561                amb_attr_idx = attr_idx;
01562             }
01563          }
01564          else {
01565 
01566             if (AT_NOT_VISIBLE(amb_attr_idx)) {
01567                PRINTMSG(TOKEN_LINE(token), 486, Error, 
01568                         TOKEN_COLUMN(token),
01569                         AT_OBJ_NAME_PTR(amb_attr_idx),
01570                         AT_OBJ_NAME_PTR(AT_MODULE_IDX((amb_attr_idx))));
01571             }
01572             else {  /* can't assign to pgm unit other than current function */
01573                PRINTMSG(TOKEN_LINE(token), 281, Error, 
01574                         TOKEN_COLUMN(token));
01575             }
01576             parsed_ok = FALSE;
01577             parse_err_flush(Find_Ref_End, NULL);
01578             goto EXIT;
01579          }
01580 
01581          break;
01582 
01583       default       :
01584 
01585          if (AT_NOT_VISIBLE(amb_attr_idx)) {
01586             PRINTMSG(TOKEN_LINE(token), 486, Error, 
01587                      TOKEN_COLUMN(token),
01588                      AT_OBJ_NAME_PTR(amb_attr_idx),
01589                      AT_OBJ_NAME_PTR(AT_MODULE_IDX((amb_attr_idx))));
01590          }
01591          else {  /* can't assign this to a program unit */
01592             PRINTMSG(TOKEN_LINE(token), 281, Error, 
01593                      TOKEN_COLUMN(token));
01594          }
01595 
01596          parsed_ok = FALSE;
01597          parse_err_flush(Find_Ref_End, NULL);
01598          goto EXIT;
01599    }
01600 
01601    OPND_FLD((*result_opnd))      = AT_Tbl_Idx;
01602    OPND_IDX((*result_opnd))      = attr_idx;
01603    OPND_LINE_NUM((*result_opnd)) = TOKEN_LINE(token);
01604    OPND_COL_NUM((*result_opnd))  = TOKEN_COLUMN(token);
01605 
01606 # ifdef _F_MINUS_MINUS
01607    if (LA_CH_VALUE != PERCENT && LA_CH_VALUE != LPAREN && 
01608        ((! cmd_line_flags.co_array_fortran) || LA_CH_VALUE != LBRKT))
01609 # else
01610    if (LA_CH_VALUE != PERCENT && LA_CH_VALUE != LPAREN)
01611 # endif
01612                                                        {
01613       goto EXIT;
01614    }
01615 
01616 
01617    if (LA_CH_VALUE == LPAREN) {
01618       /* do that array stuff */
01619       array_idx = ATD_ARRAY_IDX(amb_attr_idx);
01620 
01621       if (array_idx) {
01622 
01623          rank = 0;
01624          NTR_IR_TBL(subs_idx);
01625          IR_FLD_L(subs_idx)            = AT_Tbl_Idx;
01626          IR_IDX_L(subs_idx)            = attr_idx;
01627          IR_LINE_NUM_L(subs_idx)       = TOKEN_LINE(token);
01628          IR_COL_NUM_L(subs_idx)        = TOKEN_COLUMN(token);
01629 
01630          /* LA_CH is '(' */
01631          IR_LINE_NUM(subs_idx)         = LA_CH_LINE;
01632          IR_COL_NUM(subs_idx)          = LA_CH_COLUMN;
01633 
01634          IR_OPR(subs_idx)              = Subscript_Opr;
01635          IR_FLD_R(subs_idx)            = IL_Tbl_Idx;
01636 
01637          list_idx = NULL_IDX;
01638 
01639          do {
01640             NEXT_LA_CH;
01641 
01642             if (list_idx == NULL_IDX) {
01643                NTR_IR_LIST_TBL(list_idx);
01644                IR_IDX_R(subs_idx) = list_idx;
01645             }
01646             else {
01647                NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
01648                IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
01649                list_idx = IL_NEXT_LIST_IDX(list_idx);
01650             }
01651 
01652             if (LA_CH_VALUE != COLON) {
01653                parsed_ok = parse_expr(&opnd) && parsed_ok;
01654                COPY_OPND(IL_OPND(list_idx), opnd);
01655             }
01656 
01657             /* do some text stuff here */
01658 
01659             if (LA_CH_VALUE == COLON) {
01660                NTR_IR_TBL(trip_idx);
01661                IR_LINE_NUM(trip_idx)       = LA_CH_LINE;
01662                IR_COL_NUM(trip_idx)        = LA_CH_COLUMN;
01663 
01664                NEXT_LA_CH;
01665 
01666                IR_OPR(trip_idx)            = Triplet_Opr;
01667                IR_FLD_L(trip_idx)          = IL_Tbl_Idx;
01668                IR_LIST_CNT_L(trip_idx)     = 3;
01669                NTR_IR_LIST_TBL(list2_idx);
01670                IR_IDX_L(trip_idx)          = list2_idx;
01671                IL_OPND(list2_idx)          = IL_OPND(list_idx);
01672                IL_FLD(list_idx)            = IR_Tbl_Idx;
01673                IL_IDX(list_idx)            = trip_idx;
01674                NTR_IR_LIST_TBL(list3_idx);
01675                IL_NEXT_LIST_IDX(list2_idx) = list3_idx;
01676                IL_PREV_LIST_IDX(list3_idx) = list2_idx;
01677 
01678                if (LA_CH_VALUE != COLON && 
01679                    LA_CH_VALUE != COMMA &&
01680                    LA_CH_VALUE != RPAREN) {
01681                   parsed_ok = parse_expr(&opnd) && parsed_ok;
01682                   COPY_OPND(IL_OPND(list3_idx), opnd);
01683                }
01684 
01685                NTR_IR_LIST_TBL(list2_idx);
01686                IL_NEXT_LIST_IDX(list3_idx) = list2_idx;
01687                IL_PREV_LIST_IDX(list2_idx) = list3_idx;
01688 
01689                if (LA_CH_VALUE == COLON) {
01690                   NEXT_LA_CH;
01691                   parsed_ok = parse_expr(&opnd) && parsed_ok;
01692                   COPY_OPND(IL_OPND(list2_idx), opnd);
01693                }
01694             }
01695             rank++;
01696          }
01697          while (LA_CH_VALUE == COMMA);
01698 
01699          if (! matched_specific_token(Tok_Punct_Rparen, Tok_Class_Punct)) {
01700             if (parse_err_flush(Find_Rparen, ")")) {
01701                NEXT_LA_CH;
01702             }
01703             parsed_ok = FALSE;
01704             goto EXIT;
01705          }
01706 
01707          IR_LIST_CNT_R(subs_idx) = rank;
01708 
01709       } /* if (array_idx) */
01710 
01711       /* now check for possible substring reference */
01712 
01713       if (LA_CH_VALUE == LPAREN) {
01714 
01715          if (is_substring_ref ()) {
01716 
01717             if (TYP_TYPE(ATD_TYPE_IDX(amb_attr_idx)) != Character) {
01718 
01719                PRINTMSG(TOKEN_LINE(token), 508, Error, TOKEN_COLUMN(token));
01720                parsed_ok = FALSE;
01721                parse_err_flush(Find_Ref_End, NULL);
01722                goto EXIT;
01723             }
01724 
01725             NTR_IR_TBL(substring_idx);
01726             IR_OPR(substring_idx)             = Substring_Opr;
01727             IR_LINE_NUM(substring_idx)        = LA_CH_LINE;
01728             IR_COL_NUM(substring_idx)         = LA_CH_COLUMN;
01729             OPND_FLD((*result_opnd))          = IR_Tbl_Idx;
01730             OPND_IDX((*result_opnd))          = substring_idx;
01731 
01732             if (subs_idx) {
01733                IR_FLD_L(substring_idx)        = IR_Tbl_Idx;
01734                IR_IDX_L(substring_idx)        = subs_idx;
01735 
01736             }
01737             else {
01738                IR_FLD_L(substring_idx)        = AT_Tbl_Idx;
01739                IR_IDX_L(substring_idx)        = attr_idx;
01740                IR_LINE_NUM_L(substring_idx)   = TOKEN_LINE(token);
01741                IR_COL_NUM_L(substring_idx)    = TOKEN_COLUMN(token);
01742             }
01743 
01744             IR_FLD_R(substring_idx)           = IL_Tbl_Idx;
01745             IR_LIST_CNT_R(substring_idx)      = 2;
01746             NTR_IR_LIST_TBL(list_idx);
01747             NTR_IR_LIST_TBL(list2_idx);
01748             IR_IDX_R(substring_idx)           = list_idx;
01749             IL_NEXT_LIST_IDX(list_idx)        = list2_idx;
01750             IL_PREV_LIST_IDX(list2_idx)       = list_idx;
01751 
01752             /* consume ( */
01753             NEXT_LA_CH;
01754 
01755             if (LA_CH_VALUE != COLON) {
01756                parsed_ok = parse_expr(&opnd) && parsed_ok;
01757                COPY_OPND(IL_OPND(list_idx), opnd); 
01758             }
01759 
01760             if (LA_CH_VALUE != COLON) {
01761                if (parse_err_flush(Find_Rparen, ":")) {
01762                   NEXT_LA_CH;
01763                }
01764                parsed_ok = FALSE;
01765                goto EXIT;
01766             }
01767             else {
01768                NEXT_LA_CH;
01769             }
01770 
01771             if (LA_CH_VALUE != RPAREN) {
01772                parsed_ok = parse_expr(&opnd) && parsed_ok;
01773                COPY_OPND(IL_OPND(list2_idx), opnd); 
01774             }
01775 
01776             if (LA_CH_VALUE != RPAREN) {
01777 
01778                if (parse_err_flush(Find_Rparen, ")")) {
01779                   NEXT_LA_CH;
01780                }
01781                parsed_ok = FALSE;
01782                goto EXIT;
01783             }
01784             else {
01785                NEXT_LA_CH;
01786             }
01787             goto EXIT;
01788          }
01789       }
01790 
01791       if (LA_CH_VALUE != PERCENT) {
01792 
01793          if (subs_idx) {
01794             OPND_FLD((*result_opnd))       = IR_Tbl_Idx;
01795             OPND_IDX((*result_opnd))       = subs_idx;
01796          }
01797          else {
01798 
01799             OPND_FLD((*result_opnd))      = AT_Tbl_Idx;
01800             OPND_IDX((*result_opnd))      = attr_idx;
01801             OPND_LINE_NUM((*result_opnd)) = TOKEN_LINE(attr_name);
01802             OPND_COL_NUM((*result_opnd))  = TOKEN_COLUMN(attr_name);
01803 
01804          }
01805       }
01806    } /* if (LA_CH_VALUE == LPAREN) */
01807 
01808 # ifdef _F_MINUS_MINUS
01809    if (cmd_line_flags.co_array_fortran &&
01810        LA_CH_VALUE == LBRKT &&
01811        AT_OBJ_CLASS(amb_attr_idx) == Data_Obj) {
01812 
01813       if (ATD_PE_ARRAY_IDX(amb_attr_idx) == NULL_IDX) {
01814          /* not declared with pe dimensions */
01815          PRINTMSG(LA_CH_LINE, 1245, Error, LA_CH_COLUMN,
01816                   AT_OBJ_NAME_PTR(amb_attr_idx));
01817          parsed_ok = FALSE;
01818          parse_err_flush(Find_Ref_End, NULL);
01819          goto EXIT;
01820       }
01821 
01822       if (subs_idx == NULL_IDX) {
01823          NTR_IR_TBL(subs_idx);
01824 
01825          /* LA_CH is '[' */
01826          IR_LINE_NUM(subs_idx)         = LA_CH_LINE;
01827          IR_COL_NUM(subs_idx)          = LA_CH_COLUMN;
01828 
01829          IR_OPR(subs_idx)              = Subscript_Opr;
01830          IR_FLD_R(subs_idx)            = IL_Tbl_Idx;
01831          IR_LIST_CNT_R(subs_idx)       = 0;
01832 
01833          if (OPND_FLD((*result_opnd)) == AT_Tbl_Idx) {
01834             COPY_OPND(IR_OPND_L(subs_idx), (*result_opnd));
01835 
01836             /* put subs_idx into result opnd for now */
01837             OPND_FLD((*result_opnd))      = IR_Tbl_Idx;
01838             OPND_IDX((*result_opnd))      = subs_idx;
01839          }
01840          else if (OPND_FLD((*result_opnd)) == IR_Tbl_Idx &&
01841                   IR_OPR(OPND_IDX((*result_opnd))) == Substring_Opr) {
01842 
01843             COPY_OPND(IR_OPND_L(subs_idx), IR_OPND_L(OPND_IDX((*result_opnd))));
01844 
01845             IR_FLD_L(OPND_IDX((*result_opnd))) = IR_Tbl_Idx;
01846             IR_IDX_L(OPND_IDX((*result_opnd))) = subs_idx;
01847          }
01848 # ifdef _DEBUG
01849          else {
01850             PRINTMSG(LA_CH_LINE, 626, Internal, LA_CH_COLUMN,
01851                      "AT_Tbl_Idx", "parse_deref");
01852          }
01853 # endif
01854 
01855          list_idx = NULL_IDX;
01856       }
01857       else {
01858 
01859          list_idx = IR_IDX_R(subs_idx);
01860 
01861          while (IL_NEXT_LIST_IDX(list_idx) != NULL_IDX) {
01862             list_idx = IL_NEXT_LIST_IDX(list_idx);
01863          }
01864       }
01865 
01866       do {
01867          NEXT_LA_CH;
01868 
01869          if (list_idx == NULL_IDX) {
01870             NTR_IR_LIST_TBL(list_idx);
01871             IR_IDX_R(subs_idx) = list_idx;
01872          }
01873          else {
01874             NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
01875             IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
01876             list_idx = IL_NEXT_LIST_IDX(list_idx);
01877          }
01878 
01879          IL_PE_SUBSCRIPT(list_idx) = TRUE;
01880 
01881          if (LA_CH_VALUE != COLON) {
01882             parsed_ok = parse_expr(&opnd) && parsed_ok;
01883             COPY_OPND(IL_OPND(list_idx), opnd);
01884          }
01885 
01886          /* do some text stuff here */
01887 
01888          if (LA_CH_VALUE == COLON) {
01889 
01890             NTR_IR_TBL(trip_idx);
01891             IR_LINE_NUM(trip_idx)       = LA_CH_LINE;
01892             IR_COL_NUM(trip_idx)        = LA_CH_COLUMN;
01893 
01894             NEXT_LA_CH;
01895 
01896             IR_OPR(trip_idx)            = Triplet_Opr;
01897             IR_FLD_L(trip_idx)          = IL_Tbl_Idx;
01898             IR_LIST_CNT_L(trip_idx)     = 3;
01899             NTR_IR_LIST_TBL(list2_idx);
01900             IR_IDX_L(trip_idx)          = list2_idx;
01901             IL_OPND(list2_idx)          = IL_OPND(list_idx);
01902             IL_FLD(list_idx)            = IR_Tbl_Idx;
01903             IL_IDX(list_idx)            = trip_idx;
01904             NTR_IR_LIST_TBL(list3_idx);
01905             IL_NEXT_LIST_IDX(list2_idx) = list3_idx;
01906             IL_PREV_LIST_IDX(list3_idx) = list2_idx;
01907 
01908             if (LA_CH_VALUE != COLON &&
01909                 LA_CH_VALUE != COMMA &&
01910                 LA_CH_VALUE != RBRKT) {
01911                parsed_ok = parse_expr(&opnd) && parsed_ok;
01912                COPY_OPND(IL_OPND(list3_idx), opnd);
01913             }
01914 
01915             NTR_IR_LIST_TBL(list2_idx);
01916             IL_NEXT_LIST_IDX(list3_idx) = list2_idx;
01917             IL_PREV_LIST_IDX(list2_idx) = list3_idx;
01918 
01919             if (LA_CH_VALUE == COLON) {
01920                NEXT_LA_CH;
01921                parsed_ok = parse_expr(&opnd) && parsed_ok;
01922                COPY_OPND(IL_OPND(list2_idx), opnd);
01923             }
01924          }
01925          (IR_LIST_CNT_R(subs_idx))++;
01926       }
01927       while (LA_CH_VALUE == COMMA);
01928 
01929       if (LA_CH_VALUE != RBRKT) {
01930          parse_err_flush(Find_EOS, "]");
01931          parsed_ok = FALSE;
01932          goto EXIT;
01933       }
01934       else {
01935          /* swallow ] */
01936          NEXT_LA_CH;
01937       }
01938    }
01939 # endif
01940 
01941    if (LA_CH_VALUE == PERCENT) {
01942 
01943       /* first see if attr_idx is a structure */
01944 
01945       if (TYP_TYPE(ATD_TYPE_IDX(amb_attr_idx)) != Structure) {
01946 
01947          if (SCP_IMPL_NONE(curr_scp_idx) && !AT_TYPED(amb_attr_idx) &&
01948              !AT_DCL_ERR(amb_attr_idx)) {
01949             AT_DCL_ERR(amb_attr_idx)  = TRUE;
01950             PRINTMSG(TOKEN_LINE(attr_name), 113, Error,
01951                      TOKEN_COLUMN(attr_name),
01952                      TOKEN_STR(attr_name));
01953          }
01954          else {
01955             PRINTMSG(TOKEN_LINE(attr_name), 212, Error,
01956                      TOKEN_COLUMN(attr_name), 
01957                      TOKEN_STR(attr_name),
01958                      get_basic_type_str(ATD_TYPE_IDX(amb_attr_idx)));
01959          }
01960 
01961          parse_err_flush(Find_Ref_End, NULL);
01962          parsed_ok = FALSE;
01963          goto EXIT;
01964       }
01965       line = LA_CH_LINE;
01966       col = LA_CH_COLUMN;
01967       NEXT_LA_CH;
01968 
01969       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
01970          NTR_IR_TBL(ir_idx);
01971          IR_OPR(ir_idx)      = Struct_Opr;
01972          IR_LINE_NUM(ir_idx) = line;
01973          IR_COL_NUM(ir_idx)  = col;
01974 
01975          if (subs_idx) {
01976             IR_FLD_L(ir_idx)            = IR_Tbl_Idx;
01977             IR_IDX_L(ir_idx)            = subs_idx;
01978          }
01979          else {
01980             IR_FLD_L(ir_idx) = AT_Tbl_Idx;
01981             IR_IDX_L(ir_idx) = attr_idx;
01982 
01983             IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(attr_name);
01984             IR_COL_NUM_L(ir_idx)  = TOKEN_COLUMN(attr_name);
01985          }
01986 
01987          OPND_FLD((*result_opnd)) = IR_Tbl_Idx;
01988          OPND_IDX((*result_opnd)) = ir_idx;
01989 
01990          parsed_ok = parse_deref(result_opnd, 
01991                                  TYP_IDX(ATD_TYPE_IDX(amb_attr_idx)));
01992 
01993       }
01994       else {
01995          /* no ID after %, must be an error */
01996          parse_err_flush(Find_Ref_End, "IDENTIFIER");
01997          parsed_ok = FALSE;
01998       }
01999    }
02000 
02001 EXIT:
02002 
02003    if (parsed_ok) {
02004 
02005       if (ATD_CLASS(amb_attr_idx) == Function_Result) {
02006          AT_DEFINED(ATD_FUNC_IDX(amb_attr_idx)) = TRUE;
02007       }
02008       else if (ATD_CLASS(amb_attr_idx) == Atd_Unknown) {
02009          ATD_CLASS(amb_attr_idx)  = Variable;
02010       }
02011 
02012       AT_DEFINED(attr_idx) = TRUE;
02013    }
02014 
02015    TRACE (Func_Exit, "parse_lhs", NULL);
02016 
02017    return(parsed_ok);
02018 
02019 } /* parse_lhs */
osprey/crayf90/fe90/p_asg_expr.c
