p_asg_expr.c

Go to the documentation of this file.

/*

  Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.

  This program is free software; you can redistribute it and/or modify it
  under the terms of version 2 of the GNU General Public License as
  published by the Free Software Foundation.

  This program is distributed in the hope that it would be useful, but
  WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  

  Further, this software is distributed without any warranty that it is
  free of the rightful claim of any third person regarding infringement 
  or the like.  Any license provided herein, whether implied or 
  otherwise, applies only to this software file.  Patent licenses, if 
  any, provided herein do not apply to combinations of this program with 
  other software, or any other product whatsoever.  

  You should have received a copy of the GNU General Public License along
  with this program; if not, write the Free Software Foundation, Inc., 59
  Temple Place - Suite 330, Boston MA 02111-1307, USA.

  Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
  Mountain View, CA 94043, or:

  http://www.sgi.com

  For further information regarding this notice, see:

  http://oss.sgi.com/projects/GenInfo/NoticeExplan

*/



static char USMID[] = "\n@(#)5.0_pl/sources/p_asg_expr.c        5.3     06/17/99 09:28:10\n";

# include "defines.h"           /* Machine dependent ifdefs */

# include "host.m"              /* Host machine dependent macros.*/
# include "host.h"              /* Host machine dependent header.*/
# include "target.m"            /* Target machine dependent macros.*/
# include "target.h"            /* Target machine dependent header.*/

# include "globals.m"
# include "tokens.m"
# include "sytb.m"
# include "p_globals.m"
# include "debug.m"

# include "globals.h"
# include "tokens.h"
# include "sytb.h"
# include "p_globals.h"


/*****************************************************************\
|* function prototypes of static functions declared in this file *|
\*****************************************************************/

boolean parse_level_1 (opnd_type *);
boolean parse_mult_opnd (opnd_type *);
boolean parse_add_opnd (opnd_type *);
boolean parse_level_2 (opnd_type *);
boolean parse_level_3 (opnd_type *);
boolean parse_level_4 (opnd_type *);
boolean parse_and_opnd (opnd_type *);
boolean parse_or_opnd (opnd_type *);
boolean parse_equiv_opnd (opnd_type *);
boolean parse_level_5 (opnd_type *);
boolean parse_lhs (opnd_type *, int);


/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      BRIEF DESCRIPTION OF THIS FUNCTION'S PURPOSE                          *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NONE                                                                  *|
|*                                                                            *|
\******************************************************************************/

void parse_assignment_stmt (void)

{
   int                  attr_idx;
   int                  buf_idx;
   int                  col;
   int                  host_attr_idx;
   int                  host_name_idx;
   int                  ir_idx;
   int                  line;
   int                  name_idx;
   opnd_type            opnd = INIT_OPND_TYPE;
   stmt_category_type   save_curr_stmt_category;
   char                 str[2];
   int                  stmt_num;


   TRACE (Func_Entry, "parse_assignment_stmt", NULL);


   attr_idx = srch_sym_tbl (TOKEN_STR(token), TOKEN_LEN(token), &name_idx);

   if (attr_idx == NULL_IDX) {                   /* search host sym tab */
      host_attr_idx = srch_host_sym_tbl(TOKEN_STR(token), 
                                        TOKEN_LEN(token),
                                        &host_name_idx,
                                        FALSE);

      if (host_attr_idx != NULL_IDX && IS_STMT_ENTITY(host_attr_idx)) {

         /* do not hook up to host stmt entities */
         host_attr_idx = NULL_IDX;
      }

      if (host_attr_idx != NULL_IDX) {

         /* Make entry in local name table for this item.  Make a new attr    */
         /* and attr_link them together.                                      */

         attr_idx = ntr_host_in_sym_tbl(&token, name_idx, host_attr_idx,
                                        host_name_idx, TRUE);
      }
      else {             /* enter attr in local symbol table */
         attr_idx = ntr_sym_tbl(&token, name_idx);
         SET_IMPL_TYPE(attr_idx);
      }
   }

   if (AT_OBJ_CLASS(attr_idx) == Data_Obj) {
      ATD_SEEN_OUTSIDE_IMP_DO(attr_idx) = TRUE;
   }

   if (curr_stmt_category < Executable_Stmt_Cat                  && 
       LA_CH_VALUE             == LPAREN                         &&
       AT_ATTR_LINK(attr_idx)  == NULL_IDX                       && 
       AT_OBJ_CLASS(attr_idx)  == Data_Obj                       &&
       ATD_ARRAY_IDX(attr_idx) == NULL_IDX                       &&
       (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) != Character ||
        ! is_substring_ref())) {

      parse_stmt_func_stmt(attr_idx, name_idx);
      goto EXIT;
   }

   /* The WHERE block is marked as not allowing executables, because the only */
   /* statement allowed in a WHERE block is the assignment statement.  So if  */
   /* CURR_BLK_NO_EXEC is set, have to check that this isn't a WHERE block.   */


   /* Likewise, the FORALL block is marked as not allowing executables,       */
   /* because the only statements allowed in a FORALL construct are:          */
   /*   * assignment statement (including pointer assignment statement)       */
   /*   * WHERE statement or WHERE construct                                  */
   /*   * another FORALL construct or FORALL statement                        */
   /* So if CURR_BLK_NO_EXEC is set, also have to check that this isn't a     */
   /* FORALL block.                                                           */

   if (CURR_BLK_NO_EXEC &&
       CURR_BLK != Where_Else_Blk && 
       CURR_BLK != Where_Then_Blk &&
       CURR_BLK != Where_Else_Mask_Blk && 
       CURR_BLK != Forall_Blk) {

      if (iss_blk_stk_err()) {
         parse_err_flush(Find_EOS, NULL);
         goto EXIT;
      }
   }

   save_curr_stmt_category = curr_stmt_category;
   curr_stmt_category = Executable_Stmt_Cat;
   NTR_IR_TBL(ir_idx);
   SH_IR_IDX(curr_stmt_sh_idx)  = ir_idx;

   if (!parse_lhs(&opnd, attr_idx)) {
      parse_err_flush(Find_EOS, NULL);
      goto EXIT;
   }

   COPY_OPND(IR_OPND_L(ir_idx), opnd);

   IR_LINE_NUM(ir_idx)          = LA_CH_LINE;
   IR_COL_NUM(ir_idx)           = LA_CH_COLUMN;

   line = LA_CH_LINE;
   col  = LA_CH_COLUMN;
   buf_idx = LA_CH_BUF_IDX;
   stmt_num = LA_CH_STMT_NUM;

   if (LA_CH_VALUE == EOS) {
      PRINTMSG(line, 724, Error, col, EOS_STR);
      curr_stmt_category = save_curr_stmt_category;
   }
   else if (MATCHED_TOKEN_CLASS(Tok_Class_Punct) &&
            (TOKEN_VALUE(token) == Tok_Punct_Eq ||
             TOKEN_VALUE(token) == Tok_Punct_Rename)) {
      IR_OPR(ir_idx) = (TOKEN_VALUE(token) == Tok_Punct_Eq) ? Asg_Opr :
                                                              Ptr_Asg_Opr;
      parse_expr(&opnd);
      COPY_OPND(IR_OPND_R(ir_idx), opnd);
   }
   else {
      reset_lex(buf_idx, stmt_num);
      str[0] = LA_CH_VALUE;
      str[1] = '\0';
      PRINTMSG(line, 724, Error, col, str);
      parse_err_flush(Find_EOS, NULL);
      curr_stmt_category = save_curr_stmt_category;
   }

   if (LA_CH_VALUE != EOS) {
      parse_err_flush(Find_EOS, "operator or " EOS_STR);
   }

EXIT:

   NEXT_LA_CH;

   TRACE (Func_Exit, "parse_assignment_stmt", NULL);

   return;

}  /* parse_assignment_stmt */


/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      BNF     level-5-expr { defined-binary-op level-5-expr }               *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*                                                                            *|
\******************************************************************************/

boolean parse_expr (opnd_type   *result)

{
   int       attr_idx;
   int       host_attr_idx;
   int       host_name_idx;
   int       ir_idx;
   int       list1_idx;
   int       list2_idx;
   int       name_idx;
   opnd_type opnd = INIT_OPND_TYPE;
   boolean   parsed_ok = TRUE;

   TRACE (Func_Entry, "parse_expr", NULL);


   parsed_ok = parse_level_5(&opnd);

   while (TOKEN_VALUE(token) == Tok_Op_Defined) {

      NTR_IR_TBL(ir_idx);
      IR_OPR(ir_idx)      = Defined_Bin_Opr;

      attr_idx = srch_sym_tbl (TOKEN_STR(token), TOKEN_LEN(token), &name_idx);
      host_attr_idx = attr_idx;
      
      if (attr_idx == NULL_IDX) {
         host_attr_idx = srch_host_sym_tbl(TOKEN_STR(token), 
                                           TOKEN_LEN(token),
                                           &host_name_idx,
                                           TRUE);

         if (host_attr_idx) {
            attr_idx = ntr_host_in_sym_tbl(&token,
                                           name_idx,
                                           host_attr_idx,
                                           host_name_idx,
                                           TRUE);

            attr_idx = host_attr_idx;
         }
      }
      else if (AT_ATTR_LINK(attr_idx)) {
         host_attr_idx = AT_ATTR_LINK(attr_idx);
         while (AT_ATTR_LINK(host_attr_idx)) {
            host_attr_idx = AT_ATTR_LINK(attr_idx);
         }
      }

      if (attr_idx == NULL_IDX || AT_OBJ_CLASS(host_attr_idx) != Interface) {

         /* error .. no defined opr */

         PRINTMSG(TOKEN_LINE(token), 318, Error, TOKEN_COLUMN(token),
                  TOKEN_STR(token));
         parsed_ok = FALSE;
      }
      else if (AT_NOT_VISIBLE(host_attr_idx)) {
         PRINTMSG(TOKEN_LINE(token), 486, Error,
                  TOKEN_COLUMN(token),
                  AT_OBJ_NAME_PTR(host_attr_idx),
                  AT_OBJ_NAME_PTR(AT_MODULE_IDX((host_attr_idx))));
         parsed_ok = FALSE;
      }
     
      IR_FLD_L(ir_idx)   = AT_Tbl_Idx;
      IR_IDX_L(ir_idx)   = attr_idx;
         
      IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token);
      IR_COL_NUM_L(ir_idx)  = TOKEN_COLUMN(token);
      IR_LINE_NUM(ir_idx)   = TOKEN_LINE(token);
      IR_COL_NUM(ir_idx)    = TOKEN_COLUMN(token);


      NTR_IR_LIST_TBL(list1_idx);
      NTR_IR_LIST_TBL(list2_idx);
      IR_FLD_R(ir_idx)            = IL_Tbl_Idx;
      IR_LIST_CNT_R(ir_idx)       = 2;
      IR_IDX_R(ir_idx)            = list1_idx;
      IL_NEXT_LIST_IDX(list1_idx) = list2_idx;
      IL_PREV_LIST_IDX(list2_idx) = list1_idx;

      COPY_OPND(IL_OPND(list1_idx), opnd);
   
      parsed_ok = parse_level_5(&opnd) && parsed_ok; 

      COPY_OPND(IL_OPND(list2_idx), opnd);

      OPND_FLD(opnd) = IR_Tbl_Idx;
      OPND_IDX(opnd) = ir_idx;
   }

   COPY_OPND((*result), opnd)

   TRACE (Func_Exit, "parse_expr", NULL);

   return(parsed_ok);
} /* parse_expr */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      BNF     [defined_unary_op] primary                                    *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

boolean parse_level_1(opnd_type *result)

{
   int       attr_idx;
   int       def_idx = NULL_IDX;
   int       host_attr_idx;
   int       host_name_idx;
   int       name_idx;
   opnd_type opnd = INIT_OPND_TYPE;
   boolean   parsed_ok = TRUE;

   TRACE (Func_Entry, "parse_level_1", NULL);

   if (LA_CH_VALUE == DOT && matched_specific_token(Tok_Op_Defined, 
                                                    Tok_Class_Op)) {
      /* have defined_unary_op */

      NTR_IR_TBL(def_idx);
      IR_OPR(def_idx) = Defined_Un_Opr;
      attr_idx = srch_sym_tbl (TOKEN_STR(token), TOKEN_LEN(token), &name_idx);
      host_attr_idx = attr_idx;

      if (attr_idx == NULL_IDX) {
         host_attr_idx = srch_host_sym_tbl(TOKEN_STR(token), 
                                           TOKEN_LEN(token),
                                           &host_name_idx,
                                           TRUE);

         if (host_attr_idx) {
            attr_idx = ntr_host_in_sym_tbl(&token,
                                           name_idx,
                                           host_attr_idx,
                                           host_name_idx,
                                           TRUE);

            attr_idx = host_attr_idx;
         }
      }
      else if (AT_ATTR_LINK(attr_idx)) {
         host_attr_idx = AT_ATTR_LINK(attr_idx);
         while (AT_ATTR_LINK(host_attr_idx)) {
            host_attr_idx = AT_ATTR_LINK(attr_idx);
         }
      }

      if (attr_idx == NULL_IDX || AT_OBJ_CLASS(host_attr_idx) != Interface) {

         /* error .. no defined opr */

         PRINTMSG(TOKEN_LINE(token), 318, Error, TOKEN_COLUMN(token),
                  TOKEN_STR(token));
         parsed_ok = FALSE;
      }
      else if (AT_NOT_VISIBLE(host_attr_idx)) {
         PRINTMSG(TOKEN_LINE(token), 486, Error,
                  TOKEN_COLUMN(token),
                  AT_OBJ_NAME_PTR(host_attr_idx),
                  AT_OBJ_NAME_PTR(AT_MODULE_IDX((host_attr_idx))));
         parsed_ok = FALSE;
      }
      else {

         IR_FLD_L(def_idx)   = AT_Tbl_Idx;
         IR_IDX_L(def_idx)   = attr_idx;

         IR_LINE_NUM_L(def_idx) = TOKEN_LINE(token);
         IR_COL_NUM_L(def_idx)  = TOKEN_COLUMN(token);
         IR_LINE_NUM(def_idx)   = TOKEN_LINE(token);
         IR_COL_NUM(def_idx)    = TOKEN_COLUMN(token);
      }
   }

   parsed_ok = parse_operand(&opnd) && parsed_ok;

   if (def_idx) {
      COPY_OPND(IR_OPND_R(def_idx), opnd)
      OPND_FLD((*result)) = IR_Tbl_Idx;
      OPND_IDX((*result)) = def_idx;
   }
   else {
      COPY_OPND((*result), opnd)
   }
   TRACE (Func_Exit, "parse_level_1", NULL);

   return(parsed_ok);
} /* parse_level_1 */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      BNF     level-1-expr [** mult_opnd]                                   *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

boolean parse_mult_opnd(opnd_type *result)

{
   int       ir_idx;
   opnd_type opnd = INIT_OPND_TYPE;
   boolean   parsed_ok = TRUE;


   TRACE (Func_Entry, "parse_mult_opnd", NULL);

   parsed_ok = parse_level_1(&opnd);

   if (MATCHED_TOKEN_CLASS(Tok_Class_Op)) {

      if (TOKEN_VALUE(token) == Tok_Op_Power) {

         NTR_IR_TBL(ir_idx);
         IR_OPR(ir_idx)      = Power_Opr;
         IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
         IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);

         COPY_OPND(IR_OPND_L(ir_idx), opnd)

         parsed_ok = parse_mult_opnd(&opnd) && parsed_ok;

         COPY_OPND(IR_OPND_R(ir_idx), opnd)

         OPND_FLD((*result)) = IR_Tbl_Idx;
         OPND_IDX((*result)) = ir_idx;
      }
      else if (TOKEN_VALUE(token) == Tok_Const_True ||
               TOKEN_VALUE(token) == Tok_Const_False) {
      
         PRINTMSG(TOKEN_LINE(token), 197, Error, TOKEN_COLUMN(token),
                  "operator", "logical literal constant");
         parse_err_flush(Find_Expr_End, NULL);
         parsed_ok = FALSE;
      }
      else if (TOKEN_VALUE(token) == Tok_Op_Assign      ||
               TOKEN_VALUE(token) == Tok_Op_Deref       ||
               TOKEN_VALUE(token) == Tok_Op_Ptr_Assign  ||
               TOKEN_VALUE(token) == Tok_Op_Not)        {

         reset_lex(TOKEN_BUF_IDX(token), TOKEN_STMT_NUM(token));
         COPY_OPND((*result),opnd);
      }
      else {
         COPY_OPND((*result),opnd);
      }
   }
   else {
      COPY_OPND((*result),opnd);
   }

   TRACE (Func_Exit, "parse_mult_opnd", NULL);

   return(parsed_ok);
} /* parse_mult_opnd */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      BNF     mult_opnd {mult-op mult_opnd}                                 *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

boolean parse_add_opnd(opnd_type *result)

{
   int       ir_idx;
   opnd_type opnd = INIT_OPND_TYPE;
   boolean   parsed_ok = TRUE;

   TRACE (Func_Entry, "parse_add_opnd", NULL);

   parsed_ok = parse_mult_opnd(&opnd);

   while (TOKEN_VALUE(token) == Tok_Op_Mult || 
          TOKEN_VALUE(token) == Tok_Op_Div) {

      NTR_IR_TBL(ir_idx);
      switch (TOKEN_VALUE(token)) {
         case Tok_Op_Mult :
            IR_OPR(ir_idx) = Mult_Opr;
            break;
         case Tok_Op_Div  :
            IR_OPR(ir_idx) = Div_Opr;
      }
      IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
      IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);

      COPY_OPND(IR_OPND_L(ir_idx), opnd);
      
      parsed_ok = parse_mult_opnd(&opnd) && parsed_ok;

      COPY_OPND(IR_OPND_R(ir_idx), opnd);

      OPND_FLD(opnd) = IR_Tbl_Idx;
      OPND_IDX(opnd) = ir_idx;
   }

   COPY_OPND((*result), opnd)

   TRACE (Func_Exit, "parse_add_opnd", NULL);

   return(parsed_ok);
} /* parse_add_opnd */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      BNF     [add-op] add-opnd {add-op add-opnd}                           *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

boolean parse_level_2(opnd_type *result)

{
   int       ir_idx = NULL_IDX;
   opnd_type opnd = INIT_OPND_TYPE;
   boolean   parsed_ok = TRUE;

   TRACE (Func_Entry, "parse_level_2", NULL);

   if (LA_CH_VALUE == PLUS || LA_CH_VALUE == MINUS) {
      NTR_IR_TBL(ir_idx);
      switch (LA_CH_VALUE) {
         case PLUS  :
            IR_OPR(ir_idx) = Uplus_Opr;
            break;
         case MINUS :
            IR_OPR(ir_idx) = Uminus_Opr;
      }
      IR_LINE_NUM(ir_idx) = LA_CH_LINE;
      IR_COL_NUM(ir_idx)  = LA_CH_COLUMN;
      NEXT_LA_CH;
   }

   parsed_ok = parse_add_opnd(&opnd);
   
   if (ir_idx) {
      COPY_OPND(IR_OPND_L(ir_idx), opnd);
      OPND_FLD(opnd) = IR_Tbl_Idx;
      OPND_IDX(opnd) = ir_idx;
   }

   while (TOKEN_VALUE(token) == Tok_Op_Add ||
          TOKEN_VALUE(token) == Tok_Op_Sub) {

      NTR_IR_TBL(ir_idx);
      switch (TOKEN_VALUE(token)) {
         case Tok_Op_Add :
            IR_OPR(ir_idx) = Plus_Opr;
            break;
         case Tok_Op_Sub :
            IR_OPR(ir_idx) = Minus_Opr;
      }
      IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
      IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);

      COPY_OPND(IR_OPND_L(ir_idx), opnd);

      parsed_ok = parse_add_opnd(&opnd) && parsed_ok;

      COPY_OPND(IR_OPND_R(ir_idx), opnd);

      OPND_FLD(opnd) = IR_Tbl_Idx;
      OPND_IDX(opnd) = ir_idx;
   }

   COPY_OPND((*result), opnd)

   TRACE (Func_Exit, "parse_level_2", NULL);

   return(parsed_ok);
} /* parse_level_2 */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      BNF     level-2-expr { // level-2-expr }                              *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

boolean parse_level_3(opnd_type *result)

{
   int       ir_idx;
   opnd_type opnd = INIT_OPND_TYPE;
   boolean   parsed_ok = TRUE;

   TRACE (Func_Entry, "parse_level_3", NULL);

   parsed_ok = parse_level_2(&opnd);

   while (TOKEN_VALUE(token) == Tok_Op_Concat) {
   
      NTR_IR_TBL(ir_idx);
      IR_OPR(ir_idx)      = Concat_Opr;
      IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
      IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);

      COPY_OPND(IR_OPND_L(ir_idx), opnd);
      
      parsed_ok = parse_level_2(&opnd) && parsed_ok;

      COPY_OPND(IR_OPND_R(ir_idx), opnd);

      OPND_FLD(opnd) = IR_Tbl_Idx;
      OPND_IDX(opnd) = ir_idx;
   }

   COPY_OPND((*result), opnd)

   TRACE (Func_Exit, "parse_level_3", NULL);

   return(parsed_ok);
} /* parse_level_3 */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      BNF     [level-3-expr rel-op] level-3-expr                            *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

boolean parse_level_4(opnd_type *result)

{
   int       ir_idx;
   opnd_type opnd = INIT_OPND_TYPE;
   boolean   parsed_ok = TRUE;

   TRACE (Func_Entry, "parse_level_4", NULL);

   parsed_ok = parse_level_3(&opnd);

   if (TOKEN_VALUE(token) == Tok_Op_Eq ||
       TOKEN_VALUE(token) == Tok_Op_Ne ||
       TOKEN_VALUE(token) == Tok_Op_Ge ||
       TOKEN_VALUE(token) == Tok_Op_Gt ||
       TOKEN_VALUE(token) == Tok_Op_Le ||
       TOKEN_VALUE(token) == Tok_Op_Lt ||
       TOKEN_VALUE(token) == Tok_Op_Lg) {

      NTR_IR_TBL(ir_idx);
      switch (TOKEN_VALUE(token)) {
         case Tok_Op_Eq :
            IR_OPR(ir_idx) = Eq_Opr;
            break;
         case Tok_Op_Ne :
            IR_OPR(ir_idx) = Ne_Opr;
            break;
         case Tok_Op_Ge :
            IR_OPR(ir_idx) = Ge_Opr;
            break;
         case Tok_Op_Gt :
            IR_OPR(ir_idx) = Gt_Opr;
            break;
         case Tok_Op_Le :
            IR_OPR(ir_idx) = Le_Opr;
            break;
         case Tok_Op_Lt :
            IR_OPR(ir_idx) = Lt_Opr;
            break;
         case Tok_Op_Lg :
            IR_OPR(ir_idx) = Lg_Opr;
            PRINTMSG(TOKEN_LINE(token), 1243, Ansi, TOKEN_COLUMN(token));
            break;
      }
      IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
      IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);

      COPY_OPND(IR_OPND_L(ir_idx), opnd);

      parsed_ok = parse_level_3(&opnd) && parsed_ok;

      COPY_OPND(IR_OPND_R(ir_idx), opnd);

      OPND_FLD(opnd) = IR_Tbl_Idx;
      OPND_IDX(opnd) = ir_idx;
   }

   COPY_OPND((*result), opnd)

   TRACE (Func_Exit, "parse_level_4", NULL);

   return(parsed_ok);
} /* parse_level_4 */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      BNF     [not-op] level-4-expr                                         *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

boolean parse_and_opnd(opnd_type *result)

{
   int       buf_idx;
   int       i;
   int       ir_idx = NULL_IDX;
   char      op[8];
   opnd_type opnd = INIT_OPND_TYPE;
   boolean   parsed_ok = TRUE;
   int       stmt_num;


   TRACE (Func_Entry, "parse_and_opnd", NULL);

   if (LA_CH_VALUE == DOT) {
      buf_idx = LA_CH_BUF_IDX;
      stmt_num = LA_CH_STMT_NUM;

      NEXT_LA_CH;

      for (i = 0; i < 4; i++) {
         op[i] = LA_CH_VALUE;

         if (LA_CH_VALUE == DOT ||
             LA_CH_VALUE == EOS) {
            break;
         }
         NEXT_LA_CH;
      }

      reset_lex(buf_idx, stmt_num);

      if (((i == 1 && strncmp(op, "N.", 2) == 0)    ||
           (i == 3 && strncmp(op, "NOT.", 4) == 0))    &&
          matched_specific_token(Tok_Op_Not, Tok_Class_Op)) {

         NTR_IR_TBL(ir_idx);
         OPND_FLD((*result)) = IR_Tbl_Idx;
         OPND_IDX((*result)) = ir_idx;
         IR_OPR(ir_idx)      = Not_Opr;
         IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
         IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);
      }
   }

   parsed_ok = parse_level_4(&opnd);

   if (ir_idx) {
      COPY_OPND(IR_OPND_L(ir_idx), opnd);
   }
   else {
      COPY_OPND((*result), opnd);
   }

   TRACE (Func_Exit, "parse_and_opnd", NULL);

   return(parsed_ok);
} /* parse_and_opnd */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      BNF     and_opnd { and_op and_opnd }                                  *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

boolean parse_or_opnd(opnd_type *result)

{
   int       ir_idx;
   opnd_type opnd = INIT_OPND_TYPE;
   boolean   parsed_ok = TRUE;

   TRACE (Func_Entry, "parse_or_opnd", NULL);

   parsed_ok = parse_and_opnd(&opnd);

   while (TOKEN_VALUE(token) == Tok_Op_And) {

      NTR_IR_TBL(ir_idx);
      IR_OPR(ir_idx)      = And_Opr;
      IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
      IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);

      COPY_OPND(IR_OPND_L(ir_idx), opnd)
  
      parsed_ok = parse_and_opnd(&opnd) && parsed_ok;

      COPY_OPND(IR_OPND_R(ir_idx), opnd)

      OPND_FLD(opnd) = IR_Tbl_Idx;
      OPND_IDX(opnd) = ir_idx;
   }

   COPY_OPND((*result), opnd)

   TRACE (Func_Exit, "parse_or_opnd", NULL);

   return(parsed_ok);
} /* parse_or_opnd */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      BNF     or_opnd { or_op or_opnd }                                     *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

boolean parse_equiv_opnd(opnd_type *result)

{
   int       ir_idx;
   opnd_type opnd = INIT_OPND_TYPE;
   boolean   parsed_ok = TRUE;

   TRACE (Func_Entry, "parse_equiv_opnd", NULL);

   parsed_ok = parse_or_opnd(&opnd);

   while (TOKEN_VALUE(token) == Tok_Op_Or) {
      
      NTR_IR_TBL(ir_idx);
      IR_OPR(ir_idx)      = Or_Opr;
      IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
      IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);

      COPY_OPND(IR_OPND_L(ir_idx), opnd)

      parsed_ok = parse_or_opnd(&opnd) && parsed_ok;

      COPY_OPND(IR_OPND_R(ir_idx), opnd)

      OPND_FLD(opnd) = IR_Tbl_Idx;
      OPND_IDX(opnd) = ir_idx;
   }

   COPY_OPND((*result), opnd)

   TRACE (Func_Exit, "parse_equiv_opnd", NULL);

   return(parsed_ok);
} /* parse_equiv_opnd */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      BNF     equiv-opnd { equiv-op equiv-opnd }                            *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

boolean parse_level_5(opnd_type *result)

{
   int       ir_idx;
   opnd_type opnd = INIT_OPND_TYPE;
   boolean   parsed_ok = TRUE;

   TRACE (Func_Entry, "parse_level_5", NULL);

   parsed_ok = parse_equiv_opnd(&opnd);

   while (TOKEN_VALUE(token) == Tok_Op_Eqv   ||
          TOKEN_VALUE(token) == Tok_Op_Neqv) {
      
      NTR_IR_TBL(ir_idx);
      switch (TOKEN_VALUE(token)) {
         case Tok_Op_Eqv  :
            IR_OPR(ir_idx) = Eqv_Opr;
            break;
         case Tok_Op_Neqv :
            IR_OPR(ir_idx) = Neqv_Opr;
      }
      IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
      IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);

      COPY_OPND(IR_OPND_L(ir_idx), opnd)

      parsed_ok = parse_equiv_opnd(&opnd) && parsed_ok; 

      COPY_OPND(IR_OPND_R(ir_idx), opnd)

      OPND_FLD(opnd) = IR_Tbl_Idx;
      OPND_IDX(opnd) = ir_idx;
   }

   COPY_OPND((*result), opnd)

   TRACE (Func_Exit, "parse_level_5", NULL);

   return(parsed_ok);
} /* parse_level_5 */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      <description>                                                         *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
boolean parse_operand (opnd_type *the_opnd)

{
   opnd_type            cmplx_opnd      = INIT_OPND_TYPE;
   int                  cmplx_lin_type;
   int                  cmplx_dcl_val;
   int                  cmplx_desc;
   int                  col;
   int                  cx_l            = NULL_IDX;
   int                  cx_r            = NULL_IDX;
   long_type            constant[MAX_WORDS_FOR_NUMERIC];
   expr_arg_type        exp_desc;
   int                  ir_idx;
   int                  line;
   int                  list_idx;
   int                  list2_idx;
   opnd_type            opnd            = INIT_OPND_TYPE;
   boolean              parsed_ok       = TRUE;
   boolean              save_in_constructor;
   int                  type_idx;
   int                  type_l;
   int                  type_r;


   TRACE (Func_Entry, "parse_operand", NULL);

   if (LA_CH_VALUE == LPAREN && matched_specific_token(Tok_Punct_Lparen,
                                                       Tok_Class_Punct)) {

      line = TOKEN_LINE(token);
      col  = TOKEN_COLUMN(token);

      if (!parse_expr(the_opnd)) {
         parsed_ok = FALSE;
      }
      else if (LA_CH_VALUE == RPAREN) {
         /* insert paren_opr */
         NTR_IR_TBL(ir_idx);
         IR_OPR(ir_idx) = Paren_Opr;
         COPY_OPND(IR_OPND_L(ir_idx), (*the_opnd));
         OPND_FLD((*the_opnd)) = IR_Tbl_Idx;
         OPND_IDX((*the_opnd)) = ir_idx;
         IR_LINE_NUM(ir_idx)   = line;
         IR_COL_NUM(ir_idx)    = col;
         
         NEXT_LA_CH;
         goto EXIT;
      }
      /* Assume complex constant - Try to fold */
      else if (OPND_FLD((*the_opnd)) == CN_Tbl_Idx) {
         cx_l = OPND_IDX((*the_opnd));
      }
      else if (OPND_FLD((*the_opnd))               == AT_Tbl_Idx &&
               AT_OBJ_CLASS(OPND_IDX((*the_opnd))) == Data_Obj   &&
               ATD_CLASS(OPND_IDX((*the_opnd)))    == Constant   &&
               ATD_FLD(OPND_IDX((*the_opnd)))      == CN_Tbl_Idx) {

         cx_l = ATD_CONST_IDX(OPND_IDX((*the_opnd)));
      }
      else if (OPND_FLD((*the_opnd))               == IR_Tbl_Idx  &&
               (IR_OPR(OPND_IDX((*the_opnd)))      == Uplus_Opr ||
                IR_OPR(OPND_IDX((*the_opnd)))      == Uminus_Opr) &&
               (IR_FLD_L(OPND_IDX((*the_opnd)))    == CN_Tbl_Idx ||
                (IR_FLD_L(OPND_IDX((*the_opnd)))    == AT_Tbl_Idx &&
                 AT_OBJ_CLASS(IR_IDX_L(OPND_IDX((*the_opnd)))) == Data_Obj &&
                 ATD_CLASS(IR_IDX_L(OPND_IDX((*the_opnd))))    == Constant &&
                 ATD_FLD(IR_IDX_L(OPND_IDX((*the_opnd)))) == CN_Tbl_Idx))) {

         exp_desc.rank = 0;
         xref_state    = CIF_No_Usage_Rec;
         comp_gen_expr = TRUE;
         parsed_ok = expr_semantics(the_opnd, &exp_desc);
         comp_gen_expr = FALSE;

         if (OPND_FLD((*the_opnd)) == CN_Tbl_Idx) {
            cx_l = OPND_IDX((*the_opnd));
         }
      }

      if (cx_l                            &&
          (TYP_TYPE(CN_TYPE_IDX(cx_l)) == Real ||
           TYP_TYPE(CN_TYPE_IDX(cx_l)) == Integer) &&
          LA_CH_VALUE == COMMA                             ) {  
         /* Have complex const */
         NEXT_LA_CH;
            
         if (!parse_expr(&cmplx_opnd)) {
            parsed_ok = FALSE;
         }
         else {

            if (OPND_FLD(cmplx_opnd) == CN_Tbl_Idx) {
               cx_r = OPND_IDX(cmplx_opnd);
            }
            else if (OPND_FLD(cmplx_opnd)               == AT_Tbl_Idx &&
                     AT_OBJ_CLASS(OPND_IDX(cmplx_opnd)) == Data_Obj   &&
                     ATD_CLASS(OPND_IDX(cmplx_opnd))    == Constant   &&
                     ATD_FLD(OPND_IDX(cmplx_opnd))      == CN_Tbl_Idx) {

               cx_r = ATD_CONST_IDX(OPND_IDX(cmplx_opnd));
            }
            else if (OPND_FLD(cmplx_opnd)               == IR_Tbl_Idx  &&
                     (IR_OPR(OPND_IDX(cmplx_opnd))      == Uplus_Opr ||
                      IR_OPR(OPND_IDX(cmplx_opnd))      == Uminus_Opr) &&
                     (IR_FLD_L(OPND_IDX(cmplx_opnd))    == CN_Tbl_Idx ||
                      (IR_FLD_L(OPND_IDX(cmplx_opnd))    == AT_Tbl_Idx &&
                       AT_OBJ_CLASS(IR_IDX_L(OPND_IDX(cmplx_opnd)))==Data_Obj &&
                       ATD_CLASS(IR_IDX_L(OPND_IDX(cmplx_opnd))) == Constant &&
                       ATD_FLD(IR_IDX_L(OPND_IDX(cmplx_opnd))) == CN_Tbl_Idx))){

               exp_desc.rank = 0;
               xref_state    = CIF_No_Usage_Rec;
               comp_gen_expr = TRUE;
               parsed_ok = expr_semantics(&cmplx_opnd, &exp_desc);
               comp_gen_expr = FALSE;
      
               if (OPND_FLD(cmplx_opnd) == CN_Tbl_Idx) {
                  cx_r = OPND_IDX(cmplx_opnd);
               }
            }


            if (cx_r                               &&
                (TYP_TYPE(CN_TYPE_IDX(cx_r)) == Real ||
                 TYP_TYPE(CN_TYPE_IDX(cx_r)) == Integer)) {
               type_r = CN_TYPE_IDX(cx_r);
               type_l = CN_TYPE_IDX(cx_l);
           
               if (TYP_TYPE(type_l) == Real && 
                   TYP_TYPE(type_r) == Real) {

                  if (TYP_LINEAR(type_l) > TYP_LINEAR(type_r)) {
                     cmplx_lin_type = TYP_LINEAR(type_l);
                     cmplx_dcl_val  = TYP_DCL_VALUE(type_l);
                     cmplx_desc     = TYP_DESC(type_l);
                  }
                  else {
                     cmplx_lin_type = TYP_LINEAR(type_r);
                     cmplx_dcl_val  = TYP_DCL_VALUE(type_r);
                     cmplx_desc     = TYP_DESC(type_r);
                  }
               }
               else if (TYP_TYPE(type_l) == Real     && 
                        TYP_TYPE(type_r) == Integer) {
                  cmplx_lin_type = TYP_LINEAR(type_l);
                  cmplx_dcl_val  = TYP_DCL_VALUE(type_l);
                  cmplx_desc     = TYP_DESC(type_l);

               }
               else if (TYP_TYPE(type_l) == Integer && 
                        TYP_TYPE(type_r) == Real)   {
                  cmplx_lin_type = TYP_LINEAR(type_r);
                  cmplx_dcl_val  = TYP_DCL_VALUE(type_r);
                  cmplx_desc     = TYP_DESC(type_r);

               } 
               else { /* both integer */
                  cmplx_lin_type = REAL_DEFAULT_TYPE;
                  cmplx_dcl_val  = 0;
                  cmplx_desc     = 0;
               }

               type_idx = cmplx_lin_type;
               parsed_ok = folder_driver((char *)&CN_CONST(cx_l),
                                         type_l,
                                         NULL,
                                         NULL_IDX,
                                         constant,
                                         &type_idx,
                                          line,
                                          col,
                                          1,
                                          Cvrt_Opr) && parsed_ok;

               type_idx = cmplx_lin_type;
               parsed_ok = folder_driver((char *)&CN_CONST(cx_r),
                                         type_r,
                                         NULL,
                                         NULL_IDX,
                                    &(constant[num_host_wds[cmplx_lin_type]]),
                                         &type_idx,
                                          line,
                                          col,
                                          1,
                                          Cvrt_Opr) && parsed_ok;

               switch(cmplx_lin_type) {
                  case Real_4 :
                     cmplx_lin_type = Complex_4;
# if defined(_WHIRL_HOST64_TARGET64)
                     {
                       float *p = (float*)(&constant);
                       p[1] = p[2];
                     }
# endif
                     break;

                  case Real_8 :
                     cmplx_lin_type = Complex_8;
                     break;

                  case Real_16 :
                     cmplx_lin_type = Complex_16;
                     break;

               }

               OPND_FLD((*the_opnd)) = CN_Tbl_Idx;

               CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
               TYP_TYPE(TYP_WORK_IDX)   = Complex;
               TYP_LINEAR(TYP_WORK_IDX) = (linear_type_type) cmplx_lin_type;
               TYP_DCL_VALUE(TYP_WORK_IDX)      = cmplx_dcl_val;
               TYP_DESC(TYP_WORK_IDX)           = (type_desc_type) cmplx_desc;
               type_idx                         = ntr_type_tbl();

               OPND_IDX((*the_opnd)) = ntr_const_tbl(type_idx, 
                                                     FALSE,
                                                     constant);
            }
            else {
               parse_err_flush(Find_Rparen, "CONSTANT");
               parsed_ok = FALSE;
            }
         }
      }

      if (LA_CH_VALUE == RPAREN) {
         NEXT_LA_CH;
      }
      else if (parse_err_flush(Find_Rparen, ")")) {
         NEXT_LA_CH;
         parsed_ok = FALSE;
      }
      else {
         parsed_ok = FALSE;
      }
      goto EXIT;
   }
   else if (LA_CH_CLASS == Ch_Class_Digit  ||
            LA_CH_CLASS == Ch_Class_Letter ||
            LA_CH_VALUE == DOT             ||
            LA_CH_VALUE == QUOTE           ||
            LA_CH_VALUE == DBL_QUOTE)      {

      if (MATCHED_TOKEN_CLASS(Tok_Class_Opnd)) {
         OPND_LINE_NUM((*the_opnd)) = TOKEN_LINE(token);
         OPND_COL_NUM((*the_opnd))  = TOKEN_COLUMN(token);
         OPND_FLD((*the_opnd))      = CN_Tbl_Idx;

         switch (TOKEN_VALUE(token)) {

            case Tok_Id :

            if (! parse_deref(the_opnd, NULL_IDX)) {
               parsed_ok = FALSE;
            }
            break;

            case Tok_Const_Char :
            
               if (LA_CH_VALUE == LPAREN && is_substring_ref ()) {
                  NTR_IR_TBL(ir_idx);
                  IR_OPR(ir_idx)              = Substring_Opr;
                  IR_LINE_NUM(ir_idx)         = LA_CH_LINE;
                  IR_COL_NUM(ir_idx)          = LA_CH_COLUMN;
                  OPND_FLD((*the_opnd))       = IR_Tbl_Idx;
                  OPND_IDX((*the_opnd))       = ir_idx;
                  IR_FLD_L(ir_idx)            = CN_Tbl_Idx;
                  IR_IDX_L(ir_idx)            = TOKEN_CONST_TBL_IDX(token);
                  IR_LINE_NUM_L(ir_idx)       = TOKEN_LINE(token);
                  IR_COL_NUM_L(ir_idx)        = TOKEN_COLUMN(token);
   
                  IR_FLD_R(ir_idx)            = IL_Tbl_Idx;
                  IR_LIST_CNT_R(ir_idx)       = 2;
                  NTR_IR_LIST_TBL(list_idx);
                  NTR_IR_LIST_TBL(list2_idx);
                  IR_IDX_R(ir_idx)            = list_idx;
                  IL_NEXT_LIST_IDX(list_idx)  = list2_idx;
                  IL_PREV_LIST_IDX(list2_idx) = list_idx;
   
                  /* consume ( */
                  NEXT_LA_CH;
      
                  if (LA_CH_VALUE != COLON) {
                     parsed_ok = parse_expr(&opnd) && parsed_ok;
                     COPY_OPND(IL_OPND(list_idx), opnd);
                  }
      
                  if (LA_CH_VALUE != COLON) {
                     if (parse_err_flush(Find_Rparen, ":")) {
                        NEXT_LA_CH;
                     }
                     parsed_ok = FALSE;
                     goto EXIT;
                  }
                  else {
                     NEXT_LA_CH;
                  }
                  if (LA_CH_VALUE != RPAREN) {
                     parsed_ok = parse_expr(&opnd) && parsed_ok;
                     COPY_OPND(IL_OPND(list2_idx), opnd);
                  }
      
                  if (LA_CH_VALUE != RPAREN) {
      
                     if (parse_err_flush(Find_Rparen, ")")) {
                        NEXT_LA_CH;
                     }
                     parsed_ok = FALSE;
                  }
                  else {
                     NEXT_LA_CH;
                  }
               }
               else {
                  OPND_IDX((*the_opnd)) = TOKEN_CONST_TBL_IDX(token);
               }
               break;
   
            case Tok_Const_Hollerith :
            case Tok_Const_Boolean   :
            case Tok_Const_Boz :
            case Tok_Const_Int :
            case Tok_Const_Real :
            case Tok_Const_Dbl :
            case Tok_Const_Quad :
            case Tok_Const_False :
            case Tok_Const_True :
   
               OPND_IDX((*the_opnd)) = TOKEN_CONST_TBL_IDX(token);
               break;
         }
      }
      else if (TOKEN_VALUE(token) == Tok_Unknown) {
         parsed_ok = FALSE;
         parse_err_flush(Find_Expr_End, parse_operand_insert);
      }
      else {
         parsed_ok = FALSE;
         parse_err_flush(Find_Expr_End, NULL);
      }
   }
   else if (LA_CH_VALUE == LPAREN && matched_specific_token(Tok_Punct_Lbrkt,
                                                            Tok_Class_Punct)) {

      /* Have array constructor */

      NTR_IR_TBL(ir_idx);
      IR_OPR(ir_idx) = Array_Construct_Opr;
      IR_LINE_NUM(ir_idx) = TOKEN_LINE(token);
      IR_COL_NUM(ir_idx)  = TOKEN_COLUMN(token);
      OPND_FLD((*the_opnd)) = IR_Tbl_Idx;
      OPND_IDX((*the_opnd)) = ir_idx;

      save_in_constructor = in_constructor;
      in_constructor = TRUE;
      parsed_ok = parse_io_list(&opnd) && parsed_ok;
      in_constructor = save_in_constructor;

      COPY_OPND(IR_OPND_R(ir_idx), opnd);

      if (LA_CH_VALUE == SLASH && matched_specific_token(Tok_Punct_Rbrkt,
                                                         Tok_Class_Punct)) {

         /* intentionally blank */
      }
      else {
         parse_err_flush(Find_EOS, "/)");
         parsed_ok = FALSE;
      }
   }
   else {
      parsed_ok = FALSE;
      parse_err_flush(Find_Expr_End, parse_operand_insert);

      if (LA_CH_VALUE == EOS) {
         TOKEN_STR_WD(token, 0)   = 0;
         TOKEN_VALUE(token)       = Tok_EOS;
         TOKEN_KIND_STR(token)[0] = EOS;
         TOKEN_KIND_LEN(token)    = 0;
         TOKEN_LEN(token)         = 0;
         TOKEN_LINE(token)        = LA_CH_LINE;
         TOKEN_COLUMN(token)      = LA_CH_COLUMN;
      }
   }

EXIT:
   TRACE (Func_Exit, "parse_operand", NULL);

   return(parsed_ok);

}  /* parse_operand */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Parse structure/array dereference on lhs of assignment.               *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      result_opnd - opnd_type, points to root of tree returned.             *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      TRUE if parsed ok                                                     *|
|*                                                                            *|
\******************************************************************************/

boolean parse_lhs (opnd_type *result_opnd,
                   int        attr_idx)

{

   int           array_idx;
   int           amb_attr_idx;
   token_type    attr_name;
   int           col;
   int           ir_idx;
   int           line;
   int           list_idx;
   int           list2_idx;
   int           list3_idx;
   opnd_type     opnd = INIT_OPND_TYPE;
   boolean       parsed_ok = TRUE;
   int           rank;
   int           subs_idx = NULL_IDX;
   int           substring_idx;
   int           trip_idx;


   TRACE (Func_Entry, "parse_lhs", NULL);

   attr_name = token;

   amb_attr_idx = attr_idx;

   while (AT_ATTR_LINK(amb_attr_idx)) {
      amb_attr_idx = AT_ATTR_LINK(amb_attr_idx);
   }

   /* if local attr has problem, quit */

   if (AT_DCL_ERR(attr_idx)) {
      SH_ERR_FLG(curr_stmt_sh_idx) = TRUE;

      parse_err_flush(Find_Ref_End, NULL);
      parsed_ok = FALSE;
      goto EXIT;
   }

   /* Now lets see what this attr is */

   switch (AT_OBJ_CLASS(amb_attr_idx)) {
      case Data_Obj :

         break;

      case Pgm_Unit :
         /* must be result var of local or host function, not interface or */
         /* other external                                                 */

         if (ATP_PGM_UNIT(amb_attr_idx) == Function  &&
             ATP_SCP_ALIVE(amb_attr_idx))            {

            if (ATP_RSLT_NAME(amb_attr_idx)) {

               /* error .. assigned function name not result name */

               PRINTMSG(TOKEN_LINE(token), 299, Error, 
                        TOKEN_COLUMN(token));
               parse_err_flush(Find_Ref_End, NULL);
               parsed_ok = FALSE;
               goto EXIT;
            }
            else {
               attr_idx = ATP_RSLT_IDX(amb_attr_idx);
               amb_attr_idx = attr_idx;
            }
         }
         else {

            if (AT_NOT_VISIBLE(amb_attr_idx)) {
               PRINTMSG(TOKEN_LINE(token), 486, Error, 
                        TOKEN_COLUMN(token),
                        AT_OBJ_NAME_PTR(amb_attr_idx),
                        AT_OBJ_NAME_PTR(AT_MODULE_IDX((amb_attr_idx))));
            }
            else {  /* can't assign to pgm unit other than current function */
               PRINTMSG(TOKEN_LINE(token), 281, Error, 
                        TOKEN_COLUMN(token));
            }
            parsed_ok = FALSE;
            parse_err_flush(Find_Ref_End, NULL);
            goto EXIT;
         }

         break;

      default       :

         if (AT_NOT_VISIBLE(amb_attr_idx)) {
            PRINTMSG(TOKEN_LINE(token), 486, Error, 
                     TOKEN_COLUMN(token),
                     AT_OBJ_NAME_PTR(amb_attr_idx),
                     AT_OBJ_NAME_PTR(AT_MODULE_IDX((amb_attr_idx))));
         }
         else {  /* can't assign this to a program unit */
            PRINTMSG(TOKEN_LINE(token), 281, Error, 
                     TOKEN_COLUMN(token));
         }

         parsed_ok = FALSE;
         parse_err_flush(Find_Ref_End, NULL);
         goto EXIT;
   }

   OPND_FLD((*result_opnd))      = AT_Tbl_Idx;
   OPND_IDX((*result_opnd))      = attr_idx;
   OPND_LINE_NUM((*result_opnd)) = TOKEN_LINE(token);
   OPND_COL_NUM((*result_opnd))  = TOKEN_COLUMN(token);

# ifdef COARRAY_FORTRAN
   if (LA_CH_VALUE != PERCENT && LA_CH_VALUE != LPAREN && 
       ((! cmd_line_flags.co_array_fortran) || LA_CH_VALUE != LBRKT))
# else
   if (LA_CH_VALUE != PERCENT && LA_CH_VALUE != LPAREN)
# endif
                                                       {
      goto EXIT;
   }


   if (LA_CH_VALUE == LPAREN) {
      /* do that array stuff */
      array_idx = ATD_ARRAY_IDX(amb_attr_idx);

      if (array_idx) {

         rank = 0;
         NTR_IR_TBL(subs_idx);
         IR_FLD_L(subs_idx)            = AT_Tbl_Idx;
         IR_IDX_L(subs_idx)            = attr_idx;
         IR_LINE_NUM_L(subs_idx)       = TOKEN_LINE(token);
         IR_COL_NUM_L(subs_idx)        = TOKEN_COLUMN(token);

         /* LA_CH is '(' */
         IR_LINE_NUM(subs_idx)         = LA_CH_LINE;
         IR_COL_NUM(subs_idx)          = LA_CH_COLUMN;

         IR_OPR(subs_idx)              = Subscript_Opr;
         IR_FLD_R(subs_idx)            = IL_Tbl_Idx;

         list_idx = NULL_IDX;

         do {
            NEXT_LA_CH;

            if (list_idx == NULL_IDX) {
               NTR_IR_LIST_TBL(list_idx);
               IR_IDX_R(subs_idx) = list_idx;
            }
            else {
               NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
               IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
               list_idx = IL_NEXT_LIST_IDX(list_idx);
            }

            if (LA_CH_VALUE != COLON) {
               parsed_ok = parse_expr(&opnd) && parsed_ok;
               COPY_OPND(IL_OPND(list_idx), opnd);
            }

            /* do some text stuff here */

            if (LA_CH_VALUE == COLON) {
               NTR_IR_TBL(trip_idx);
               IR_LINE_NUM(trip_idx)       = LA_CH_LINE;
               IR_COL_NUM(trip_idx)        = LA_CH_COLUMN;

               NEXT_LA_CH;

               IR_OPR(trip_idx)            = Triplet_Opr;
               IR_FLD_L(trip_idx)          = IL_Tbl_Idx;
               IR_LIST_CNT_L(trip_idx)     = 3;
               NTR_IR_LIST_TBL(list2_idx);
               IR_IDX_L(trip_idx)          = list2_idx;
               IL_OPND(list2_idx)          = IL_OPND(list_idx);
               IL_FLD(list_idx)            = IR_Tbl_Idx;
               IL_IDX(list_idx)            = trip_idx;
               NTR_IR_LIST_TBL(list3_idx);
               IL_NEXT_LIST_IDX(list2_idx) = list3_idx;
               IL_PREV_LIST_IDX(list3_idx) = list2_idx;

               if (LA_CH_VALUE != COLON && 
                   LA_CH_VALUE != COMMA &&
                   LA_CH_VALUE != RPAREN) {
                  parsed_ok = parse_expr(&opnd) && parsed_ok;
                  COPY_OPND(IL_OPND(list3_idx), opnd);
               }

               NTR_IR_LIST_TBL(list2_idx);
               IL_NEXT_LIST_IDX(list3_idx) = list2_idx;
               IL_PREV_LIST_IDX(list2_idx) = list3_idx;

               if (LA_CH_VALUE == COLON) {
                  NEXT_LA_CH;
                  parsed_ok = parse_expr(&opnd) && parsed_ok;
                  COPY_OPND(IL_OPND(list2_idx), opnd);
               }
            }
            rank++;
         }
         while (LA_CH_VALUE == COMMA);

         if (! matched_specific_token(Tok_Punct_Rparen, Tok_Class_Punct)) {
            if (parse_err_flush(Find_Rparen, ")")) {
               NEXT_LA_CH;
            }
            parsed_ok = FALSE;
            goto EXIT;
         }

         IR_LIST_CNT_R(subs_idx) = rank;

      } /* if (array_idx) */

      /* now check for possible substring reference */

      if (LA_CH_VALUE == LPAREN) {

         if (is_substring_ref ()) {

            if (TYP_TYPE(ATD_TYPE_IDX(amb_attr_idx)) != Character) {

               PRINTMSG(TOKEN_LINE(token), 508, Error, TOKEN_COLUMN(token));
               parsed_ok = FALSE;
               parse_err_flush(Find_Ref_End, NULL);
               goto EXIT;
            }

            NTR_IR_TBL(substring_idx);
            IR_OPR(substring_idx)             = Substring_Opr;
            IR_LINE_NUM(substring_idx)        = LA_CH_LINE;
            IR_COL_NUM(substring_idx)         = LA_CH_COLUMN;
            OPND_FLD((*result_opnd))          = IR_Tbl_Idx;
            OPND_IDX((*result_opnd))          = substring_idx;

            if (subs_idx) {
               IR_FLD_L(substring_idx)        = IR_Tbl_Idx;
               IR_IDX_L(substring_idx)        = subs_idx;

            }
            else {
               IR_FLD_L(substring_idx)        = AT_Tbl_Idx;
               IR_IDX_L(substring_idx)        = attr_idx;
               IR_LINE_NUM_L(substring_idx)   = TOKEN_LINE(token);
               IR_COL_NUM_L(substring_idx)    = TOKEN_COLUMN(token);
            }

            IR_FLD_R(substring_idx)           = IL_Tbl_Idx;
            IR_LIST_CNT_R(substring_idx)      = 2;
            NTR_IR_LIST_TBL(list_idx);
            NTR_IR_LIST_TBL(list2_idx);
            IR_IDX_R(substring_idx)           = list_idx;
            IL_NEXT_LIST_IDX(list_idx)        = list2_idx;
            IL_PREV_LIST_IDX(list2_idx)       = list_idx;

            /* consume ( */
            NEXT_LA_CH;

            if (LA_CH_VALUE != COLON) {
               parsed_ok = parse_expr(&opnd) && parsed_ok;
               COPY_OPND(IL_OPND(list_idx), opnd); 
            }

            if (LA_CH_VALUE != COLON) {
               if (parse_err_flush(Find_Rparen, ":")) {
                  NEXT_LA_CH;
               }
               parsed_ok = FALSE;
               goto EXIT;
            }
            else {
               NEXT_LA_CH;
            }

            if (LA_CH_VALUE != RPAREN) {
               parsed_ok = parse_expr(&opnd) && parsed_ok;
               COPY_OPND(IL_OPND(list2_idx), opnd); 
            }

            if (LA_CH_VALUE != RPAREN) {

               if (parse_err_flush(Find_Rparen, ")")) {
                  NEXT_LA_CH;
               }
               parsed_ok = FALSE;
               goto EXIT;
            }
            else {
               NEXT_LA_CH;
            }
            goto EXIT;
         }
      }

      if (LA_CH_VALUE != PERCENT) {

         if (subs_idx) {
            OPND_FLD((*result_opnd))       = IR_Tbl_Idx;
            OPND_IDX((*result_opnd))       = subs_idx;
         }
         else {

            OPND_FLD((*result_opnd))      = AT_Tbl_Idx;
            OPND_IDX((*result_opnd))      = attr_idx;
            OPND_LINE_NUM((*result_opnd)) = TOKEN_LINE(attr_name);
            OPND_COL_NUM((*result_opnd))  = TOKEN_COLUMN(attr_name);

         }
      }
   } /* if (LA_CH_VALUE == LPAREN) */

# ifdef COARRAY_FORTRAN
   if (cmd_line_flags.co_array_fortran &&
       LA_CH_VALUE == LBRKT &&
       AT_OBJ_CLASS(amb_attr_idx) == Data_Obj) {

      if (ATD_PE_ARRAY_IDX(amb_attr_idx) == NULL_IDX) {
         /* not declared with pe dimensions */
         PRINTMSG(LA_CH_LINE, 1245, Error, LA_CH_COLUMN,
                  AT_OBJ_NAME_PTR(amb_attr_idx));
         parsed_ok = FALSE;
         parse_err_flush(Find_Ref_End, NULL);
         goto EXIT;
      }

      if (subs_idx == NULL_IDX) {
         NTR_IR_TBL(subs_idx);

         /* LA_CH is '[' */
         IR_LINE_NUM(subs_idx)         = LA_CH_LINE;
         IR_COL_NUM(subs_idx)          = LA_CH_COLUMN;

         IR_OPR(subs_idx)              = Subscript_Opr;
         IR_FLD_R(subs_idx)            = IL_Tbl_Idx;
         IR_LIST_CNT_R(subs_idx)       = 0;

         if (OPND_FLD((*result_opnd)) == AT_Tbl_Idx) {
            COPY_OPND(IR_OPND_L(subs_idx), (*result_opnd));

            /* put subs_idx into result opnd for now */
            OPND_FLD((*result_opnd))      = IR_Tbl_Idx;
            OPND_IDX((*result_opnd))      = subs_idx;
         }
         else if (OPND_FLD((*result_opnd)) == IR_Tbl_Idx &&
                  IR_OPR(OPND_IDX((*result_opnd))) == Substring_Opr) {

            COPY_OPND(IR_OPND_L(subs_idx), IR_OPND_L(OPND_IDX((*result_opnd))));

            IR_FLD_L(OPND_IDX((*result_opnd))) = IR_Tbl_Idx;
            IR_IDX_L(OPND_IDX((*result_opnd))) = subs_idx;
         }
# ifdef _DEBUG
         else {
            PRINTMSG(LA_CH_LINE, 626, Internal, LA_CH_COLUMN,
                     "AT_Tbl_Idx", "parse_deref");
         }
# endif

         list_idx = NULL_IDX;
      }
      else {

         list_idx = IR_IDX_R(subs_idx);

         while (IL_NEXT_LIST_IDX(list_idx) != NULL_IDX) {
            list_idx = IL_NEXT_LIST_IDX(list_idx);
         }
      }

      do {
         NEXT_LA_CH;

         if (list_idx == NULL_IDX) {
            NTR_IR_LIST_TBL(list_idx);
            IR_IDX_R(subs_idx) = list_idx;
         }
         else {
            NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
            IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
            list_idx = IL_NEXT_LIST_IDX(list_idx);
         }

         IL_PE_SUBSCRIPT(list_idx) = TRUE;

         if (LA_CH_VALUE != COLON) {
            parsed_ok = parse_expr(&opnd) && parsed_ok;
            COPY_OPND(IL_OPND(list_idx), opnd);
         }

         /* do some text stuff here */

         if (LA_CH_VALUE == COLON) {

            NTR_IR_TBL(trip_idx);
            IR_LINE_NUM(trip_idx)       = LA_CH_LINE;
            IR_COL_NUM(trip_idx)        = LA_CH_COLUMN;

            NEXT_LA_CH;

            IR_OPR(trip_idx)            = Triplet_Opr;
            IR_FLD_L(trip_idx)          = IL_Tbl_Idx;
            IR_LIST_CNT_L(trip_idx)     = 3;
            NTR_IR_LIST_TBL(list2_idx);
            IR_IDX_L(trip_idx)          = list2_idx;
            IL_OPND(list2_idx)          = IL_OPND(list_idx);
            IL_FLD(list_idx)            = IR_Tbl_Idx;
            IL_IDX(list_idx)            = trip_idx;
            NTR_IR_LIST_TBL(list3_idx);
            IL_NEXT_LIST_IDX(list2_idx) = list3_idx;
            IL_PREV_LIST_IDX(list3_idx) = list2_idx;

            if (LA_CH_VALUE != COLON &&
                LA_CH_VALUE != COMMA &&
                LA_CH_VALUE != RBRKT) {
               parsed_ok = parse_expr(&opnd) && parsed_ok;
               COPY_OPND(IL_OPND(list3_idx), opnd);
            }

            NTR_IR_LIST_TBL(list2_idx);
            IL_NEXT_LIST_IDX(list3_idx) = list2_idx;
            IL_PREV_LIST_IDX(list2_idx) = list3_idx;

            if (LA_CH_VALUE == COLON) {
               NEXT_LA_CH;
               parsed_ok = parse_expr(&opnd) && parsed_ok;
               COPY_OPND(IL_OPND(list2_idx), opnd);
            }
         }
         (IR_LIST_CNT_R(subs_idx))++;
      }
      while (LA_CH_VALUE == COMMA);

      if (LA_CH_VALUE != RBRKT) {
         parse_err_flush(Find_EOS, "]");
         parsed_ok = FALSE;
         goto EXIT;
      }
      else {
         /* swallow ] */
         NEXT_LA_CH;
      }
   }
# endif

   if (LA_CH_VALUE == PERCENT) {

      /* first see if attr_idx is a structure */

      if (TYP_TYPE(ATD_TYPE_IDX(amb_attr_idx)) != Structure) {

         if (SCP_IMPL_NONE(curr_scp_idx) && !AT_TYPED(amb_attr_idx) &&
             !AT_DCL_ERR(amb_attr_idx)) {
            AT_DCL_ERR(amb_attr_idx)    = TRUE;
            PRINTMSG(TOKEN_LINE(attr_name), 113, Error,
                     TOKEN_COLUMN(attr_name),
                     TOKEN_STR(attr_name));
         }
         else {
            PRINTMSG(TOKEN_LINE(attr_name), 212, Error,
                     TOKEN_COLUMN(attr_name), 
                     TOKEN_STR(attr_name),
                     get_basic_type_str(ATD_TYPE_IDX(amb_attr_idx)));
         }

         parse_err_flush(Find_Ref_End, NULL);
         parsed_ok = FALSE;
         goto EXIT;
      }
      line = LA_CH_LINE;
      col = LA_CH_COLUMN;
      NEXT_LA_CH;

      if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
         NTR_IR_TBL(ir_idx);
         IR_OPR(ir_idx)      = Struct_Opr;
         IR_LINE_NUM(ir_idx) = line;
         IR_COL_NUM(ir_idx)  = col;

         if (subs_idx) {
            IR_FLD_L(ir_idx)            = IR_Tbl_Idx;
            IR_IDX_L(ir_idx)            = subs_idx;
         }
         else {
            IR_FLD_L(ir_idx) = AT_Tbl_Idx;
            IR_IDX_L(ir_idx) = attr_idx;

            IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(attr_name);
            IR_COL_NUM_L(ir_idx)  = TOKEN_COLUMN(attr_name);
         }

         OPND_FLD((*result_opnd)) = IR_Tbl_Idx;
         OPND_IDX((*result_opnd)) = ir_idx;

         parsed_ok = parse_deref(result_opnd, 
                                 TYP_IDX(ATD_TYPE_IDX(amb_attr_idx)));

      }
      else {
         /* no ID after %, must be an error */
         parse_err_flush(Find_Ref_End, "IDENTIFIER");
         parsed_ok = FALSE;
      }
   }

EXIT:

   if (parsed_ok) {

      if (ATD_CLASS(amb_attr_idx) == Function_Result) {
         AT_DEFINED(ATD_FUNC_IDX(amb_attr_idx)) = TRUE;
      }
      else if (ATD_CLASS(amb_attr_idx) == Atd_Unknown) {
         ATD_CLASS(amb_attr_idx)        = Variable;
      }

      AT_DEFINED(attr_idx) = TRUE;
   }

   TRACE (Func_Exit, "parse_lhs", NULL);

   return(parsed_ok);

} /* parse_lhs */