Open64 (mfef90, whirl2f, and IR tools): osprey1.0/crayf90/fe90/s

Go to the documentation of this file.
00001 /*
00002 
00003   Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.
00004 
00005   This program is free software; you can redistribute it and/or modify it
00006   under the terms of version 2 of the GNU General Public License as
00007   published by the Free Software Foundation.
00008 
00009   This program is distributed in the hope that it would be useful, but
00010   WITHOUT ANY WARRANTY; without even the implied warranty of
00011   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
00012 
00013   Further, this software is distributed without any warranty that it is
00014   free of the rightful claim of any third person regarding infringement 
00015   or the like.  Any license provided herein, whether implied or 
00016   otherwise, applies only to this software file.  Patent licenses, if 
00017   any, provided herein do not apply to combinations of this program with 
00018   other software, or any other product whatsoever.  
00019 
00020   You should have received a copy of the GNU General Public License along
00021   with this program; if not, write the Free Software Foundation, Inc., 59
00022   Temple Place - Suite 330, Boston MA 02111-1307, USA.
00023 
00024   Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00025   Mountain View, CA 94043, or:
00026 
00027   http://www.sgi.com
00028 
00029   For further information regarding this notice, see:
00030 
00031   http://oss.sgi.com/projects/GenInfo/NoticeExplan
00032 
00033 */
00034 
00035 
00036 
00037 static char USMID[] = "\n@(#)5.0_pl/sources/s_rcnstrct.c        5.5     09/29/99 17:38:13\n";
00038 
00039 # include "defines.h"           /* Machine dependent ifdefs */
00040 
00041 # include "host.m"              /* Host machine dependent macros.*/
00042 # include "host.h"              /* Host machine dependent header.*/
00043 # include "target.m"            /* Target machine dependent macros.*/
00044 # include "target.h"            /* Target machine dependent header.*/
00045 
00046 # include "globals.m"
00047 # include "tokens.m"
00048 # include "sytb.m"
00049 # include "s_globals.m"
00050 # include "debug.m"
00051 # include "s_asg_expr.m"
00052 # include "s_cnstrct.m"
00053 
00054 # include "globals.h"
00055 # include "tokens.h"
00056 # include "sytb.h"
00057 # include "s_globals.h"
00058 # include "s_rcnstrct.h"
00059 
00060 # if defined(_HOST_OS_UNICOS) || defined(_HOST_OS_MAX)
00061 # include <fortran.h>
00062 # endif
00063 
00064 
00065 
00066 /*****************************************************************\
00067 |* function prototypes of static functions declared in this file *|
00068 \*****************************************************************/
00069 
00070 static void    check_for_dependencies(opnd_type *, size_level_type *);
00071 static void    create_array_constructor_asg(opnd_type *, opnd_type *, int, int);
00072 static void    do_slice_asg(int, opnd_type *, int, int);
00073 static void    determine_slice_size(int, opnd_type *, size_level_type *);
00074 static void    create_interp_stmts(int, int);
00075 static void    do_single_asg(opnd_type *, expr_arg_type *, opnd_type *, int, 
00076                              int);
00077 static void    create_struct_constructor_asg(opnd_type *, opnd_type *);
00078 static void    increment_subscript(int);
00079 static void    test_size_stmts(int, int, int);
00080 static void    expand_stmts(opnd_type *, expr_arg_type *);
00081 static void    check_for_constructors(opnd_type *, expr_arg_type *);
00082 
00083 /******************************************************************************\
00084 |*                                                                            *|
00085 |* Description:                                                               *|
00086 |*      This is the main entry for the run time array constructor system.     *|
00087 |*      It drives the routines which generate the necessary assignments and   *|
00088 |*      loops to create a constructor temp that is not constant.              *|
00089 |*      There are three basic approaches ...                                  *|
00090 |*              1. Simple_Expr_Size. The tmp size can be determined by a      *|
00091 |*                 single run time expression. The tmp is then alloc'd at     *|
00092 |*                 size and run time assignments follow.                      *|
00093 |*              2. Interp_Loop_Size. The tmp size is determined by runtime    *|
00094 |*                 interpretation of the implied do loops.                    *|
00095 |*              3. "your guess is as good as mine" size. The tmp size is      *|
00096 |*                 dependent on function calls, so we just allocate a large   *|
00097 |*                 allocatable array tmp and after every assignment test to   *|
00098 |*                 see if we have enough room. If not, we reallocate the      *|
00099 |*                 array with another large increment.                        *|
00100 |*                                                                            *|
00101 |* Input parameters:                                                          *|
00102 |*      top_opnd - original tree (array constructor)                          *|
00103 |*      exp_desc - expression descriptor for constructor.                     *|
00104 |*                                                                            *|
00105 |* Output parameters:                                                         *|
00106 |*      top_opnd - points to tmp reference.                                   *|
00107 |*      exp_desc - some fields are modified.                                  *|
00108 |*                                                                            *|
00109 |* Returns:                                                                   *|
00110 |*      TRUE if no errors.                                                    *|
00111 |*                                                                            *|
00112 \******************************************************************************/
00113 
00114 boolean create_runtime_array_constructor(opnd_type      *top_opnd,
00115                                          expr_arg_type  *exp_desc)
00116 
00117 {
00118    int                  alloc_idx;
00119    int                  allocate_tmp_idx;
00120    int                  asg_idx;
00121    int                  base_asg_idx;
00122    int                  base_tmp_idx;
00123    int                  bd_idx;
00124    int                  call_idx;
00125    opnd_type            char_len_opnd;
00126    int                  char_len_tmp;
00127    int                  cn_idx;
00128    int                  col;
00129    size_level_type      constructor_size_level;
00130    int                  dealloc_idx;
00131    int                  dump_dv_idx;
00132    int                  dv_idx;
00133    int                  ir_idx;
00134    opnd_type            l_opnd;
00135    int                  line;
00136    int                  list_idx;
00137    expr_arg_type        loc_exp_desc;
00138    int                  loc_idx;
00139    int                  max_idx;
00140    int                  minus_idx;
00141    opnd_type            num_opnd;
00142    int                  num_tmp_idx;
00143    boolean              ok = TRUE;
00144    int                  realloc_size_attr;
00145    boolean              save_defer_stmt_expansion;
00146    boolean              save_in_constructor;
00147    int                  save_curr_stmt_sh_idx;
00148    int                  shift_idx;
00149    size_offset_type     size;
00150    int                  size_limit_attr;
00151    opnd_type            size_opnd;
00152    int                  size_tmp_idx;
00153    size_offset_type     stride;
00154    int                  subscript_idx;
00155    opnd_type            target_base_opnd;
00156    long                 the_constant;
00157    int                  tmp_idx;
00158    int                  tmp_sub_idx;
00159    int                  type_idx;
00160 
00161 
00162    TRACE (Func_Entry, "create_runtime_array_constructor", NULL);
00163 
00164    stmt_expansion_control_start();
00165    save_defer_stmt_expansion = defer_stmt_expansion;
00166    defer_stmt_expansion = FALSE;
00167 
00168    ir_idx = OPND_IDX((*top_opnd));
00169    line   = IR_LINE_NUM(ir_idx);
00170    col    = IR_COL_NUM(ir_idx);
00171 
00172    save_in_constructor = in_constructor;
00173    in_constructor = TRUE;
00174 
00175    COPY_OPND(num_opnd, (exp_desc->shape[0]));
00176    constructor_size_level = (size_level_type) exp_desc->constructor_size_level;
00177 
00178    GEN_COMPILER_TMP_ASG(asg_idx,
00179                         tmp_sub_idx,
00180                         TRUE,   /* Semantics is done */
00181                         line,
00182                         col,
00183                         SA_INTEGER_DEFAULT_TYPE,
00184                         Priv);
00185    
00186    IR_FLD_R(asg_idx)    = CN_Tbl_Idx;
00187    IR_IDX_R(asg_idx)    = CN_INTEGER_ONE_IDX;
00188    IR_LINE_NUM_R(asg_idx) = line;
00189    IR_COL_NUM_R(asg_idx)  = col;
00190 
00191    gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00192 
00193    SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))     = asg_idx;
00194    SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00195 
00196    if (TYP_TYPE(IR_TYPE_IDX(ir_idx)) == Character) {
00197       /* determine max char length */
00198 
00199       copy_subtree(&(exp_desc->char_len), &char_len_opnd);
00200       OPND_LINE_NUM(char_len_opnd) = line;
00201       OPND_COL_NUM(char_len_opnd)  = col;
00202 
00203       process_char_len(&char_len_opnd);
00204 
00205       expand_stmts(&char_len_opnd, NULL);
00206 
00207       if (OPND_FLD(char_len_opnd) == IR_Tbl_Idx &&
00208           IR_OPR(OPND_IDX(char_len_opnd)) != Subscript_Opr &&
00209           IR_OPR(OPND_IDX(char_len_opnd)) != Whole_Subscript_Opr &&
00210           IR_OPR(OPND_IDX(char_len_opnd)) != Section_Subscript_Opr &&
00211           IR_OPR(OPND_IDX(char_len_opnd)) != Substring_Opr &&
00212           IR_OPR(OPND_IDX(char_len_opnd)) != Whole_Substring_Opr &&
00213           IR_OPR(OPND_IDX(char_len_opnd)) != Struct_Opr &&
00214           IR_OPR(OPND_IDX(char_len_opnd)) != Dv_Deref_Opr) {
00215 
00216          loc_exp_desc = init_exp_desc;
00217 
00218          loc_exp_desc.type_idx = SA_INTEGER_DEFAULT_TYPE;
00219          loc_exp_desc.type = TYP_TYPE(loc_exp_desc.type_idx);
00220          loc_exp_desc.linear_type = SA_INTEGER_DEFAULT_TYPE;
00221 
00222          char_len_tmp = create_tmp_asg(&char_len_opnd, &loc_exp_desc,
00223                                        &l_opnd, Intent_In, FALSE, FALSE);
00224          OPND_FLD(char_len_opnd) = AT_Tbl_Idx;
00225          OPND_IDX(char_len_opnd) = char_len_tmp;
00226          OPND_LINE_NUM(char_len_opnd) = line;
00227          OPND_COL_NUM(char_len_opnd)  = col;
00228       }
00229       
00230 
00231 # ifdef _DEBUG
00232       if (OPND_FLD(char_len_opnd) == NO_Tbl_Idx) {
00233          PRINTMSG(line, 902, Internal, col);
00234       }
00235 # endif
00236 
00237       CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
00238       TYP_TYPE(TYP_WORK_IDX)       = Character;
00239       TYP_LINEAR(TYP_WORK_IDX)     = CHARACTER_DEFAULT_TYPE;
00240       TYP_CHAR_CLASS(TYP_WORK_IDX) = (OPND_FLD(char_len_opnd) == CN_Tbl_Idx ?
00241                                       Const_Len_Char : Var_Len_Char);
00242       TYP_FLD(TYP_WORK_IDX)        = OPND_FLD(char_len_opnd);
00243       TYP_IDX(TYP_WORK_IDX)        = OPND_IDX(char_len_opnd);
00244 
00245       if (TYP_CHAR_CLASS(TYP_WORK_IDX) == Var_Len_Char) {
00246          TYP_ORIG_LEN_IDX(TYP_WORK_IDX) = OPND_IDX(char_len_opnd);
00247       }
00248 
00249       type_idx         = ntr_type_tbl();
00250       COPY_OPND(exp_desc->char_len, char_len_opnd);
00251    }
00252    else {
00253 
00254       type_idx = IR_TYPE_IDX(ir_idx);
00255    }
00256 
00257    exp_desc->type_idx = type_idx;
00258 
00259    if (constructor_size_level == Simple_Expr_Size) {
00260 
00261       /* try to fold */
00262       ok = expr_semantics(&num_opnd, &loc_exp_desc);
00263 
00264       if (OPND_FLD(num_opnd) == CN_Tbl_Idx &&
00265           (TYP_TYPE(IR_TYPE_IDX(ir_idx)) != Character ||
00266            OPND_FLD(char_len_opnd) == CN_Tbl_Idx)) {
00267 
00268          /* get stack tmp of constant size */
00269 
00270          tmp_idx                = gen_compiler_tmp(line, col, Priv, TRUE);
00271          AT_SEMANTICS_DONE(tmp_idx)     = TRUE;
00272          ATD_STOR_BLK_IDX(tmp_idx)      = SCP_SB_STACK_IDX(curr_scp_idx); 
00273 
00274          ATD_TYPE_IDX(tmp_idx)     = type_idx;
00275          exp_desc->shape[0].fld    = OPND_FLD(num_opnd);
00276          exp_desc->shape[0].idx    = OPND_IDX(num_opnd);
00277          exp_desc->rank            = 1;
00278          ATD_ARRAY_IDX(tmp_idx)    = create_bd_ntry_for_const(exp_desc,
00279                                                               line,
00280                                                               col);
00281 
00282          OPND_FLD(target_base_opnd) = AT_Tbl_Idx;
00283          OPND_IDX(target_base_opnd) = tmp_idx;
00284          OPND_LINE_NUM(target_base_opnd) = line;
00285          OPND_COL_NUM(target_base_opnd)  = col;
00286 
00287          create_array_constructor_asg(top_opnd, 
00288                                      &target_base_opnd, 
00289                                       tmp_sub_idx,
00290                                       0);
00291 
00292       }
00293       else {
00294          COPY_OPND(size_opnd, num_opnd);
00295          OPND_LINE_NUM(size_opnd) = line;
00296          OPND_COL_NUM(size_opnd) = col;
00297 
00298          /* set up size tmp, alloc actual tmp */
00299 
00300          determine_tmp_size(&size_opnd,  type_idx);
00301 
00302          NTR_IR_TBL(max_idx);
00303          IR_OPR(max_idx) = Max_Opr;
00304          IR_LINE_NUM(max_idx)   = line;
00305          IR_COL_NUM(max_idx)    = col;
00306          IR_TYPE_IDX(max_idx) = SA_INTEGER_DEFAULT_TYPE;
00307          IR_FLD_L(max_idx) = IL_Tbl_Idx;
00308          IR_LIST_CNT_L(max_idx) = 2;
00309 
00310          NTR_IR_LIST_TBL(list_idx);
00311          IR_IDX_L(max_idx) = list_idx;
00312  
00313          IL_FLD(list_idx) = CN_Tbl_Idx;
00314          IL_IDX(list_idx) = CN_INTEGER_ZERO_IDX;
00315          IL_LINE_NUM(list_idx) = line;
00316          IL_COL_NUM(list_idx)  = col;
00317 
00318          NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
00319          IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
00320          list_idx = IL_NEXT_LIST_IDX(list_idx);
00321 
00322          COPY_OPND(IL_OPND(list_idx), size_opnd);
00323 
00324          OPND_FLD(size_opnd) = IR_Tbl_Idx;
00325          OPND_IDX(size_opnd) = max_idx;
00326 
00327 
00328          GEN_COMPILER_TMP_ASG(asg_idx,
00329                               size_tmp_idx,
00330                               TRUE,     /* Semantics is done */
00331                               line,
00332                               col,
00333                               SA_INTEGER_DEFAULT_TYPE,
00334                               Priv);
00335 
00336          COPY_OPND(IR_OPND_R(asg_idx), size_opnd);
00337 
00338          gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00339 
00340          SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))     = asg_idx;
00341          SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00342 
00343          GEN_COMPILER_TMP_ASG(asg_idx,
00344                               num_tmp_idx,
00345                               TRUE,     /* Semantics is done */
00346                               line,
00347                               col,
00348                               SA_INTEGER_DEFAULT_TYPE,
00349                               Priv);
00350 
00351          COPY_OPND(IR_OPND_R(asg_idx), num_opnd);
00352 
00353          gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00354 
00355          SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))     = asg_idx;
00356          SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00357 
00358          tmp_idx                = gen_compiler_tmp(line, col, Priv, TRUE);
00359          AT_SEMANTICS_DONE(tmp_idx)     = TRUE;
00360          ATD_TYPE_IDX(tmp_idx)          = type_idx;
00361          ATD_STOR_BLK_IDX(tmp_idx)      = SCP_SB_BASED_IDX(curr_scp_idx);
00362          exp_desc->shape[0].fld         = OPND_FLD(num_opnd);
00363          exp_desc->shape[0].idx         = OPND_IDX(num_opnd);
00364          exp_desc->rank                 = 1;
00365 
00366          bd_idx                         = reserve_array_ntry(1);
00367          BD_RANK(bd_idx)                = 1;
00368          BD_LINE_NUM(bd_idx)            = line;
00369          BD_COLUMN_NUM(bd_idx)          = col;
00370          BD_LEN_FLD(bd_idx)             = AT_Tbl_Idx;
00371          BD_LEN_IDX(bd_idx)             = num_tmp_idx;
00372 /*         BD_ARRAY_CLASS(bd_idx)         = Explicit_Shape;*/
00373          BD_ARRAY_SIZE(bd_idx)          = Var_Len_Array;
00374 
00375          BD_LB_FLD(bd_idx,1)            = CN_Tbl_Idx;
00376          BD_LB_IDX(bd_idx,1)            = CN_INTEGER_ONE_IDX;
00377 
00378          BD_UB_FLD(bd_idx,1)            = AT_Tbl_Idx;
00379          BD_UB_IDX(bd_idx,1)            = num_tmp_idx;
00380 
00381          BD_XT_FLD(bd_idx,1)            = AT_Tbl_Idx;
00382          BD_XT_IDX(bd_idx,1)            = num_tmp_idx;
00383 
00384          gen_copyin_bounds_stmt(num_tmp_idx);
00385 
00386          set_stride_for_first_dim(type_idx, &stride);
00387 
00388          BD_SM_FLD(bd_idx, 1)           = stride.fld;
00389          BD_SM_IDX(bd_idx, 1)           = stride.idx;
00390 
00391          BD_RESOLVED(bd_idx)            = TRUE;
00392 
00393          BD_FLOW_DEPENDENT(bd_idx)      = TRUE;
00394 
00395          ATD_ARRAY_IDX(tmp_idx)         = ntr_array_in_bd_tbl(bd_idx);
00396          ATD_AUTOMATIC(tmp_idx)         = TRUE;
00397 
00398          GEN_COMPILER_TMP_ASG(base_asg_idx,
00399                               base_tmp_idx,
00400                               TRUE,     /* Semantics is done */
00401                               line,
00402                               col,
00403                               SA_INTEGER_DEFAULT_TYPE,
00404                               Priv);
00405 
00406          ATD_AUTO_BASE_IDX(tmp_idx)     = base_tmp_idx;
00407 
00408          NTR_IR_TBL(alloc_idx);
00409          IR_OPR(alloc_idx) = Alloc_Opr;
00410          IR_TYPE_IDX(alloc_idx) = TYPELESS_DEFAULT_TYPE;
00411          IR_LINE_NUM(alloc_idx)   = line;
00412          IR_COL_NUM(alloc_idx)    = col;
00413          IR_FLD_L(alloc_idx) = AT_Tbl_Idx;
00414          IR_IDX_L(alloc_idx) = size_tmp_idx;
00415          IR_LINE_NUM_L(alloc_idx)   = line;
00416          IR_COL_NUM_L(alloc_idx)    = col;
00417          IR_FLD_R(base_asg_idx) = IR_Tbl_Idx;
00418          IR_IDX_R(base_asg_idx) = alloc_idx;
00419 
00420          gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00421 
00422          SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = base_asg_idx;
00423          SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00424 
00425          NTR_IR_TBL(dealloc_idx);
00426          IR_OPR(dealloc_idx) = Dealloc_Opr;
00427          IR_TYPE_IDX(dealloc_idx) = TYPELESS_DEFAULT_TYPE;
00428          IR_LINE_NUM(dealloc_idx)   = line;
00429          IR_COL_NUM(dealloc_idx)    = col;
00430          COPY_OPND(IR_OPND_L(dealloc_idx), IR_OPND_L(base_asg_idx));
00431 
00432          gen_sh(After, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00433 
00434          SH_IR_IDX(curr_stmt_sh_idx) = dealloc_idx;
00435          SH_P2_SKIP_ME(curr_stmt_sh_idx) = TRUE;
00436 
00437          curr_stmt_sh_idx = SH_PREV_IDX(curr_stmt_sh_idx);
00438 
00439          OPND_FLD(target_base_opnd) = AT_Tbl_Idx;
00440          OPND_IDX(target_base_opnd) = tmp_idx;
00441          OPND_LINE_NUM(target_base_opnd) = line;
00442          OPND_COL_NUM(target_base_opnd)  = col;
00443 
00444          create_array_constructor_asg(top_opnd, 
00445                                       &target_base_opnd, 
00446                                       tmp_sub_idx,
00447                                       0);
00448       }
00449 
00450       OPND_FLD((*top_opnd)) = AT_Tbl_Idx;
00451       OPND_IDX((*top_opnd)) = tmp_idx;
00452       OPND_LINE_NUM((*top_opnd)) = line;
00453       OPND_COL_NUM((*top_opnd))  = col;
00454 
00455       /* gen_whole_subscript calls gen_whole_substring */
00456       ok = gen_whole_subscript(top_opnd, exp_desc) && ok;
00457 
00458       exp_desc->tmp_reference = TRUE;
00459       exp_desc->contig_array = TRUE;
00460    }
00461    else if (constructor_size_level == Interp_Loop_Size) {
00462 
00463       GEN_COMPILER_TMP_ASG(asg_idx,
00464                            num_tmp_idx,
00465                            TRUE,        /* Semantics is done */
00466                            line,
00467                            col,
00468                            SA_INTEGER_DEFAULT_TYPE,
00469                            Priv);
00470 
00471       IR_FLD_R(asg_idx) = CN_Tbl_Idx;
00472       IR_IDX_R(asg_idx) = CN_INTEGER_ZERO_IDX;
00473       IR_LINE_NUM_R(asg_idx) = line;
00474       IR_COL_NUM_R(asg_idx)  = col;
00475 
00476       gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00477 
00478       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))     = asg_idx;
00479       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00480 
00481       create_interp_stmts(OPND_IDX(num_opnd), num_tmp_idx);
00482 
00483       OPND_FLD(size_opnd) = AT_Tbl_Idx;
00484       OPND_IDX(size_opnd) = num_tmp_idx;
00485       OPND_LINE_NUM(size_opnd) = line;
00486       OPND_COL_NUM(size_opnd) = col;
00487 
00488       determine_tmp_size(&size_opnd, type_idx);
00489 
00490       NTR_IR_TBL(max_idx);
00491       IR_OPR(max_idx) = Max_Opr;
00492       IR_TYPE_IDX(max_idx) = SA_INTEGER_DEFAULT_TYPE;
00493       IR_LINE_NUM(max_idx)   = line;
00494       IR_COL_NUM(max_idx)    = col;
00495       IR_FLD_L(max_idx) = IL_Tbl_Idx;
00496       IR_LIST_CNT_L(max_idx) = 2;
00497 
00498       NTR_IR_LIST_TBL(list_idx);
00499       IR_IDX_L(max_idx) = list_idx;
00500 
00501       IL_FLD(list_idx) = CN_Tbl_Idx;
00502       IL_IDX(list_idx) = CN_INTEGER_ZERO_IDX;
00503       IL_LINE_NUM(list_idx) = line;
00504       IL_COL_NUM(list_idx)  = col;
00505 
00506       NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
00507       IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
00508       list_idx = IL_NEXT_LIST_IDX(list_idx);
00509 
00510       COPY_OPND(IL_OPND(list_idx), size_opnd);
00511 
00512       OPND_FLD(size_opnd) = IR_Tbl_Idx;
00513       OPND_IDX(size_opnd) = max_idx;
00514 
00515       GEN_COMPILER_TMP_ASG(asg_idx,
00516                            size_tmp_idx,
00517                            TRUE,        /* Semantics is done */
00518                            line,
00519                            col,
00520                            SA_INTEGER_DEFAULT_TYPE,
00521                            Priv);
00522 
00523       COPY_OPND(IR_OPND_R(asg_idx), size_opnd);
00524 
00525       gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00526 
00527       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))     = asg_idx;
00528       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00529 
00530       tmp_idx                   = gen_compiler_tmp(line, col, Priv, TRUE);
00531       AT_SEMANTICS_DONE(tmp_idx)= TRUE;
00532 
00533       ATD_TYPE_IDX(tmp_idx)     = type_idx;
00534       ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_BASED_IDX(curr_scp_idx);
00535       exp_desc->shape[0].fld    = OPND_FLD(num_opnd);
00536       exp_desc->shape[0].idx    = OPND_IDX(num_opnd);
00537       exp_desc->rank            = 1;
00538 
00539       bd_idx                    = reserve_array_ntry(1);
00540       BD_RESOLVED(bd_idx)       = TRUE;
00541       BD_RANK(bd_idx)           = 1;
00542       BD_LINE_NUM(bd_idx)       = line;
00543       BD_COLUMN_NUM(bd_idx)     = col;
00544       BD_LEN_FLD(bd_idx)        = AT_Tbl_Idx;
00545       BD_LEN_IDX(bd_idx)        = num_tmp_idx;
00546 
00547 /*      BD_ARRAY_CLASS(bd_idx)         = Explicit_Shape; */
00548       BD_ARRAY_SIZE(bd_idx)     = Var_Len_Array;
00549 
00550       BD_LB_FLD(bd_idx,1)       = CN_Tbl_Idx;
00551       BD_LB_IDX(bd_idx,1)       = CN_INTEGER_ONE_IDX;
00552 
00553       BD_UB_FLD(bd_idx,1)       = AT_Tbl_Idx;
00554       BD_UB_IDX(bd_idx,1)       = num_tmp_idx;
00555 
00556       BD_XT_FLD(bd_idx,1)       = AT_Tbl_Idx;
00557       BD_XT_IDX(bd_idx,1)       = num_tmp_idx;
00558 
00559       gen_copyin_bounds_stmt(num_tmp_idx);
00560 
00561       set_stride_for_first_dim(type_idx, &stride);
00562 
00563       BD_SM_FLD(bd_idx, 1)      = stride.fld;
00564       BD_SM_IDX(bd_idx, 1)      = stride.idx;
00565 
00566       BD_FLOW_DEPENDENT(bd_idx) = TRUE;
00567 
00568       ATD_ARRAY_IDX(tmp_idx)    = ntr_array_in_bd_tbl(bd_idx);
00569       ATD_AUTOMATIC(tmp_idx)    = TRUE;
00570 
00571       GEN_COMPILER_TMP_ASG(base_asg_idx,
00572                            base_tmp_idx,
00573                            TRUE,        /* Semantics is done */
00574                            line,
00575                            col,
00576                            SA_INTEGER_DEFAULT_TYPE,
00577                            Priv);
00578 
00579       ATD_AUTO_BASE_IDX(tmp_idx)        = base_tmp_idx;
00580 
00581       NTR_IR_TBL(alloc_idx);
00582       IR_OPR(alloc_idx) = Alloc_Opr;
00583       IR_TYPE_IDX(alloc_idx) = TYPELESS_DEFAULT_TYPE;
00584       IR_LINE_NUM(alloc_idx)   = line;
00585       IR_COL_NUM(alloc_idx)    = col;
00586       IR_FLD_L(alloc_idx) = AT_Tbl_Idx;
00587       IR_IDX_L(alloc_idx) = size_tmp_idx;
00588       IR_LINE_NUM_L(alloc_idx)   = line;
00589       IR_COL_NUM_L(alloc_idx)    = col;
00590       IR_FLD_R(base_asg_idx) = IR_Tbl_Idx;
00591       IR_IDX_R(base_asg_idx) = alloc_idx;
00592 
00593       gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00594 
00595       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = base_asg_idx;
00596       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00597 
00598       NTR_IR_TBL(dealloc_idx);
00599       IR_OPR(dealloc_idx) = Dealloc_Opr;
00600       IR_TYPE_IDX(dealloc_idx) = TYPELESS_DEFAULT_TYPE;
00601       IR_LINE_NUM(dealloc_idx)   = line;
00602       IR_COL_NUM(dealloc_idx)    = col;
00603       COPY_OPND(IR_OPND_L(dealloc_idx), IR_OPND_L(base_asg_idx));
00604 
00605       gen_sh(After, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00606 
00607       SH_IR_IDX(curr_stmt_sh_idx) = dealloc_idx;
00608       SH_P2_SKIP_ME(curr_stmt_sh_idx) = TRUE;
00609 
00610       curr_stmt_sh_idx = SH_PREV_IDX(curr_stmt_sh_idx);
00611 
00612       OPND_FLD(target_base_opnd) = AT_Tbl_Idx;
00613       OPND_IDX(target_base_opnd) = tmp_idx;
00614       OPND_LINE_NUM(target_base_opnd) = line;
00615       OPND_COL_NUM(target_base_opnd)  = col;
00616 
00617       create_array_constructor_asg(top_opnd, 
00618                                    &target_base_opnd, 
00619                                    tmp_sub_idx,
00620                                    0);
00621 
00622 
00623       OPND_FLD((*top_opnd)) = AT_Tbl_Idx;
00624       OPND_IDX((*top_opnd)) = tmp_idx;
00625       OPND_LINE_NUM((*top_opnd)) = line;
00626       OPND_COL_NUM((*top_opnd))  = col;
00627 
00628       ok = gen_whole_subscript(top_opnd, exp_desc) && ok;
00629 
00630       exp_desc->tmp_reference = TRUE;
00631       exp_desc->contig_array = TRUE;
00632    }
00633    else {
00634       /* this is the guess type */
00635 
00636       tmp_idx                   = gen_compiler_tmp(line, col, Priv, TRUE);
00637       AT_SEMANTICS_DONE(tmp_idx)= TRUE;
00638 
00639       ATD_TYPE_IDX(tmp_idx)     = type_idx;
00640 
00641       assign_storage_blk(tmp_idx);
00642 
00643       ATD_ALLOCATABLE(tmp_idx)  = TRUE;
00644 
00645       ATD_ARRAY_IDX(tmp_idx)    = BD_DEFERRED_1_IDX;
00646 
00647       save_curr_stmt_sh_idx     = curr_stmt_sh_idx;
00648       curr_stmt_sh_idx          = SH_PREV_IDX(curr_stmt_sh_idx);
00649 
00650       gen_entry_dope_code(tmp_idx);
00651 
00652       curr_stmt_sh_idx = save_curr_stmt_sh_idx;
00653 
00654       /* set up original size */
00655 
00656       GEN_COMPILER_TMP_ASG(asg_idx,
00657                            size_limit_attr,
00658                            TRUE,        /* Semantics is done */
00659                            stmt_start_line,
00660                            stmt_start_col,
00661                            SA_INTEGER_DEFAULT_TYPE,
00662                            Priv);
00663 
00664       IR_FLD_R(asg_idx) = CN_Tbl_Idx;
00665       IR_IDX_R(asg_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
00666                                       CONSTRUCTOR_GUESS_SIZE);
00667       IR_LINE_NUM_R(asg_idx) = line;
00668       IR_COL_NUM_R(asg_idx)  = col;
00669 
00670       gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00671       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
00672       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00673 
00674 
00675       NTR_IR_TBL(dv_idx);
00676       IR_OPR(dv_idx) = Dv_Set_Low_Bound;
00677       IR_TYPE_IDX(dv_idx) = SA_INTEGER_DEFAULT_TYPE;
00678       IR_LINE_NUM(dv_idx) = line;
00679       IR_COL_NUM(dv_idx)  = col;
00680 
00681       IR_FLD_L(dv_idx) = AT_Tbl_Idx;
00682       IR_IDX_L(dv_idx) = tmp_idx;
00683       IR_LINE_NUM_L(dv_idx) = line;
00684       IR_COL_NUM_L(dv_idx)  = col;
00685 
00686       IR_FLD_R(dv_idx) = CN_Tbl_Idx;
00687       IR_IDX_R(dv_idx) = CN_INTEGER_ONE_IDX;
00688       IR_LINE_NUM_R(dv_idx) = line;
00689       IR_COL_NUM_R(dv_idx)  = col;
00690 
00691       IR_DV_DIM(dv_idx) = 1;
00692 
00693       gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00694       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = dv_idx;
00695       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00696 
00697       NTR_IR_TBL(dv_idx);
00698       IR_OPR(dv_idx) = Dv_Set_Extent;
00699       IR_TYPE_IDX(dv_idx) = SA_INTEGER_DEFAULT_TYPE;
00700       IR_LINE_NUM(dv_idx) = line;
00701       IR_COL_NUM(dv_idx)  = col;
00702 
00703       IR_FLD_L(dv_idx) = AT_Tbl_Idx;
00704       IR_IDX_L(dv_idx) = tmp_idx;
00705       IR_LINE_NUM_L(dv_idx) = line;
00706       IR_COL_NUM_L(dv_idx)  = col;
00707 
00708       IR_FLD_R(dv_idx) = CN_Tbl_Idx;
00709       IR_IDX_R(dv_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 
00710                                      CONSTRUCTOR_GUESS_SIZE);
00711       IR_LINE_NUM_R(dv_idx) = line;
00712       IR_COL_NUM_R(dv_idx)  = col;
00713 
00714       IR_DV_DIM(dv_idx) = 1;
00715 
00716       gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00717       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = dv_idx;
00718       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00719 
00720       NTR_IR_TBL(dv_idx);
00721       IR_OPR(dv_idx) = Dv_Set_Stride_Mult;
00722       IR_TYPE_IDX(dv_idx) = SA_INTEGER_DEFAULT_TYPE;
00723       IR_LINE_NUM(dv_idx) = line;
00724       IR_COL_NUM(dv_idx)  = col;
00725 
00726       IR_FLD_L(dv_idx)  = AT_Tbl_Idx;
00727       IR_IDX_L(dv_idx)  = tmp_idx;
00728       IR_LINE_NUM_L(dv_idx) = line;
00729       IR_COL_NUM_L(dv_idx)  = col;
00730       type_idx          = ATD_TYPE_IDX(tmp_idx);
00731 
00732       switch (TYP_TYPE(type_idx)) {
00733 
00734          case Typeless:
00735             IR_FLD_R(dv_idx) = CN_Tbl_Idx;
00736             IR_IDX_R(dv_idx) = C_INT_TO_CN(NULL_IDX,
00737                                      STORAGE_WORD_SIZE(TYP_BIT_LEN(type_idx)));
00738             IR_LINE_NUM_R(dv_idx) = line;
00739             IR_COL_NUM_R(dv_idx)  = col;
00740             break;
00741 
00742          case Integer:
00743          case Logical:
00744          case CRI_Ptr:
00745          case CRI_Ch_Ptr:
00746          case Real:
00747          case Complex:
00748             the_constant        = TARGET_BITS_TO_WORDS(storage_bit_size_tbl[
00749                                                        TYP_LINEAR(type_idx)]);
00750             IR_FLD_R(dv_idx)    = CN_Tbl_Idx;
00751             IR_IDX_R(dv_idx)    = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
00752                                               the_constant);
00753             IR_LINE_NUM_R(dv_idx) = line;
00754             IR_COL_NUM_R(dv_idx)  = col;
00755             break;
00756 
00757          case Character:  /* This is really number of bytes */
00758             IR_FLD_R(dv_idx)    = TYP_FLD(type_idx);
00759             IR_IDX_R(dv_idx)    = TYP_IDX(type_idx);
00760             IR_LINE_NUM_R(dv_idx) = line;
00761             IR_COL_NUM_R(dv_idx)  = col;
00762 
00763             break;
00764 
00765          case Structure:
00766             size.fld    = ATT_STRUCT_BIT_LEN_FLD(TYP_IDX(type_idx));
00767             size.idx    = ATT_STRUCT_BIT_LEN_IDX(TYP_IDX(type_idx));
00768 
00769             BITS_TO_WORDS(size, TARGET_BITS_PER_WORD);
00770 
00771             if (size.fld == NO_Tbl_Idx) {
00772                IR_FLD_R(dv_idx) = CN_Tbl_Idx;
00773                IR_IDX_R(dv_idx) = ntr_const_tbl(size.type_idx,
00774                                                 FALSE,
00775                                                 size.constant);
00776             }
00777             else {
00778                IR_FLD_R(dv_idx) = size.fld;
00779                IR_IDX_R(dv_idx) = size.idx;
00780             }
00781 
00782             IR_LINE_NUM_R(dv_idx) = line;
00783             IR_COL_NUM_R(dv_idx)  = col;
00784             break;
00785 
00786       }  /* end switch */
00787 
00788       IR_DV_DIM(dv_idx) = 1;
00789 
00790       gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00791       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = dv_idx;
00792       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00793 
00794 
00795       allocate_tmp_idx = create_alloc_descriptor(1,line,col,FALSE);
00796 
00797       /* put loc of dope vector into tmp_array */
00798 
00799 
00800       NTR_IR_TBL(loc_idx);
00801       IR_OPR(loc_idx)           = Aloc_Opr;
00802       IR_TYPE_IDX(loc_idx)      = CRI_Ptr_8;
00803       IR_LINE_NUM(loc_idx)      = line;
00804       IR_COL_NUM(loc_idx)       = col;
00805       IR_FLD_L(loc_idx)         = AT_Tbl_Idx;
00806       IR_IDX_L(loc_idx)         = tmp_idx;
00807       IR_LINE_NUM_L(loc_idx)    = line;
00808       IR_COL_NUM_L(loc_idx)     = col;
00809 
00810       NTR_IR_TBL(asg_idx);
00811       IR_OPR(asg_idx) = Asg_Opr;
00812       IR_TYPE_IDX(asg_idx) = SA_INTEGER_DEFAULT_TYPE;
00813       IR_LINE_NUM(asg_idx) = line;
00814       IR_COL_NUM(asg_idx)  = col;
00815 
00816       IR_FLD_R(asg_idx) = IR_Tbl_Idx;
00817       IR_IDX_R(asg_idx) = loc_idx;
00818 
00819       NTR_IR_TBL(subscript_idx);
00820       IR_OPR(subscript_idx) = Subscript_Opr;
00821       IR_TYPE_IDX(subscript_idx) = SA_INTEGER_DEFAULT_TYPE;
00822       IR_LINE_NUM(subscript_idx) = line;
00823       IR_COL_NUM(subscript_idx)  = col;
00824       IR_FLD_L(subscript_idx) = AT_Tbl_Idx;
00825       IR_IDX_L(subscript_idx) = allocate_tmp_idx;
00826       IR_LINE_NUM_L(subscript_idx) = line;
00827       IR_COL_NUM_L(subscript_idx)  = col;
00828 
00829       IR_FLD_L(asg_idx) = IR_Tbl_Idx;
00830       IR_IDX_L(asg_idx) = subscript_idx;
00831 
00832       the_constant = 2;
00833 
00834 # if defined(GENERATE_WHIRL)
00835       if (TYP_LINEAR(ATD_TYPE_IDX(allocate_tmp_idx)) == Integer_4) {
00836          the_constant++;
00837       }
00838 # endif
00839 
00840       NTR_IR_LIST_TBL(list_idx);
00841       IL_FLD(list_idx) = CN_Tbl_Idx;
00842       IL_IDX(list_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, the_constant);
00843       IL_LINE_NUM(list_idx) = line;
00844       IL_COL_NUM(list_idx)  = col;
00845 
00846       IR_FLD_R(subscript_idx) = IL_Tbl_Idx;
00847       IR_LIST_CNT_R(subscript_idx) = 1;
00848       IR_IDX_R(subscript_idx) = list_idx;
00849 
00850       gen_sh(Before, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
00851       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
00852 
00853       /* set up call to _ALLOCATE */
00854 
00855       NTR_IR_TBL(call_idx);
00856       IR_OPR(call_idx) = Call_Opr;
00857       IR_TYPE_IDX(call_idx) = TYPELESS_DEFAULT_TYPE;
00858       IR_LINE_NUM(call_idx)   = line;
00859       IR_COL_NUM(call_idx)    = col;
00860       IR_LINE_NUM_L(call_idx)   = line;
00861       IR_COL_NUM_L(call_idx)    = col;
00862       IR_FLD_L(call_idx) = AT_Tbl_Idx;
00863 
00864       if (glb_tbl_idx[Allocate_Attr_Idx] == NULL_IDX) {
00865          glb_tbl_idx[Allocate_Attr_Idx] = create_lib_entry_attr(
00866                                                    ALLOCATE_LIB_ENTRY,
00867                                                    ALLOCATE_NAME_LEN,
00868                                                    line,
00869                                                    col);
00870       }
00871 
00872       ADD_ATTR_TO_LOCAL_LIST(glb_tbl_idx[Allocate_Attr_Idx]);
00873 
00874       IR_IDX_L(call_idx) = glb_tbl_idx[Allocate_Attr_Idx];
00875       IR_FLD_R(call_idx) = IL_Tbl_Idx;
00876       IR_LIST_CNT_R(call_idx) = 2;
00877       NTR_IR_LIST_TBL(list_idx);
00878       IR_IDX_R(call_idx) = list_idx;
00879 
00880       NTR_IR_TBL(loc_idx);
00881       IR_OPR(loc_idx)           = Aloc_Opr;
00882       IR_TYPE_IDX(loc_idx)      = CRI_Ptr_8;
00883       IR_LINE_NUM(loc_idx)   = line;
00884       IR_COL_NUM(loc_idx)    = col;
00885       IR_FLD_L(loc_idx)         = AT_Tbl_Idx;
00886       IR_IDX_L(loc_idx)         = allocate_tmp_idx;
00887       IR_LINE_NUM_L(loc_idx)   = line;
00888       IR_COL_NUM_L(loc_idx)    = col;
00889       IL_FLD(list_idx)          = IR_Tbl_Idx;
00890       IL_IDX(list_idx)          = loc_idx;
00891    
00892 
00893       /* no stat */
00894 
00895       NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
00896       list_idx = IL_NEXT_LIST_IDX(list_idx);
00897       IL_FLD(list_idx) = CN_Tbl_Idx;
00898       IL_IDX(list_idx) = CN_INTEGER_ZERO_IDX;
00899       IL_LINE_NUM(list_idx) = line;
00900       IL_COL_NUM(list_idx)  = col;
00901 
00902       gen_sh(Before, Call_Stmt, line, col, FALSE, FALSE, TRUE);
00903       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = call_idx;
00904       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00905 
00906       NTR_IR_TBL(dv_idx);
00907       IR_OPR(dv_idx) = Dv_Deref_Opr;
00908       IR_TYPE_IDX(dv_idx) = ATD_TYPE_IDX(tmp_idx);
00909       IR_LINE_NUM(dv_idx) = line;
00910       IR_COL_NUM(dv_idx)  = col;
00911 
00912       IR_FLD_L(dv_idx) = AT_Tbl_Idx;
00913       IR_IDX_L(dv_idx) = tmp_idx;
00914       IR_LINE_NUM_L(dv_idx) = line;
00915       IR_COL_NUM_L(dv_idx)  = col;
00916 
00917       OPND_FLD(target_base_opnd) = IR_Tbl_Idx;
00918       OPND_IDX(target_base_opnd) = dv_idx;
00919 
00920       create_array_constructor_asg(top_opnd,
00921                                   &target_base_opnd,
00922                                    tmp_sub_idx,
00923                                    size_limit_attr);
00924 
00925 
00926       /* set the index variable back 1 to real size */
00927 
00928       NTR_IR_TBL(asg_idx);
00929       IR_OPR(asg_idx) = Asg_Opr;
00930       IR_TYPE_IDX(asg_idx) = ATD_TYPE_IDX(tmp_sub_idx);
00931       IR_LINE_NUM(asg_idx) = line;
00932       IR_COL_NUM(asg_idx)  = col;
00933 
00934       IR_FLD_L(asg_idx) = AT_Tbl_Idx;
00935       IR_IDX_L(asg_idx) = tmp_sub_idx;
00936       IR_LINE_NUM_L(asg_idx) = line;
00937       IR_COL_NUM_L(asg_idx)  = col;
00938 
00939       NTR_IR_TBL(minus_idx);
00940       IR_OPR(minus_idx) = Minus_Opr;
00941       IR_TYPE_IDX(minus_idx) = SA_INTEGER_DEFAULT_TYPE;
00942       IR_LINE_NUM(minus_idx) = line;
00943       IR_COL_NUM(minus_idx) = col;
00944       IR_FLD_L(minus_idx) = AT_Tbl_Idx;
00945       IR_IDX_L(minus_idx) = tmp_sub_idx;
00946       IR_LINE_NUM_L(minus_idx) = line;
00947       IR_COL_NUM_L(minus_idx) = col;
00948       IR_FLD_R(minus_idx) = CN_Tbl_Idx;
00949       IR_IDX_R(minus_idx) = CN_INTEGER_ONE_IDX;
00950       IR_LINE_NUM_R(minus_idx) = line;
00951       IR_COL_NUM_R(minus_idx) = col;
00952 
00953       IR_FLD_R(asg_idx)   = IR_Tbl_Idx;
00954       IR_IDX_R(asg_idx)   = minus_idx;
00955 
00956       gen_sh(Before, Assignment_Stmt, stmt_start_line, stmt_start_col,
00957              FALSE, FALSE, TRUE);
00958       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
00959       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
00960 
00961       /* compute new bit size */
00962 
00963       GEN_COMPILER_TMP_ASG(asg_idx,
00964                            realloc_size_attr,
00965                            TRUE,   /* Semantics is done */
00966                            line,
00967                            col,
00968                            SA_INTEGER_DEFAULT_TYPE,
00969                            Priv);
00970 
00971       NTR_IR_TBL(ir_idx);
00972       IR_OPR(ir_idx) = Mult_Opr;
00973       IR_TYPE_IDX(ir_idx) = SA_INTEGER_DEFAULT_TYPE;
00974       IR_LINE_NUM(ir_idx)   = line;
00975       IR_COL_NUM(ir_idx)    = col;
00976       IR_FLD_L(ir_idx) = AT_Tbl_Idx;
00977       IR_IDX_L(ir_idx) = tmp_sub_idx;
00978       IR_LINE_NUM_L(ir_idx)   = line;
00979       IR_COL_NUM_L(ir_idx)    = col;
00980 
00981       NTR_IR_TBL(dv_idx);
00982       IR_OPR(dv_idx) = Dv_Access_El_Len;
00983       IR_TYPE_IDX(dv_idx) = SA_INTEGER_DEFAULT_TYPE;
00984       IR_LINE_NUM(dv_idx)   = line;
00985       IR_COL_NUM(dv_idx)    = col;
00986       IR_FLD_L(dv_idx) = AT_Tbl_Idx;
00987       IR_IDX_L(dv_idx) = tmp_idx;
00988       IR_LINE_NUM_L(dv_idx)   = line;
00989       IR_COL_NUM_L(dv_idx)    = col;
00990 
00991       IR_FLD_R(ir_idx) = IR_Tbl_Idx;
00992       IR_IDX_R(ir_idx) = dv_idx;
00993 
00994       if (char_len_in_bytes) {
00995          if (TYP_TYPE(type_idx) == Character) {
00996             /* el len is in bytes */
00997             NTR_IR_TBL(shift_idx);
00998             IR_TYPE_IDX(shift_idx) = SA_INTEGER_DEFAULT_TYPE;
00999             IR_LINE_NUM(shift_idx) = line;
01000             IR_COL_NUM(shift_idx) = col;
01001             IR_OPR(shift_idx) = Shiftl_Opr;
01002 
01003             NTR_IR_LIST_TBL(list_idx);
01004             IR_FLD_L(shift_idx) = IL_Tbl_Idx;
01005             IR_IDX_L(shift_idx) = list_idx;
01006             IR_LIST_CNT_L(shift_idx) = 2;
01007 
01008             COPY_OPND(IL_OPND(list_idx), IR_OPND_R(ir_idx));
01009 
01010             NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
01011             IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
01012             list_idx = IL_NEXT_LIST_IDX(list_idx);
01013 
01014             IL_LINE_NUM(list_idx) = line;
01015             IL_COL_NUM(list_idx) = col;
01016 
01017             IL_FLD(list_idx) = CN_Tbl_Idx;
01018             IL_IDX(list_idx) = CN_INTEGER_THREE_IDX;
01019             IR_IDX_R(ir_idx) = shift_idx;
01020          }
01021       }
01022 
01023       IR_FLD_R(asg_idx) = IR_Tbl_Idx;
01024       IR_IDX_R(asg_idx) = ir_idx;
01025 
01026       gen_sh(Before, Assignment_Stmt, stmt_start_line,
01027              stmt_start_col, FALSE, FALSE, TRUE);
01028 
01029       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))     = asg_idx;
01030       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
01031 
01032       /* realloc the tmp to final size */
01033       /* new size is in bits. (elements * element bit size) */
01034 
01035       if (glb_tbl_idx[Realloc_Attr_Idx] == NULL_IDX) {
01036          glb_tbl_idx[Realloc_Attr_Idx] = 
01037                            create_lib_entry_attr(REALLOC_LIB_ENTRY,
01038                                                  REALLOC_NAME_LEN,
01039                                                  line,
01040                                                  col);
01041       }
01042 
01043       ADD_ATTR_TO_LOCAL_LIST(glb_tbl_idx[Realloc_Attr_Idx]);
01044    
01045       NTR_IR_TBL(call_idx);
01046       IR_OPR(call_idx) = Call_Opr;
01047       IR_TYPE_IDX(call_idx) = TYPELESS_DEFAULT_TYPE;
01048       IR_LINE_NUM(call_idx) = line;
01049       IR_COL_NUM(call_idx)  = col;
01050       IR_FLD_L(call_idx) = AT_Tbl_Idx;
01051       IR_IDX_L(call_idx) = glb_tbl_idx[Realloc_Attr_Idx];
01052       IR_LINE_NUM_L(call_idx) = line;
01053       IR_COL_NUM_L(call_idx)  = col;
01054 
01055       NTR_IR_LIST_TBL(list_idx);
01056       IR_FLD_R(call_idx) = IL_Tbl_Idx;
01057       IR_IDX_R(call_idx) = list_idx;
01058       IR_LIST_CNT_R(call_idx) = 2;
01059 
01060       NTR_IR_TBL(ir_idx);
01061       IR_OPR(ir_idx)            = Aloc_Opr;
01062       IR_TYPE_IDX(ir_idx)       = CRI_Ptr_8;
01063       IR_LINE_NUM(ir_idx)       = line;
01064       IR_COL_NUM(ir_idx)        = col;
01065 
01066       IL_FLD(list_idx) = IR_Tbl_Idx;
01067       IL_IDX(list_idx) = ir_idx;
01068    
01069       IR_FLD_L(ir_idx) = AT_Tbl_Idx;
01070       IR_IDX_L(ir_idx) = tmp_idx;
01071       IR_LINE_NUM_L(ir_idx)     = line;
01072       IR_COL_NUM_L(ir_idx)      = col;
01073       
01074    
01075       NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
01076       list_idx = IL_NEXT_LIST_IDX(list_idx);
01077    
01078       NTR_IR_TBL(ir_idx);
01079       IR_OPR(ir_idx) = Aloc_Opr;
01080       IR_TYPE_IDX(ir_idx) = CRI_Ptr_8;
01081       IR_LINE_NUM(ir_idx) = line;
01082       IR_COL_NUM(ir_idx)  = col;
01083    
01084       IL_FLD(list_idx) = IR_Tbl_Idx;
01085       IL_IDX(list_idx) = ir_idx;
01086    
01087       IR_FLD_L(ir_idx) = AT_Tbl_Idx;
01088       IR_IDX_L(ir_idx) = realloc_size_attr;
01089       IR_LINE_NUM_L(ir_idx)     = line;
01090       IR_COL_NUM_L(ir_idx)      = col;
01091    
01092       gen_sh(Before, Call_Stmt, stmt_start_line,
01093              stmt_start_col, FALSE, FALSE, TRUE);
01094    
01095       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))     = call_idx;
01096       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
01097 
01098 
01099       /* reset the extent */
01100 
01101       NTR_IR_TBL(dv_idx);
01102       IR_OPR(dv_idx) = Dv_Set_Extent;
01103       IR_TYPE_IDX(dv_idx) = SA_INTEGER_DEFAULT_TYPE;
01104       IR_DV_DIM(dv_idx) = 1;
01105       IR_LINE_NUM(dv_idx) = line;
01106       IR_COL_NUM(dv_idx)  = col;
01107 
01108       IR_FLD_L(dv_idx) = AT_Tbl_Idx;
01109       IR_IDX_L(dv_idx) = tmp_idx;
01110       IR_LINE_NUM_L(dv_idx) = line;
01111       IR_COL_NUM_L(dv_idx)  = col;
01112 
01113       IR_FLD_R(dv_idx) = AT_Tbl_Idx;
01114       IR_IDX_R(dv_idx) = tmp_sub_idx;
01115       IR_LINE_NUM_R(dv_idx) = line;
01116       IR_COL_NUM_R(dv_idx)  = col;
01117 
01118       gen_sh(Before, Assignment_Stmt, stmt_start_line,
01119              stmt_start_col, FALSE, FALSE, TRUE);
01120 
01121       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))     = dv_idx;
01122       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
01123 
01124       NTR_IR_TBL(dv_idx);
01125       IR_OPR(dv_idx) = Dv_Deref_Opr;
01126       IR_TYPE_IDX(dv_idx) = ATD_TYPE_IDX(tmp_idx);
01127       IR_LINE_NUM(dv_idx) = line;
01128       IR_COL_NUM(dv_idx)  = col;
01129 
01130       IR_FLD_L(dv_idx) = AT_Tbl_Idx;
01131       IR_IDX_L(dv_idx) = tmp_idx;
01132       IR_LINE_NUM_L(dv_idx) = line;
01133       IR_COL_NUM_L(dv_idx)  = col;
01134 
01135       OPND_FLD((*top_opnd)) = IR_Tbl_Idx;
01136       OPND_IDX((*top_opnd)) = dv_idx;
01137 
01138       NTR_IR_TBL(subscript_idx);
01139       IR_OPR(subscript_idx) = Whole_Subscript_Opr;
01140       IR_TYPE_IDX(subscript_idx) = ATD_TYPE_IDX(tmp_idx);
01141       IR_LINE_NUM(subscript_idx) = line;
01142       IR_COL_NUM(subscript_idx)  = col;
01143 
01144       COPY_OPND(IR_OPND_L(subscript_idx), (*top_opnd));
01145 
01146       NTR_IR_LIST_TBL(list_idx);
01147       IR_FLD_R(subscript_idx) = IL_Tbl_Idx;
01148       IR_IDX_R(subscript_idx) = list_idx;
01149       IR_LIST_CNT_R(subscript_idx) = 1;
01150 
01151       NTR_IR_TBL(dv_idx);
01152       IR_OPR(dv_idx) = Triplet_Opr;
01153       IR_TYPE_IDX(dv_idx) = SA_INTEGER_DEFAULT_TYPE;
01154       IR_LINE_NUM(dv_idx) = line;
01155       IR_COL_NUM(dv_idx) = col;
01156 
01157       IL_FLD(list_idx) = IR_Tbl_Idx;
01158       IL_IDX(list_idx) = dv_idx;
01159 
01160       NTR_IR_LIST_TBL(list_idx);
01161       IR_FLD_L(dv_idx) = IL_Tbl_Idx;
01162       IR_IDX_L(dv_idx) = list_idx;
01163       IR_LIST_CNT_L(dv_idx) = 3;
01164 
01165       IL_FLD(list_idx) = CN_Tbl_Idx;
01166       IL_IDX(list_idx) = CN_INTEGER_ONE_IDX;
01167       IL_LINE_NUM(list_idx) = line;
01168       IL_COL_NUM(list_idx)  = col;
01169 
01170       NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
01171       list_idx = IL_NEXT_LIST_IDX(list_idx);
01172 
01173       IL_FLD(list_idx) = AT_Tbl_Idx;
01174       IL_IDX(list_idx) = tmp_sub_idx;
01175       IL_LINE_NUM(list_idx) = line;
01176       IL_COL_NUM(list_idx)  = col;
01177 
01178       COPY_OPND((exp_desc->shape[0]), IL_OPND(list_idx));
01179       exp_desc->rank = 1;
01180 
01181       NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
01182       list_idx = IL_NEXT_LIST_IDX(list_idx);
01183 
01184       IL_FLD(list_idx) = CN_Tbl_Idx;
01185       IL_IDX(list_idx) = CN_INTEGER_ONE_IDX;
01186       IL_LINE_NUM(list_idx) = line;
01187       IL_COL_NUM(list_idx)  = col;
01188 
01189       OPND_FLD((*top_opnd)) = IR_Tbl_Idx;
01190       OPND_IDX((*top_opnd)) = subscript_idx;
01191 
01192 
01193       exp_desc->reference   = TRUE;
01194       exp_desc->allocatable = TRUE;
01195       exp_desc->contig_array = TRUE;
01196 
01197       if (exp_desc->type == Character) {
01198          ok = gen_whole_substring(top_opnd, exp_desc->rank) && ok;
01199       }
01200 
01201 # if 0
01202      /* call the dope vector dump routine dump_dv */
01203 
01204      dump_dv_idx = create_lib_entry_attr("DUMP_DV",
01205                                          7,
01206                                          line,
01207                                          col);
01208 
01209       ADD_ATTR_TO_LOCAL_LIST(dump_dv_idx);
01210 
01211       NTR_IR_TBL(call_idx);
01212       IR_OPR(call_idx) = Call_Opr;
01213       IR_TYPE_IDX(call_idx) = SA_INTEGER_DEFAULT_TYPE;
01214       IR_LINE_NUM(call_idx) = line;
01215       IR_COL_NUM(call_idx) = col;
01216       IR_FLD_L(call_idx) = AT_Tbl_Idx;
01217       IR_IDX_L(call_idx) = dump_dv_idx;
01218       IR_LINE_NUM_L(call_idx) = line;
01219       IR_COL_NUM_L(call_idx) = col;
01220 
01221       NTR_IR_LIST_TBL(list_idx);
01222       IR_FLD_R(call_idx) = IL_Tbl_Idx;
01223       IR_IDX_R(call_idx) = list_idx;
01224       IR_LIST_CNT_R(call_idx) = 1;
01225 
01226       NTR_IR_TBL(loc_idx);
01227       IR_OPR(loc_idx) = Aloc_Opr;
01228       IR_TYPE_IDX(loc_idx) = CRI_Ptr_8;
01229       IR_LINE_NUM(loc_idx)   = line;
01230       IR_COL_NUM(loc_idx)    = col;
01231       IL_FLD(list_idx) = IR_Tbl_Idx;
01232       IL_IDX(list_idx) = loc_idx;
01233 
01234       IR_FLD_L(loc_idx) = AT_Tbl_Idx;
01235       IR_IDX_L(loc_idx) = tmp_idx;
01236       IR_LINE_NUM_L(loc_idx)   = line;
01237       IR_COL_NUM_L(loc_idx)    = col;
01238 
01239       gen_sh(Before, Call_Stmt, stmt_start_line,
01240              stmt_start_col, FALSE, FALSE, TRUE);
01241 
01242       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))     = call_idx;
01243       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
01244 
01245 # endif
01246 
01247       if (glb_tbl_idx[Dealloc_Attr_Idx] == NULL_IDX) {
01248          glb_tbl_idx[Dealloc_Attr_Idx] = create_lib_entry_attr(
01249                                                     DEALLOC_LIB_ENTRY,
01250                                                     DEALLOC_NAME_LEN,
01251                                                     line,
01252                                                     col);
01253       }
01254 
01255       ADD_ATTR_TO_LOCAL_LIST(glb_tbl_idx[Dealloc_Attr_Idx]);
01256 
01257       save_curr_stmt_sh_idx = curr_stmt_sh_idx;
01258 
01259 # ifdef _ALLOCATE_IS_CALL
01260       /* create array to send to DEALLOC */
01261 
01262       allocate_tmp_idx = create_alloc_descriptor(1, line, col,FALSE);
01263 
01264       /* put loc of dope vector, tmp_idx, into allocate_tmp_idx(1) */
01265 
01266       NTR_IR_TBL(subscript_idx);
01267       IR_OPR(subscript_idx) = Subscript_Opr;
01268       IR_TYPE_IDX(subscript_idx) = SA_INTEGER_DEFAULT_TYPE;
01269       IR_LINE_NUM(subscript_idx) = line;
01270       IR_COL_NUM(subscript_idx)  = col;
01271       IR_FLD_L(subscript_idx)    = AT_Tbl_Idx;
01272       IR_IDX_L(subscript_idx)    = allocate_tmp_idx;
01273       IR_LINE_NUM_L(subscript_idx) = line;
01274       IR_COL_NUM_L(subscript_idx)  = col;
01275 
01276       NTR_IR_LIST_TBL(list_idx);
01277       IR_FLD_R(subscript_idx) = IL_Tbl_Idx;
01278       IR_IDX_R(subscript_idx) = list_idx;
01279       IR_LIST_CNT_R(subscript_idx) = 1;
01280 
01281       IL_FLD(list_idx) = CN_Tbl_Idx;
01282       the_constant     = 2L;
01283 
01284 # if defined(GENERATE_WHIRL)
01285       if (TYP_LINEAR(ATD_TYPE_IDX(allocate_tmp_idx)) == Integer_4) {
01286          the_constant++;
01287       }
01288 # endif
01289 
01290       IL_IDX(list_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
01291                                      the_constant);
01292       IL_LINE_NUM(list_idx) = line;
01293       IL_COL_NUM(list_idx)  = col;
01294 
01295       NTR_IR_TBL(asg_idx);
01296       IR_OPR(asg_idx) = Asg_Opr;
01297       IR_TYPE_IDX(asg_idx) = SA_INTEGER_DEFAULT_TYPE;
01298 
01299       IR_LINE_NUM(asg_idx) = line;
01300       IR_COL_NUM(asg_idx)  = col;
01301       IR_FLD_L(asg_idx)    = IR_Tbl_Idx;
01302       IR_IDX_L(asg_idx)    = subscript_idx;
01303       NTR_IR_TBL(loc_idx);
01304       IR_OPR(loc_idx)      = Loc_Opr;
01305       IR_TYPE_IDX(loc_idx) = CRI_Ptr_8;
01306       IR_LINE_NUM(loc_idx) = line;
01307       IR_COL_NUM(loc_idx)  = col;
01308 
01309       IR_FLD_R(asg_idx)    = IR_Tbl_Idx;
01310       IR_IDX_R(asg_idx)    = loc_idx;
01311 
01312       IR_FLD_L(loc_idx)    = AT_Tbl_Idx;
01313       IR_IDX_L(loc_idx)    = tmp_idx;
01314       IR_LINE_NUM_L(loc_idx) = line;
01315       IR_COL_NUM_L(loc_idx)  = col;
01316 
01317       gen_sh(After, Assignment_Stmt, line, col, FALSE, FALSE, TRUE);
01318       SH_IR_IDX(curr_stmt_sh_idx) = asg_idx;
01319       SH_P2_SKIP_ME(curr_stmt_sh_idx) = TRUE;
01320 
01321       /* now set up call to DEALLOC */
01322 
01323       NTR_IR_TBL(call_idx);
01324       IR_OPR(call_idx) = Call_Opr;
01325       IR_TYPE_IDX(call_idx) = TYPELESS_DEFAULT_TYPE;
01326       IR_LINE_NUM(call_idx) = line;
01327       IR_COL_NUM(call_idx)  = col;
01328       IR_FLD_L(call_idx) = AT_Tbl_Idx;
01329       IR_IDX_L(call_idx) = glb_tbl_idx[Dealloc_Attr_Idx];
01330       IR_LINE_NUM_L(call_idx) = line;
01331       IR_COL_NUM_L(call_idx)  = col;
01332 
01333       NTR_IR_LIST_TBL(list_idx);
01334       IR_FLD_R(call_idx) = IL_Tbl_Idx;
01335       IR_IDX_R(call_idx) = list_idx;
01336       IR_LIST_CNT_R(call_idx) = 1;
01337 
01338       NTR_IR_TBL(loc_idx);
01339       IR_OPR(loc_idx)    = Aloc_Opr;
01340       IR_TYPE_IDX(loc_idx) = CRI_Ptr_8;
01341       IR_FLD_L(loc_idx)  = AT_Tbl_Idx;
01342       IR_IDX_L(loc_idx)  = allocate_tmp_idx;
01343       IR_LINE_NUM(loc_idx) = line;
01344       IR_COL_NUM(loc_idx)  = col;
01345       IR_LINE_NUM_L(loc_idx) = line;
01346       IR_COL_NUM_L(loc_idx)  = col;
01347       IL_FLD(list_idx)   = IR_Tbl_Idx;
01348       IL_IDX(list_idx)   = loc_idx;
01349 
01350       gen_sh(After, Call_Stmt, line, col, FALSE, FALSE, TRUE);
01351       SH_IR_IDX(curr_stmt_sh_idx) = call_idx;
01352       SH_P2_SKIP_ME(curr_stmt_sh_idx) = TRUE;
01353 
01354 # else
01355       NTR_IR_TBL(asg_idx);
01356       IR_OPR(asg_idx) = Deallocate_Opr;
01357       IR_TYPE_IDX(asg_idx) = TYPELESS_DEFAULT_TYPE;
01358       IR_LINE_NUM(asg_idx) = line;
01359       IR_COL_NUM(asg_idx)  = col;
01360 
01361       NTR_IR_LIST_TBL(list_idx);
01362       IR_FLD_L(asg_idx) = IL_Tbl_Idx;
01363       IR_IDX_L(asg_idx) = list_idx;
01364       IR_LIST_CNT_L(asg_idx) = 1;
01365 
01366       NTR_IR_TBL(loc_idx);
01367       IR_OPR(loc_idx)             = Aloc_Opr;
01368       IR_TYPE_IDX(loc_idx)        = CRI_Ptr_8;
01369       IR_FLD_L(loc_idx)           = AT_Tbl_Idx;
01370       IR_IDX_L(loc_idx)           = tmp_idx;
01371       IR_LINE_NUM(loc_idx)        = line;
01372       IR_COL_NUM(loc_idx)         = col;
01373       IR_LINE_NUM_L(loc_idx)      = line;
01374       IR_COL_NUM_L(loc_idx)       = col;
01375       IL_FLD(list_idx)            = IR_Tbl_Idx;
01376       IL_IDX(list_idx)            = loc_idx;
01377 
01378       NTR_IR_LIST_TBL(list_idx);
01379       IR_FLD_R(asg_idx) = IL_Tbl_Idx;
01380       IR_IDX_R(asg_idx) = list_idx;
01381       IR_LIST_CNT_R(asg_idx) = 3;
01382       IL_FLD(list_idx) = AT_Tbl_Idx;
01383       IL_IDX(list_idx) = glb_tbl_idx[Dealloc_Attr_Idx];
01384       IL_LINE_NUM(list_idx) = line;
01385       IL_COL_NUM(list_idx)  = col;
01386 
01387       NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
01388       IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
01389       list_idx = IL_NEXT_LIST_IDX(list_idx);
01390 
01391       IL_FLD(list_idx) = CN_Tbl_Idx;
01392       IL_IDX(list_idx) = gen_alloc_header_const(Integer_8,
01393                                                 1, 
01394                                                 FALSE,
01395                                                 &cn_idx);
01396       IL_LINE_NUM(list_idx) = line;
01397       IL_COL_NUM(list_idx)  = col;
01398 
01399       NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
01400       IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
01401       list_idx = IL_NEXT_LIST_IDX(list_idx);
01402 
01403       IL_FLD(list_idx) = CN_Tbl_Idx;
01404       IL_IDX(list_idx) = CN_INTEGER_ZERO_IDX;
01405       IL_LINE_NUM(list_idx) = line;
01406       IL_COL_NUM(list_idx)  = col;
01407 
01408       gen_sh(After, Call_Stmt, line, col, FALSE, FALSE, TRUE);
01409       SH_IR_IDX(curr_stmt_sh_idx) = asg_idx;
01410       SH_P2_SKIP_ME(curr_stmt_sh_idx) = TRUE;
01411 # endif
01412 
01413       curr_stmt_sh_idx = save_curr_stmt_sh_idx;
01414    }
01415 
01416    in_constructor = save_in_constructor;
01417 
01418    defer_stmt_expansion = save_defer_stmt_expansion;
01419    stmt_expansion_control_end(top_opnd);
01420 
01421    TRACE (Func_Exit, "create_runtime_array_constructor", NULL);
01422 
01423    return(ok);
01424 
01425 }  /* create_runtime_array_constructor */
01426 
01427 /******************************************************************************\
01428 |*                                                                            *|
01429 |* Description:                                                               *|
01430 |*      The main entry point for run time struct constructors. This is a much *|
01431 |*      simpler problem than the run time array constructors since we know    *|
01432 |*      the size at compile time. We just need to generate the run time       *|
01433 |*      assignments.                                                          *|
01434 |*                                                                            *|
01435 |* Input parameters:                                                          *|
01436 |*      top_opnd - original tree.                                             *|
01437 |*                                                                            *|
01438 |* Output parameters:                                                         *|
01439 |*      top_opnd - tmp reference.                                             *|
01440 |*                                                                            *|
01441 |* Returns:                                                                   *|
01442 |*      TRUE if no errors.                                                    *|
01443 |*                                                                            *|
01444 \******************************************************************************/
01445 
01446 boolean create_runtime_struct_constructor(opnd_type     *top_opnd)
01447 
01448 {
01449    int                  col;
01450    int                  ir_idx;
01451    int                  line;
01452    boolean              ok = TRUE;
01453    opnd_type            opnd;
01454    boolean              save_defer_stmt_expansion;
01455    int                  tmp_idx;
01456 
01457 
01458    TRACE (Func_Entry, "create_runtime_struct_constructor", NULL);
01459 
01460    stmt_expansion_control_start();
01461    save_defer_stmt_expansion = defer_stmt_expansion;
01462    defer_stmt_expansion = FALSE;
01463 
01464    ir_idx                       = OPND_IDX((*top_opnd));
01465    line                         = IR_LINE_NUM(ir_idx);
01466    col                          = IR_COL_NUM(ir_idx);
01467    tmp_idx                      = gen_compiler_tmp(line, col, Priv, TRUE);
01468    AT_SEMANTICS_DONE(tmp_idx)   = TRUE;
01469    ATD_TYPE_IDX(tmp_idx)        = IR_TYPE_IDX(ir_idx);
01470    ATD_STOR_BLK_IDX(tmp_idx)    = SCP_SB_STACK_IDX(curr_scp_idx);
01471 
01472    OPND_FLD(opnd) = AT_Tbl_Idx;
01473    OPND_IDX(opnd) = tmp_idx;
01474    OPND_LINE_NUM(opnd) = line;
01475    OPND_COL_NUM(opnd)  = col;
01476 
01477    create_struct_constructor_asg(top_opnd,
01478                                  &opnd);
01479 
01480    OPND_FLD((*top_opnd)) = AT_Tbl_Idx;
01481    OPND_IDX((*top_opnd)) = tmp_idx;
01482    OPND_LINE_NUM((*top_opnd)) = line;
01483    OPND_COL_NUM((*top_opnd))  = col;
01484 
01485    defer_stmt_expansion = save_defer_stmt_expansion;
01486    stmt_expansion_control_end(top_opnd);
01487 
01488    TRACE (Func_Exit, "create_runtime_struct_constructor", NULL);
01489 
01490    return(ok);
01491 
01492 }  /* create_runtime_struct_constructor */
01493 
01494 /******************************************************************************\
01495 |*                                                                            *|
01496 |* Description:                                                               *|
01497 |*      Analyse implied do loops to see if their size can be determined with  *|
01498 |*      a simple expression, runtime loop interpretation, or just a guess/    *|
01499 |*      realloc.                                                              *|
01500 |*                                                                            *|
01501 |* Input parameters:                                                          *|
01502 |*      top_opnd - tree to analyse.                                           *|
01503 |*                                                                            *|
01504 |* Output parameters:                                                         *|
01505 |*      size_opnd - pass back the size expression for this loop. Could involve*|
01506 |*                  other implied do loops.                                   *|
01507 |*      constructor_size_level - simple expression, interpret loops, or guess *|
01508 |*                                                                            *|
01509 |* Returns:                                                                   *|
01510 |*      NOTHING                                                               *|
01511 |*                                                                            *|
01512 \******************************************************************************/
01513 
01514 void analyse_loops(opnd_type       *top_opnd,
01515                    opnd_type       *size_opnd,
01516                    size_level_type *constructor_size_level)
01517 
01518 {
01519    int                  col;
01520    int                  div_idx;
01521    opnd_type            end_opnd;
01522    opnd_type            inc_opnd;
01523    int                  ir_idx;
01524    int                  line;
01525    int                  lcv_attr;
01526    int                  list_idx;
01527    int                  list2_idx;
01528    int                  max_idx;
01529    int                  minus_idx;
01530    opnd_type            mopnd;
01531    int                  mult_idx;
01532    opnd_type            opnd;
01533    int                  plus_idx;
01534    opnd_type            popnd;
01535    size_level_type      size_level_l;
01536    size_level_type      size_level_r;
01537    opnd_type            size_opnd_l;
01538    opnd_type            size_opnd_r;
01539    opnd_type            slice_size_opnd;
01540    opnd_type            start_opnd;
01541 
01542 
01543    TRACE (Func_Entry, "analyse_loops", NULL);
01544 
01545    find_opnd_line_and_column(top_opnd, &line, &col);
01546 
01547    *size_opnd = null_opnd;
01548    OPND_LINE_NUM((*size_opnd)) = line;
01549    OPND_COL_NUM((*size_opnd))  = col;
01550 
01551    switch(OPND_FLD((*top_opnd))) {
01552       case CN_Tbl_Idx :
01553          OPND_FLD((*size_opnd)) = CN_Tbl_Idx;
01554          OPND_IDX((*size_opnd)) = CN_INTEGER_ONE_IDX;
01555          break;
01556 
01557       case AT_Tbl_Idx  :
01558          OPND_FLD((*size_opnd)) = CN_Tbl_Idx;
01559          OPND_IDX((*size_opnd)) = CN_INTEGER_ONE_IDX;
01560          break;
01561 
01562       case IR_Tbl_Idx  :
01563 
01564          ir_idx = OPND_IDX((*top_opnd));
01565 
01566          switch(IR_OPR(ir_idx)) {
01567 
01568             case Array_Construct_Opr   :
01569             case Constant_Array_Construct_Opr   :
01570 
01571                /* determine size expr for slice */
01572                determine_slice_size(IR_IDX_R(ir_idx), size_opnd, 
01573                                     constructor_size_level);
01574 
01575                break;
01576 
01577             case Struct_Construct_Opr  :
01578             case Constant_Struct_Construct_Opr  :
01579 
01580                OPND_FLD((*size_opnd)) = CN_Tbl_Idx;
01581                OPND_IDX((*size_opnd)) = CN_INTEGER_ONE_IDX;
01582                break;
01583 
01584             case Implied_Do_Opr        :
01585 
01586                determine_slice_size(IR_IDX_L(ir_idx), &slice_size_opnd,
01587                                     constructor_size_level);
01588 
01589                line = IR_LINE_NUM(ir_idx);
01590                col  = IR_COL_NUM(ir_idx);
01591 
01592                list_idx = IR_IDX_R(ir_idx);
01593                lcv_attr = IL_IDX(list_idx);
01594 
01595                list_idx = IL_NEXT_LIST_IDX(list_idx);
01596                COPY_OPND(start_opnd, IL_OPND(list_idx));
01597                
01598                list_idx = IL_NEXT_LIST_IDX(list_idx);
01599                COPY_OPND(end_opnd, IL_OPND(list_idx));
01600                
01601                list_idx = IL_NEXT_LIST_IDX(list_idx);
01602                COPY_OPND(inc_opnd, IL_OPND(list_idx));
01603                
01604                if (*constructor_size_level == Simple_Expr_Size) {
01605                   /* see if trip count is invariant */
01606 
01607                   minus_idx = gen_ir(OPND_FLD(end_opnd), OPND_IDX(end_opnd),
01608                                  Minus_Opr, SA_INTEGER_DEFAULT_TYPE, line, col,
01609                                      OPND_FLD(start_opnd),OPND_IDX(start_opnd));
01610 
01611                   plus_idx = gen_ir(IR_Tbl_Idx, minus_idx,
01612                                 Plus_Opr, SA_INTEGER_DEFAULT_TYPE, line, col,
01613                                     OPND_FLD(inc_opnd), OPND_IDX(inc_opnd));
01614 
01615                   div_idx = gen_ir(IR_Tbl_Idx, plus_idx,
01616                                Div_Opr, SA_INTEGER_DEFAULT_TYPE, line, col,
01617                                    OPND_FLD(inc_opnd), OPND_IDX(inc_opnd));
01618 
01619                   NTR_IR_TBL(max_idx);
01620                   IR_OPR(max_idx)       = Max_Opr;
01621                   IR_TYPE_IDX(max_idx)  = SA_INTEGER_DEFAULT_TYPE;
01622                   IR_LINE_NUM(max_idx)  = line;
01623                   IR_COL_NUM(max_idx)   = col;
01624                   IR_FLD_L(max_idx)     = IL_Tbl_Idx;
01625                   IR_LIST_CNT_L(max_idx)= 2;
01626                   NTR_IR_LIST_TBL(list2_idx);
01627                   IR_IDX_L(max_idx)     = list2_idx;
01628                   IL_FLD(list2_idx)     = CN_Tbl_Idx;
01629                   IL_IDX(list2_idx)     = CN_INTEGER_ZERO_IDX;
01630                   IL_LINE_NUM(list2_idx) = line;
01631                   IL_COL_NUM(list2_idx)  = col;
01632 
01633                   NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list2_idx));
01634                   IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = list2_idx;
01635                   list2_idx = IL_NEXT_LIST_IDX(list2_idx);
01636 
01637                   IL_FLD(list2_idx) = IR_Tbl_Idx;
01638                   IL_IDX(list2_idx) = div_idx;
01639 
01640                   OPND_FLD(mopnd) = IR_Tbl_Idx;
01641                   OPND_IDX(mopnd) = max_idx;
01642 
01643                   check_for_dependencies(&mopnd, constructor_size_level);
01644                }
01645    
01646                if (*constructor_size_level == Guess_Size) {
01647                   *size_opnd = null_opnd;
01648                   goto EXIT;
01649                }
01650                else if (*constructor_size_level == Simple_Expr_Size) {
01651                   mult_idx = gen_ir(OPND_FLD(mopnd), OPND_IDX(mopnd),
01652                                 Mult_Opr, SA_INTEGER_DEFAULT_TYPE, line, col,
01653                                     OPND_FLD(slice_size_opnd),
01654                                             OPND_IDX(slice_size_opnd));
01655 
01656                   OPND_FLD((*size_opnd)) = IR_Tbl_Idx;
01657                   OPND_IDX((*size_opnd)) = mult_idx;
01658 
01659                }
01660                else {
01661                   /* set up implied do around slice size expr */
01662                   NTR_IR_TBL(ir_idx);
01663                   IR_OPR(ir_idx) = Implied_Do_Opr;
01664                   IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
01665                   IR_LINE_NUM(ir_idx) = line;
01666                   IR_COL_NUM(ir_idx)  = col;
01667 
01668                   NTR_IR_LIST_TBL(list_idx);
01669                   IR_FLD_R(ir_idx) = IL_Tbl_Idx;
01670                   IR_IDX_R(ir_idx) = list_idx;
01671                   IR_LIST_CNT_R(ir_idx) = 4;
01672      
01673                   IL_FLD(list_idx) = AT_Tbl_Idx;
01674                   IL_IDX(list_idx) = lcv_attr;
01675                   IL_LINE_NUM(list_idx) = line;
01676                   IL_COL_NUM(list_idx)  = col;
01677                   
01678                   NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
01679                   IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
01680                   list_idx = IL_NEXT_LIST_IDX(list_idx);
01681 
01682                   COPY_OPND(IL_OPND(list_idx), start_opnd);
01683 
01684                   NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
01685                   IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
01686                   list_idx = IL_NEXT_LIST_IDX(list_idx);
01687 
01688                   COPY_OPND(IL_OPND(list_idx), end_opnd);
01689 
01690                   NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
01691                   IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
01692                   list_idx = IL_NEXT_LIST_IDX(list_idx);
01693 
01694                   COPY_OPND(IL_OPND(list_idx), inc_opnd);
01695 
01696                   COPY_OPND(IR_OPND_L(ir_idx), slice_size_opnd);
01697 
01698                   OPND_FLD((*size_opnd)) = IR_Tbl_Idx;
01699                   OPND_IDX((*size_opnd)) = ir_idx;
01700                }
01701                
01702                break;
01703 
01704             
01705             case Uplus_Opr             :
01706             case Uminus_Opr            :
01707             case Paren_Opr             :
01708             case Not_Opr               :
01709             case Bnot_Opr              :
01710                COPY_OPND(opnd, IR_OPND_L(ir_idx));
01711                analyse_loops(&opnd, size_opnd, constructor_size_level);
01712                break;
01713 
01714             case Power_Opr             :
01715             case Mult_Opr              :
01716             case Div_Opr               :
01717             case Minus_Opr             :
01718             case Plus_Opr              :
01719             case Concat_Opr            :
01720             case Eq_Opr                :
01721             case Ne_Opr                :
01722             case Lg_Opr                :
01723             case Lt_Opr                :
01724             case Le_Opr                :
01725             case Gt_Opr                :
01726             case Ge_Opr                :
01727             case And_Opr               :
01728             case Or_Opr                :
01729             case Eqv_Opr               :
01730             case Neqv_Opr              :
01731             case Band_Opr              :
01732             case Bor_Opr               :
01733             case Beqv_Opr              :
01734             case Bneqv_Opr             :
01735                size_level_l = *constructor_size_level;
01736                size_level_r = *constructor_size_level;
01737                
01738                COPY_OPND(opnd, IR_OPND_L(ir_idx));
01739                analyse_loops(&opnd, &size_opnd_l, &size_level_l);
01740                COPY_OPND(opnd, IR_OPND_R(ir_idx));
01741                analyse_loops(&opnd, &size_opnd_r, &size_level_r);
01742 
01743                if (OPND_FLD(size_opnd_l) == CN_Tbl_Idx &&
01744                    compare_cn_and_value(OPND_IDX(size_opnd_l), 1, Eq_Opr)) {
01745                   COPY_OPND((*size_opnd), size_opnd_r);
01746                   *constructor_size_level = size_level_r;
01747                }
01748                else if (OPND_FLD(size_opnd_r) == CN_Tbl_Idx &&
01749                         compare_cn_and_value(OPND_IDX(size_opnd_r), 
01750                                              1, 
01751                                              Eq_Opr)) {
01752                   COPY_OPND((*size_opnd), size_opnd_l);
01753                   *constructor_size_level = size_level_l;
01754                }
01755                else if (size_level_l < size_level_r) {
01756                   COPY_OPND((*size_opnd), size_opnd_l);
01757                   *constructor_size_level = size_level_l;
01758                }
01759                else {
01760                   COPY_OPND((*size_opnd), size_opnd_r);
01761                   *constructor_size_level = size_level_r;
01762                }
01763                break;
01764 
01765             case Whole_Subscript_Opr   :
01766             case Section_Subscript_Opr :
01767 
01768                mopnd = null_opnd;
01769 
01770                list_idx = IR_IDX_R(ir_idx);
01771 
01772                while (list_idx) {
01773 
01774                   COPY_OPND(opnd, IL_OPND(list_idx));
01775                   analyse_loops(&opnd, &popnd, constructor_size_level);
01776 
01777                   if (*constructor_size_level == Guess_Size) {
01778                      *size_opnd = null_opnd;
01779                      goto EXIT;
01780                   }
01781 
01782                   if (OPND_FLD(mopnd) == NO_Tbl_Idx) {
01783                      COPY_OPND(mopnd, popnd);
01784                   }
01785                   else {
01786                      NTR_IR_TBL(mult_idx);
01787                      IR_OPR(mult_idx) = Mult_Opr;
01788                      IR_TYPE_IDX(mult_idx) = SA_INTEGER_DEFAULT_TYPE;
01789                      IR_LINE_NUM(mult_idx)   = line;
01790                      IR_COL_NUM(mult_idx)    = col;
01791                      COPY_OPND(IR_OPND_L(mult_idx), mopnd);
01792                      COPY_OPND(IR_OPND_R(mult_idx), popnd);
01793                      OPND_FLD(mopnd) = IR_Tbl_Idx;
01794                      OPND_IDX(mopnd) = mult_idx;
01795                   }
01796                   list_idx = IL_NEXT_LIST_IDX(list_idx);
01797                }
01798 
01799                COPY_OPND((*size_opnd), mopnd);
01800                break;
01801 
01802             case Subscript_Opr         :
01803             case Struct_Opr            :
01804             case Whole_Substring_Opr   :
01805             case Substring_Opr         :
01806                COPY_OPND(opnd, IR_OPND_L(ir_idx));
01807                analyse_loops(&opnd, size_opnd, constructor_size_level);
01808                break;
01809 
01810             case Call_Opr              :
01811             /* what about function result sizes that depend on constructors */
01812                break;
01813 
01814             default :
01815                *constructor_size_level = Guess_Size;
01816                *size_opnd = null_opnd;
01817                break;
01818          }
01819          break;
01820 
01821       case IL_Tbl_Idx :
01822          break;
01823    }
01824 
01825 EXIT:
01826 
01827    TRACE (Func_Exit, "analyse_loops", NULL);
01828 
01829    return;
01830 
01831 }  /* analyse_loops */
01832 
01833 /******************************************************************************\
01834 |*                                                                            *|
01835 |* Description:                                                               *|
01836 |*      Called from analyse_loops, this routine looks at the size expression  *|
01837 |*      and determines the constructor_size_level.                            *|
01838 |*                                                                            *|
01839 |* Input parameters:                                                          *|
01840 |*      opnd - top of size expression.                                        *|
01841 |*                                                                            *|
01842 |* Output parameters:                                                         *|
01843 |*      constructor_size_level - simple expr, interp loops, or guess.         *|
01844 |*                                                                            *|
01845 |* Returns:                                                                   *|
01846 |*      NOTHING                                                               *|
01847 |*                                                                            *|
01848 \******************************************************************************/
01849 
01850 static void check_for_dependencies(opnd_type       *opnd,
01851                                    size_level_type *constructor_size_level)
01852 
01853 {
01854    int                  attr_idx;
01855    int                  col;
01856    int                  line;
01857    int                  list_idx;
01858    opnd_type            topnd;
01859 
01860    TRACE (Func_Entry, "check_for_dependencies", NULL);
01861 
01862    if (*constructor_size_level == Guess_Size) {
01863       TRACE (Func_Exit, "check_for_dependencies", NULL);
01864       return;
01865    }
01866 
01867 
01868    switch (OPND_FLD((*opnd))) {
01869       case AT_Tbl_Idx :
01870          attr_idx = OPND_IDX((*opnd));
01871          find_opnd_line_and_column(opnd, &line, &col);
01872 
01873          if (ATD_IMP_DO_LCV(attr_idx)) {
01874             *constructor_size_level = Interp_Loop_Size;
01875          }
01876          else if (ATD_CLASS(attr_idx) == Compiler_Tmp &&
01877                   ATD_FLD(attr_idx) == IR_Tbl_Idx &&
01878                   IR_OPR(ATD_TMP_IDX(attr_idx)) == Asg_Opr &&
01879                   line <= AT_DEF_LINE(attr_idx)) {
01880 
01881             /* replace with the right hand side */
01882             COPY_OPND((*opnd), IR_OPND_R(ATD_TMP_IDX(attr_idx)));
01883             check_for_dependencies(opnd, constructor_size_level);
01884          }
01885          break;
01886       case IR_Tbl_Idx :
01887          if (IR_OPR(OPND_IDX((*opnd))) == Call_Opr) {
01888             *constructor_size_level = Guess_Size;
01889          }
01890          else if (IR_OPR(OPND_IDX((*opnd))) == Stmt_Expansion_Opr) {
01891             *constructor_size_level = Guess_Size;
01892          }
01893          else if (IR_OPR(OPND_IDX((*opnd))) == Dv_Access_El_Len ||
01894                   IR_OPR(OPND_IDX((*opnd))) == Dv_Access_Low_Bound ||
01895                   IR_OPR(OPND_IDX((*opnd))) == Dv_Access_Extent ||
01896                   IR_OPR(OPND_IDX((*opnd))) == Dv_Access_Stride_Mult) {
01897 
01898             *constructor_size_level = Guess_Size;
01899          }
01900          else {
01901             COPY_OPND(topnd, IR_OPND_L(OPND_IDX((*opnd))));
01902             check_for_dependencies(&topnd, constructor_size_level);
01903             COPY_OPND(IR_OPND_L(OPND_IDX((*opnd))), topnd);
01904 
01905             if (*constructor_size_level != Guess_Size) {
01906                COPY_OPND(topnd, IR_OPND_R(OPND_IDX((*opnd))));
01907                check_for_dependencies(&topnd, constructor_size_level);
01908                COPY_OPND(IR_OPND_R(OPND_IDX((*opnd))), topnd);
01909             }
01910          }
01911 
01912          break;
01913 
01914       case IL_Tbl_Idx :
01915          list_idx = OPND_IDX((*opnd));
01916          while (list_idx) {
01917 
01918             COPY_OPND(topnd, IL_OPND(list_idx));
01919             check_for_dependencies(&topnd, constructor_size_level);
01920             COPY_OPND(IL_OPND(list_idx), topnd);
01921 
01922             if (*constructor_size_level == Guess_Size) {
01923                break;
01924             }
01925 
01926             list_idx = IL_NEXT_LIST_IDX(list_idx);
01927          }
01928          break;
01929 
01930       case CN_Tbl_Idx :
01931       case NO_Tbl_Idx :
01932          break;
01933    }
01934 
01935    TRACE (Func_Exit, "check_for_dependencies", NULL);
01936 
01937    return;
01938 
01939 }  /* check_for_dependencies */
01940 
01941 /******************************************************************************\
01942 |*                                                                            *|
01943 |* Description:                                                               *|
01944 |*      After the tmp has been allocated, this routine drives the generation  *|
01945 |*      of the run time assignments.                                          *|
01946 |*                                                                            *|
01947 |* Input parameters:                                                          *|
01948 |*      top_opnd - top of constructor tree.                                   *|
01949 |*      target_base_opnd - base of right hand side array.                     *|
01950 |*      target_sub_idx   - subscript attr idx.                                *|
01951 |*      size_limit_attr  - attr used for size test (for guess thing)          *|
01952 |*                                                                            *|
01953 |* Output parameters:                                                         *|
01954 |*      NONE                                                                  *|
01955 |*                                                                            *|
01956 |* Returns:                                                                   *|
01957 |*      NOTHING                                                               *|
01958 |*                                                                            *|
01959 \******************************************************************************/
01960 
01961 static void create_array_constructor_asg(opnd_type *top_opnd,
01962                                          opnd_type *target_base_opnd,
01963                                          int        target_sub_idx,
01964                                          int        size_limit_attr)
01965 
01966 {
01967    int                  attr_idx;
01968    int                  col;
01969    opnd_type            end_opnd;
01970    expr_arg_type        exp_desc;
01971    opnd_type            inc_opnd;
01972    int                  ir_idx;
01973    int                  lcv_attr;
01974    int                  line;
01975    int                  list_idx;
01976    opnd_type            opnd;
01977    int                  place_idx;
01978    int                  save_curr_stmt_sh_idx;
01979    int                  sh_idx;
01980    opnd_type            start_opnd;
01981    int                  sub_idx;
01982 
01983 
01984    TRACE (Func_Entry, "create_array_constructor_asg", NULL);
01985 
01986    if (OPND_FLD((*top_opnd)) == IR_Tbl_Idx) {
01987       ir_idx = OPND_IDX((*top_opnd));
01988    }
01989    else {
01990       find_opnd_line_and_column(top_opnd, &line, &col);
01991       PRINTMSG(line, 985, Internal, col);
01992       return;
01993    }
01994 
01995    if (IR_OPR(ir_idx) == Array_Construct_Opr) {
01996 
01997       do_slice_asg(IR_IDX_R(ir_idx), target_base_opnd, target_sub_idx,
01998                    size_limit_attr);
01999    }
02000    else if (IR_OPR(ir_idx) == Constant_Array_Construct_Opr) {
02001 
02002       exp_desc = arg_info_list[IR_IDX_L(ir_idx)].ed;
02003       create_constructor_constant(top_opnd, &exp_desc);
02004 
02005       do_single_asg(top_opnd, &exp_desc, target_base_opnd, target_sub_idx,
02006                     size_limit_attr);
02007       
02008    }
02009    else if (IR_OPR(ir_idx) == Implied_Do_Opr) {
02010       gen_sh(Before, Assignment_Stmt, IR_LINE_NUM(ir_idx), IR_COL_NUM(ir_idx),
02011              FALSE, FALSE, TRUE);
02012       save_curr_stmt_sh_idx = curr_stmt_sh_idx;
02013       curr_stmt_sh_idx  = SH_PREV_IDX(curr_stmt_sh_idx);
02014       NTR_IR_TBL(place_idx);
02015       IR_OPR(place_idx) = Null_Opr;
02016       SH_IR_IDX(curr_stmt_sh_idx) = place_idx;
02017 
02018       list_idx = IR_IDX_R(ir_idx);
02019       lcv_attr = IL_IDX(list_idx);
02020       list_idx = IL_NEXT_LIST_IDX(list_idx);
02021       COPY_OPND(start_opnd, IL_OPND(list_idx));
02022       expand_stmts(&start_opnd, NULL);
02023 
02024       list_idx = IL_NEXT_LIST_IDX(list_idx);
02025       COPY_OPND(end_opnd, IL_OPND(list_idx));
02026       expand_stmts(&end_opnd, NULL);
02027 
02028       list_idx = IL_NEXT_LIST_IDX(list_idx);
02029       COPY_OPND(inc_opnd, IL_OPND(list_idx));
02030       expand_stmts(&inc_opnd, NULL);
02031 
02032       create_loop_stmts(lcv_attr, 
02033                        &start_opnd,
02034                        &end_opnd,
02035                        &inc_opnd,
02036                         curr_stmt_sh_idx,       /* body start sh idx */
02037                         curr_stmt_sh_idx);      /* body end sh idx */
02038 
02039       do_slice_asg(IR_IDX_L(ir_idx), target_base_opnd, target_sub_idx,
02040                    size_limit_attr);
02041 
02042       /* now remove null place holder stmt. should still be curr_stmt */
02043 
02044       sh_idx = curr_stmt_sh_idx;
02045 
02046       remove_sh(sh_idx);
02047       FREE_IR_NODE(SH_IR_IDX(sh_idx));
02048       FREE_SH_NODE(sh_idx);
02049 
02050       curr_stmt_sh_idx = save_curr_stmt_sh_idx;
02051    }
02052    else if (IR_OPR(ir_idx) == Struct_Construct_Opr) {
02053 
02054       line = IR_LINE_NUM(ir_idx);
02055       col  = IR_COL_NUM(ir_idx);
02056 
02057       NTR_IR_TBL(sub_idx);
02058       IR_OPR(sub_idx) = Subscript_Opr;
02059       IR_TYPE_IDX(sub_idx) = SA_INTEGER_DEFAULT_TYPE;
02060       IR_LINE_NUM(sub_idx) = line;
02061       IR_COL_NUM(sub_idx) = col;
02062       COPY_OPND(IR_OPND_L(sub_idx), (*target_base_opnd));
02063       NTR_IR_LIST_TBL(list_idx);
02064       IR_FLD_R(sub_idx) = IL_Tbl_Idx;
02065       IR_IDX_R(sub_idx) = list_idx;
02066       IR_LIST_CNT_R(sub_idx) = 1;
02067       IL_FLD(list_idx) = AT_Tbl_Idx;
02068       IL_IDX(list_idx) = target_sub_idx;
02069       IL_LINE_NUM(list_idx) = line;
02070       IL_COL_NUM(list_idx)  = col;
02071       
02072       OPND_FLD(opnd) = IR_Tbl_Idx;
02073       OPND_IDX(opnd) = sub_idx;
02074 
02075       create_struct_constructor_asg(top_opnd, &opnd);
02076 
02077       increment_subscript(target_sub_idx);
02078 
02079       if (size_limit_attr) {
02080          attr_idx = find_left_attr(target_base_opnd);
02081          test_size_stmts(attr_idx, target_sub_idx, size_limit_attr);
02082       }
02083    }
02084    else if (IR_OPR(ir_idx) == Constant_Struct_Construct_Opr) {
02085 
02086       create_constructor_constant(top_opnd, &exp_desc);
02087       do_single_asg(top_opnd, &exp_desc, target_base_opnd, target_sub_idx,
02088                     size_limit_attr);
02089    }
02090    else {
02091       PRINTMSG(IR_LINE_NUM(ir_idx), 986, Internal, IR_COL_NUM(ir_idx));
02092    }
02093 
02094    TRACE (Func_Exit, "create_array_constructor_asg", NULL);
02095 
02096    return;
02097 
02098 }  /* create_array_constructor_asg */
02099 
02100 /******************************************************************************\
02101 |*                                                                            *|
02102 |* Description:                                                               *|
02103 |*      This routine drives the generation of a slice of an array constructor *|
02104 |*      (inside an implied do).                                               *|
02105 |*                                                                            *|
02106 |* Input parameters:                                                          *|
02107 |*      list_idx - start of slice list.                                       *|
02108 |*      target_base_opnd - base of right hand side array.                     *|
02109 |*      target_sub_idx   - subscript attr idx.                                *|
02110 |*      size_limit_attr  - attr used for size test (for guess thing)          *|
02111 |*                                                                            *|
02112 |* Output parameters:                                                         *|
02113 |*      NONE                                                                  *|
02114 |*                                                                            *|
02115 |* Returns:                                                                   *|
02116 |*      NOTHING                                                               *|
02117 |*                                                                            *|
02118 \******************************************************************************/
02119 
02120 static void do_slice_asg(int            list_idx,
02121                          opnd_type      *target_base_opnd,
02122                          int            target_sub_idx,
02123                          int            size_limit_attr)
02124 
02125 {
02126    expr_arg_type        exp_desc;
02127    int                  info_idx;
02128    opnd_type            opnd;
02129 
02130 
02131    TRACE (Func_Entry, "do_slice_asg", NULL);
02132 
02133    while (list_idx) {
02134 
02135       if (IL_FLD(list_idx) == IR_Tbl_Idx                        &&
02136           (IR_OPR(IL_IDX(list_idx)) == Array_Construct_Opr  ||
02137            IR_OPR(IL_IDX(list_idx)) == Struct_Construct_Opr ||
02138            IR_OPR(IL_IDX(list_idx)) == Constant_Array_Construct_Opr  ||
02139            IR_OPR(IL_IDX(list_idx)) == Constant_Struct_Construct_Opr ||
02140            IR_OPR(IL_IDX(list_idx)) == Implied_Do_Opr))         {
02141 
02142          COPY_OPND(opnd, IL_OPND(list_idx));
02143          create_array_constructor_asg(&opnd, target_base_opnd, target_sub_idx,
02144                                       size_limit_attr);
02145       }
02146       else {
02147 
02148          info_idx = IL_ARG_DESC_IDX(list_idx);
02149          COPY_OPND(opnd, IL_OPND(list_idx));
02150          exp_desc = arg_info_list[info_idx].ed;
02151          expand_stmts(&opnd, &exp_desc);
02152          COPY_OPND(IL_OPND(list_idx), opnd);
02153 
02154          do_single_asg(&opnd, &exp_desc, target_base_opnd, target_sub_idx,
02155                        size_limit_attr);
02156       }
02157 
02158       list_idx = IL_NEXT_LIST_IDX(list_idx);
02159    }
02160 
02161    TRACE (Func_Exit, "do_slice_asg", NULL);
02162 
02163    return;
02164 
02165 }  /* do_slice_asg */
02166 
02167 /******************************************************************************\
02168 |*                                                                            *|
02169 |* Description:                                                               *|
02170 |*      Called from analyse_loops to create the size expression for a loop    *|
02171 |*      slice.                                                                *|
02172 |*                                                                            *|
02173 |* Input parameters:                                                          *|
02174 |*      list_idx - start of slice list.                                       *|
02175 |*                                                                            *|
02176 |* Output parameters:                                                         *|
02177 |*      size_opnd - top of size expression returned.                          *|
02178 |*      constructor_size_level - simple expr, interp loops, or just guess.    *|
02179 |*                                                                            *|
02180 |* Returns:                                                                   *|
02181 |*      NOTHING                                                               *|
02182 |*                                                                            *|
02183 \******************************************************************************/
02184 
02185 static void determine_slice_size(int             list_idx,
02186                                  opnd_type       *size_opnd,
02187                                  size_level_type *constructor_size_level)
02188 
02189 {
02190    expr_arg_type        exp_desc;
02191    int                  i;
02192    opnd_type            mopnd;
02193    int                  mult_idx;
02194    opnd_type            opnd;
02195    int                  plus_idx;
02196    opnd_type            popnd;
02197    long_type            scalar_cnt;
02198 
02199 
02200    TRACE (Func_Entry, "determine_slice_size", NULL);
02201 
02202    scalar_cnt = 0L;
02203 
02204    popnd = null_opnd;
02205 
02206    while (list_idx) {
02207 
02208       if (IL_FLD(list_idx) == IR_Tbl_Idx &&
02209           (IR_OPR(IL_IDX(list_idx)) == Array_Construct_Opr ||
02210            IR_OPR(IL_IDX(list_idx)) == Constant_Array_Construct_Opr ||
02211            IR_OPR(IL_IDX(list_idx)) == Implied_Do_Opr)) {
02212 
02213          COPY_OPND(opnd, IL_OPND(list_idx));
02214          analyse_loops(&opnd, &mopnd, constructor_size_level);
02215 
02216          if (*constructor_size_level == Guess_Size) {
02217             *size_opnd = null_opnd;
02218             goto EXIT;
02219          }
02220 
02221          if (OPND_FLD(popnd) == NO_Tbl_Idx) {
02222             COPY_OPND(popnd, mopnd);
02223          }
02224          else {
02225             NTR_IR_TBL(plus_idx);
02226             IR_OPR(plus_idx) = Plus_Opr;
02227             IR_TYPE_IDX(plus_idx) = SA_INTEGER_DEFAULT_TYPE;
02228             IR_LINE_NUM(plus_idx) = stmt_start_line;
02229             IR_COL_NUM(plus_idx)  = stmt_start_col;
02230             COPY_OPND(IR_OPND_L(plus_idx), popnd);
02231             COPY_OPND(IR_OPND_R(plus_idx), mopnd);
02232 
02233             OPND_FLD(popnd) = IR_Tbl_Idx;
02234             OPND_IDX(popnd) = plus_idx;
02235          }
02236          list_idx = IL_NEXT_LIST_IDX(list_idx);
02237          continue;
02238       }
02239 
02240       exp_desc = arg_info_list[IL_ARG_DESC_IDX(list_idx)].ed;
02241 
02242       if (exp_desc.has_constructor) {
02243 
02244          COPY_OPND(opnd, IL_OPND(list_idx));
02245          analyse_loops(&opnd, &mopnd, constructor_size_level);
02246 
02247          if (*constructor_size_level == Guess_Size) {
02248             *size_opnd = null_opnd;
02249             goto EXIT;
02250          }
02251 
02252          if (OPND_FLD(popnd) == NO_Tbl_Idx) {
02253             COPY_OPND(popnd, mopnd);
02254          }
02255          else {
02256             NTR_IR_TBL(plus_idx);
02257             IR_OPR(plus_idx) = Plus_Opr;
02258             IR_TYPE_IDX(plus_idx) = SA_INTEGER_DEFAULT_TYPE;
02259             IR_LINE_NUM(plus_idx) = stmt_start_line;
02260             IR_COL_NUM(plus_idx)  = stmt_start_col;
02261             COPY_OPND(IR_OPND_L(plus_idx), popnd);
02262             COPY_OPND(IR_OPND_R(plus_idx), mopnd);
02263             OPND_FLD(popnd) = IR_Tbl_Idx;
02264             OPND_IDX(popnd) = plus_idx;
02265          }
02266       }
02267       else if (exp_desc.rank) {
02268          for (i = 0; i < exp_desc.rank; i++) {
02269 
02270             if (exp_desc.shape[i].fld == NO_Tbl_Idx) {
02271                *constructor_size_level = Guess_Size;
02272                *size_opnd = null_opnd;
02273                goto EXIT;
02274             }
02275 
02276             if (i == 0) {
02277                COPY_OPND(mopnd, exp_desc.shape[i]);
02278                OPND_LINE_NUM(mopnd) = stmt_start_line;
02279                OPND_COL_NUM(mopnd)  = stmt_start_col;
02280             }
02281             else {
02282                NTR_IR_TBL(mult_idx);
02283                IR_OPR(mult_idx) = Mult_Opr;
02284                IR_TYPE_IDX(mult_idx) = SA_INTEGER_DEFAULT_TYPE;
02285                IR_LINE_NUM(mult_idx) = stmt_start_line;
02286                IR_COL_NUM(mult_idx)  = stmt_start_col;
02287                COPY_OPND(IR_OPND_L(mult_idx), mopnd);
02288                COPY_OPND(IR_OPND_R(mult_idx), exp_desc.shape[i]);
02289                IR_LINE_NUM_R(mult_idx) = stmt_start_line;
02290                IR_COL_NUM_R(mult_idx)  = stmt_start_col;
02291                OPND_FLD(mopnd) = IR_Tbl_Idx;
02292                OPND_IDX(mopnd) = mult_idx;
02293             }
02294          }
02295 
02296          check_for_dependencies(&mopnd, constructor_size_level);
02297 
02298          if (*constructor_size_level == Guess_Size) {
02299             *size_opnd = null_opnd;
02300             goto EXIT;
02301          }
02302 
02303          if (OPND_FLD(popnd) == NO_Tbl_Idx) {
02304             COPY_OPND(popnd, mopnd);
02305          }
02306          else {
02307             NTR_IR_TBL(plus_idx);
02308             IR_OPR(plus_idx) = Plus_Opr;
02309             IR_TYPE_IDX(plus_idx) = SA_INTEGER_DEFAULT_TYPE;
02310             IR_LINE_NUM(plus_idx) = stmt_start_line;
02311             IR_COL_NUM(plus_idx)  = stmt_start_col;
02312             COPY_OPND(IR_OPND_L(plus_idx), popnd);
02313             COPY_OPND(IR_OPND_R(plus_idx), mopnd);
02314             OPND_FLD(popnd) = IR_Tbl_Idx;
02315             OPND_IDX(popnd) = plus_idx;
02316          }
02317       }
02318       else {
02319          scalar_cnt++;
02320       }
02321       list_idx = IL_NEXT_LIST_IDX(list_idx);
02322    }
02323 
02324    if (scalar_cnt > 0) {
02325       OPND_FLD(mopnd) = CN_Tbl_Idx;
02326       OPND_IDX(mopnd) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, scalar_cnt);
02327       OPND_LINE_NUM(mopnd) = stmt_start_line;
02328       OPND_COL_NUM(mopnd)  = stmt_start_col;
02329 
02330       if (OPND_FLD(popnd) == NO_Tbl_Idx) {
02331             COPY_OPND(popnd, mopnd);
02332       }
02333       else {
02334          NTR_IR_TBL(plus_idx);
02335          IR_OPR(plus_idx) = Plus_Opr;
02336          IR_TYPE_IDX(plus_idx) = SA_INTEGER_DEFAULT_TYPE;
02337          IR_LINE_NUM(plus_idx) = stmt_start_line;
02338          IR_COL_NUM(plus_idx)  = stmt_start_col;
02339          COPY_OPND(IR_OPND_L(plus_idx), popnd);
02340          COPY_OPND(IR_OPND_R(plus_idx), mopnd);
02341          OPND_FLD(popnd) = IR_Tbl_Idx;
02342          OPND_IDX(popnd) = plus_idx;
02343       }
02344    }
02345 
02346    COPY_OPND((*size_opnd), popnd);
02347 
02348 EXIT:
02349 
02350    TRACE (Func_Exit, "determine_slice_size", NULL);
02351 
02352    return;
02353 
02354 }  /* determine_slice_size */
02355 
02356 /******************************************************************************\
02357 |*                                                                            *|
02358 |* Description:                                                               *|
02359 |*      This routine drives the generation of the loop interpretation stmst.  *|
02360 |*                                                                            *|
02361 |* Input parameters:                                                          *|
02362 |*      ir_idx - top operator of loop                                         *|
02363 |*      size_tmp_idx - attr idx that holds the cumulative size.               *|
02364 |*                                                                            *|
02365 |* Output parameters:                                                         *|
02366 |*      NONE                                                                  *|
02367 |*                                                                            *|
02368 |* Returns:                                                                   *|
02369 |*      NOTHING                                                               *|
02370 |*                                                                            *|
02371 \******************************************************************************/
02372 
02373 static void create_interp_stmts(int        ir_idx,
02374                                 int        size_tmp_idx)
02375 
02376 {
02377    int                  asg_idx;
02378    int                  col;
02379    opnd_type            end_opnd;
02380    opnd_type            inc_opnd;
02381    int                  lcv_attr;
02382    int                  line;
02383    int                  list_idx;
02384    int                  plus_idx;
02385    int                  save_curr_stmt_sh_idx;
02386    int                  sh_idx;
02387    opnd_type            start_opnd;
02388 
02389 
02390    TRACE (Func_Entry, "create_interp_stmts", NULL);
02391 
02392    line = IR_LINE_NUM(ir_idx);
02393    col  = IR_COL_NUM(ir_idx);
02394 
02395    if (IR_OPR(ir_idx) == Implied_Do_Opr) {
02396       save_curr_stmt_sh_idx = curr_stmt_sh_idx;
02397 
02398       gen_sh(Before, Assignment_Stmt, line, col,
02399              FALSE, FALSE, TRUE);
02400 
02401       NTR_IR_TBL(asg_idx);
02402       IR_OPR(asg_idx) = Null_Opr;
02403 
02404       curr_stmt_sh_idx = SH_PREV_IDX(curr_stmt_sh_idx);
02405       SH_IR_IDX(curr_stmt_sh_idx) = asg_idx;
02406 
02407       list_idx = IR_IDX_R(ir_idx);
02408 
02409       lcv_attr = IL_IDX(list_idx);
02410 
02411       list_idx = IL_NEXT_LIST_IDX(list_idx);
02412       COPY_OPND(start_opnd, IL_OPND(list_idx));
02413       
02414       list_idx = IL_NEXT_LIST_IDX(list_idx);
02415       COPY_OPND(end_opnd, IL_OPND(list_idx));
02416       
02417       list_idx = IL_NEXT_LIST_IDX(list_idx);
02418       COPY_OPND(inc_opnd, IL_OPND(list_idx));
02419 
02420       /* there better not be any functions in these expressions */
02421 
02422       create_loop_stmts(lcv_attr,
02423                        &start_opnd,
02424                        &end_opnd,
02425                        &inc_opnd,
02426                         curr_stmt_sh_idx,       /* body start sh idx */
02427                         curr_stmt_sh_idx);      /* body end sh idx */
02428 
02429       if (IR_FLD_L(ir_idx) == IR_Tbl_Idx && 
02430           (IR_OPR(IR_IDX_L(ir_idx)) == Implied_Do_Opr ||
02431            IR_OPR(IR_IDX_L(ir_idx)) == Plus_Opr)) {
02432 
02433 
02434          create_interp_stmts(IR_IDX_L(ir_idx), size_tmp_idx);
02435       }
02436       else {
02437          NTR_IR_TBL(asg_idx);
02438          IR_OPR(asg_idx) = Asg_Opr;
02439          IR_TYPE_IDX(asg_idx) = ATD_TYPE_IDX(size_tmp_idx);
02440          IR_LINE_NUM(asg_idx) = line;
02441          IR_COL_NUM(asg_idx)  = col;
02442          IR_FLD_L(asg_idx) = AT_Tbl_Idx;
02443          IR_IDX_L(asg_idx) = size_tmp_idx;
02444          IR_LINE_NUM_L(asg_idx) = line;
02445          IR_COL_NUM_L(asg_idx)  = col;
02446 
02447          NTR_IR_TBL(plus_idx);
02448          IR_OPR(plus_idx) = Plus_Opr;
02449          IR_TYPE_IDX(plus_idx) = SA_INTEGER_DEFAULT_TYPE;
02450          IR_LINE_NUM(plus_idx) = line;
02451          IR_COL_NUM(plus_idx)  = col;
02452          IR_FLD_R(asg_idx) = IR_Tbl_Idx;
02453          IR_IDX_R(asg_idx) = plus_idx;
02454          IR_FLD_L(plus_idx) = AT_Tbl_Idx;
02455          IR_IDX_L(plus_idx) = size_tmp_idx;
02456          IR_LINE_NUM_L(plus_idx) = line;
02457          IR_COL_NUM_L(plus_idx)  = col;
02458          COPY_OPND(IR_OPND_R(plus_idx), IR_OPND_L(ir_idx));
02459 
02460          gen_sh(Before, Assignment_Stmt, line, col,
02461                 FALSE, FALSE, TRUE);
02462          SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
02463          SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
02464       }
02465 
02466       /* remove null place holder stmt */
02467       sh_idx = curr_stmt_sh_idx;
02468       remove_sh(sh_idx);
02469       FREE_IR_NODE(SH_IR_IDX(sh_idx));
02470       FREE_SH_NODE(sh_idx);
02471 
02472       curr_stmt_sh_idx = save_curr_stmt_sh_idx;
02473    }
02474    else if (IR_OPR(ir_idx) == Plus_Opr) {
02475 
02476       if (IR_FLD_L(ir_idx) == IR_Tbl_Idx &&
02477           (IR_OPR(IR_IDX_L(ir_idx)) == Implied_Do_Opr ||
02478            IR_OPR(IR_IDX_L(ir_idx)) == Plus_Opr)) {
02479 
02480          create_interp_stmts(IR_IDX_L(ir_idx), size_tmp_idx);
02481       }
02482       else {
02483          NTR_IR_TBL(asg_idx);
02484          IR_OPR(asg_idx) = Asg_Opr;
02485          IR_TYPE_IDX(asg_idx) = SA_INTEGER_DEFAULT_TYPE;
02486          IR_LINE_NUM(asg_idx) = line;
02487          IR_COL_NUM(asg_idx)  = col;
02488          IR_FLD_L(asg_idx) = AT_Tbl_Idx;
02489          IR_IDX_L(asg_idx) = size_tmp_idx;
02490          IR_LINE_NUM_L(asg_idx) = line;
02491          IR_COL_NUM_L(asg_idx)  = col;
02492 
02493          NTR_IR_TBL(plus_idx);
02494          IR_OPR(plus_idx) = Plus_Opr;
02495          IR_TYPE_IDX(plus_idx) = SA_INTEGER_DEFAULT_TYPE;
02496          IR_LINE_NUM(plus_idx) = line;
02497          IR_COL_NUM(plus_idx)  = col;
02498          IR_FLD_R(asg_idx) = IR_Tbl_Idx;
02499          IR_IDX_R(asg_idx) = plus_idx;
02500          IR_FLD_L(plus_idx) = AT_Tbl_Idx;
02501          IR_IDX_L(plus_idx) = size_tmp_idx;
02502          IR_LINE_NUM_L(plus_idx) = line;
02503          IR_COL_NUM_L(plus_idx)  = col;
02504          COPY_OPND(IR_OPND_R(plus_idx), IR_OPND_L(ir_idx));
02505 
02506          gen_sh(Before, Assignment_Stmt, line, col,
02507                 FALSE, FALSE, TRUE);
02508          SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
02509          SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
02510       }
02511 
02512       if (IR_FLD_R(ir_idx) == IR_Tbl_Idx &&
02513           (IR_OPR(IR_IDX_R(ir_idx)) == Implied_Do_Opr ||
02514            IR_OPR(IR_IDX_R(ir_idx)) == Plus_Opr)) {
02515 
02516          create_interp_stmts(IR_IDX_R(ir_idx), size_tmp_idx);
02517       }
02518       else {
02519          NTR_IR_TBL(asg_idx);
02520          IR_OPR(asg_idx) = Asg_Opr;
02521          IR_TYPE_IDX(asg_idx) = SA_INTEGER_DEFAULT_TYPE;
02522          IR_LINE_NUM(asg_idx) = line;
02523          IR_COL_NUM(asg_idx)  = col;
02524          IR_FLD_L(asg_idx) = AT_Tbl_Idx;
02525          IR_IDX_L(asg_idx) = size_tmp_idx;
02526          IR_LINE_NUM_L(asg_idx) = line;
02527          IR_COL_NUM_L(asg_idx)  = col;
02528 
02529          NTR_IR_TBL(plus_idx);
02530          IR_OPR(plus_idx) = Plus_Opr;
02531          IR_TYPE_IDX(plus_idx) = SA_INTEGER_DEFAULT_TYPE;
02532          IR_LINE_NUM(plus_idx) = line;
02533          IR_COL_NUM(plus_idx)  = col;
02534          IR_FLD_R(asg_idx) = IR_Tbl_Idx;
02535          IR_IDX_R(asg_idx) = plus_idx;
02536          IR_FLD_L(plus_idx) = AT_Tbl_Idx;
02537          IR_IDX_L(plus_idx) = size_tmp_idx;
02538          IR_LINE_NUM_L(plus_idx) = line;
02539          IR_COL_NUM_L(plus_idx)  = col;
02540          COPY_OPND(IR_OPND_R(plus_idx), IR_OPND_R(ir_idx));
02541 
02542          gen_sh(Before, Assignment_Stmt, line, col,
02543                 FALSE, FALSE, TRUE);
02544          SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
02545          SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
02546       }
02547    }
02548 
02549    TRACE (Func_Exit, "create_interp_stmts", NULL);
02550 
02551    return;
02552 
02553 }  /* create_interp_stmts */
02554 
02555 /******************************************************************************\
02556 |*                                                                            *|
02557 |* Description:                                                               *|
02558 |*      Create single assignment for run time constructors                    *|
02559 |*                                                                            *|
02560 |* Input parameters:                                                          *|
02561 |*      r_opnd - right hand side expression.                                  *|
02562 |*      exp_desc - right hand side expression descriptor.                     *|
02563 |*      target_base_opnd - base of array tmp.                                 *|
02564 |*      target_sub_idx - subscript attr idx.                                  *|
02565 |*      size_limit_attr - attr for size test (guess)                          *|
02566 |*                                                                            *|
02567 |* Output parameters:                                                         *|
02568 |*      NONE                                                                  *|
02569 |*                                                                            *|
02570 |* Returns:                                                                   *|
02571 |*      NOTHING                                                               *|
02572 |*                                                                            *|
02573 \******************************************************************************/
02574 
02575 static void do_single_asg(opnd_type             *r_opnd,
02576                           expr_arg_type         *exp_desc,
02577                           opnd_type             *target_base_opnd,
02578                           int                    target_sub_idx,
02579                           int                    size_limit_attr)
02580 
02581 {
02582    int                  asg_idx;
02583    int                  asg_idx2;
02584    int                  attr_idx;
02585    int                  col;
02586    int                  i;
02587    int                  line;
02588    int                  list2_idx;
02589    int                  minus_idx;
02590    int                  mult_idx;
02591    opnd_type            opnd;
02592    int                  plus_idx;
02593    int                  sub_idx;
02594    int                  tmp_idx;
02595    int                  trip_idx;
02596 
02597 
02598    TRACE (Func_Entry, "do_single_asg", NULL);
02599 
02600    find_opnd_line_and_column(r_opnd, &line, &col);
02601 
02602    if (exp_desc->rank == 0) {
02603 
02604       NTR_IR_TBL(sub_idx);
02605       IR_OPR(sub_idx) = Subscript_Opr;
02606       IR_TYPE_IDX(sub_idx) = exp_desc->type_idx;
02607       IR_LINE_NUM(sub_idx) = line;
02608       IR_COL_NUM(sub_idx)  = col;
02609       COPY_OPND(IR_OPND_L(sub_idx), (*target_base_opnd));
02610 
02611       NTR_IR_LIST_TBL(list2_idx);
02612       IR_FLD_R(sub_idx) = IL_Tbl_Idx;
02613       IR_IDX_R(sub_idx) = list2_idx;
02614       IR_LIST_CNT_R(sub_idx) = 1;
02615 
02616       IL_FLD(list2_idx) = AT_Tbl_Idx;
02617       IL_IDX(list2_idx) = target_sub_idx;
02618       IL_LINE_NUM(list2_idx) = line;
02619       IL_COL_NUM(list2_idx)  = col;
02620 
02621       OPND_FLD(opnd) = IR_Tbl_Idx;
02622       OPND_IDX(opnd) = sub_idx;
02623 
02624       if (exp_desc->type == Character) {
02625          gen_whole_substring(&opnd, 0);
02626       }
02627 
02628       NTR_IR_TBL(asg_idx);
02629       IR_OPR(asg_idx) = Asg_Opr;
02630       IR_TYPE_IDX(asg_idx) = exp_desc->type_idx;
02631       IR_LINE_NUM(asg_idx) = line;
02632       IR_COL_NUM(asg_idx)  = col;
02633       COPY_OPND(IR_OPND_L(asg_idx), opnd);
02634       COPY_OPND(IR_OPND_R(asg_idx), (*r_opnd));
02635 
02636       gen_sh(Before, Assignment_Stmt, line, col,
02637              FALSE, FALSE, TRUE);
02638 
02639       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
02640       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
02641 
02642       increment_subscript(target_sub_idx);
02643 
02644       if (size_limit_attr) {
02645          attr_idx = find_left_attr(target_base_opnd);
02646          test_size_stmts(attr_idx, target_sub_idx, size_limit_attr);
02647       }
02648    }
02649    else if (exp_desc->rank == 1) {
02650 
02651       /* increment target_sub_idx first so we can check it */
02652 
02653       NTR_IR_TBL(asg_idx);
02654       IR_OPR(asg_idx) = Asg_Opr;
02655       IR_TYPE_IDX(asg_idx) = SA_INTEGER_DEFAULT_TYPE;
02656       IR_LINE_NUM(asg_idx) = line;
02657       IR_COL_NUM(asg_idx)  = col;
02658       IR_FLD_L(asg_idx)    = AT_Tbl_Idx;
02659       IR_IDX_L(asg_idx)    = target_sub_idx;
02660       IR_LINE_NUM_L(asg_idx) = line;
02661       IR_COL_NUM_L(asg_idx)  = col;
02662       NTR_IR_TBL(plus_idx);
02663       IR_OPR(plus_idx) = Plus_Opr;
02664       IR_TYPE_IDX(plus_idx) = SA_INTEGER_DEFAULT_TYPE;
02665       IR_LINE_NUM(plus_idx) = line;
02666       IR_COL_NUM(plus_idx)  = col;
02667       IR_FLD_R(asg_idx) = IR_Tbl_Idx;
02668       IR_IDX_R(asg_idx) = plus_idx;
02669 
02670       IR_FLD_L(plus_idx) = AT_Tbl_Idx;
02671       IR_IDX_L(plus_idx) = target_sub_idx;
02672       IR_LINE_NUM_L(plus_idx) = line;
02673       IR_COL_NUM_L(plus_idx)  = col;
02674       IR_FLD_R(plus_idx) = exp_desc->shape[0].fld;
02675       IR_IDX_R(plus_idx) = exp_desc->shape[0].idx;
02676       IR_LINE_NUM_R(plus_idx) = line;
02677       IR_COL_NUM_R(plus_idx)  = col;
02678 
02679       gen_sh(Before, Assignment_Stmt, line, col,
02680              FALSE, FALSE, TRUE);
02681 
02682       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
02683       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
02684 
02685       if (size_limit_attr) {
02686          attr_idx = find_left_attr(target_base_opnd);
02687          test_size_stmts(attr_idx, target_sub_idx, size_limit_attr);
02688       }
02689 
02690       NTR_IR_TBL(sub_idx);
02691       IR_OPR(sub_idx) = Section_Subscript_Opr;
02692       IR_TYPE_IDX(sub_idx) = exp_desc->type_idx;
02693       IR_LINE_NUM(sub_idx) = line;
02694       IR_COL_NUM(sub_idx)  = col;
02695       COPY_OPND(IR_OPND_L(sub_idx), (*target_base_opnd));
02696 
02697       NTR_IR_LIST_TBL(list2_idx);
02698       IR_FLD_R(sub_idx) = IL_Tbl_Idx;
02699       IR_IDX_R(sub_idx) = list2_idx;
02700       IR_LIST_CNT_R(sub_idx) = 1;
02701 
02702       NTR_IR_TBL(trip_idx);
02703       IR_OPR(trip_idx) = Triplet_Opr;
02704       IR_TYPE_IDX(trip_idx) = SA_INTEGER_DEFAULT_TYPE;
02705       IR_LINE_NUM(trip_idx) = line;
02706       IR_COL_NUM(trip_idx)  = col;
02707 
02708       IL_FLD(list2_idx) = IR_Tbl_Idx;
02709       IL_IDX(list2_idx) = trip_idx;
02710 
02711       NTR_IR_LIST_TBL(list2_idx);
02712       IR_FLD_L(trip_idx) = IL_Tbl_Idx;
02713       IR_IDX_L(trip_idx) = list2_idx;
02714       IR_LIST_CNT_L(trip_idx) = 3;
02715 
02716       NTR_IR_TBL(minus_idx);
02717       IR_OPR(minus_idx) = Minus_Opr;
02718       IR_TYPE_IDX(minus_idx) = SA_INTEGER_DEFAULT_TYPE;
02719       IR_LINE_NUM(minus_idx) = line;
02720       IR_COL_NUM(minus_idx)  = col;
02721       IR_FLD_L(minus_idx) = AT_Tbl_Idx;
02722       IR_IDX_L(minus_idx) = target_sub_idx;
02723       IR_LINE_NUM_L(minus_idx) = line;
02724       IR_COL_NUM_L(minus_idx)  = col;
02725       IR_FLD_R(minus_idx) = exp_desc->shape[0].fld;
02726       IR_IDX_R(minus_idx) = exp_desc->shape[0].idx;
02727       IR_LINE_NUM_R(minus_idx) = line;
02728       IR_COL_NUM_R(minus_idx)  = col;
02729 
02730       IL_FLD(list2_idx) = IR_Tbl_Idx;
02731       IL_IDX(list2_idx) = minus_idx;
02732 
02733       NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list2_idx));
02734       IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = list2_idx;
02735       list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02736 
02737       NTR_IR_TBL(minus_idx);
02738       IR_OPR(minus_idx) = Minus_Opr;
02739       IR_TYPE_IDX(minus_idx) = SA_INTEGER_DEFAULT_TYPE;
02740       IR_LINE_NUM(minus_idx) = line;
02741       IR_COL_NUM(minus_idx)  = col;
02742       IR_FLD_L(minus_idx) = AT_Tbl_Idx;
02743       IR_IDX_L(minus_idx) = target_sub_idx;
02744       IR_LINE_NUM_L(minus_idx) = line;
02745       IR_COL_NUM_L(minus_idx)  = col;
02746       IR_FLD_R(minus_idx) = CN_Tbl_Idx;
02747       IR_IDX_R(minus_idx) = CN_INTEGER_ONE_IDX;
02748       IR_LINE_NUM_R(minus_idx) = line;
02749       IR_COL_NUM_R(minus_idx)  = col;
02750 
02751       IL_FLD(list2_idx) = IR_Tbl_Idx;
02752       IL_IDX(list2_idx) = minus_idx;
02753 
02754       NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list2_idx));
02755       IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = list2_idx;
02756       list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02757       IL_FLD(list2_idx) = CN_Tbl_Idx;
02758       IL_IDX(list2_idx) = CN_INTEGER_ONE_IDX;
02759       IL_LINE_NUM(list2_idx) = line;
02760       IL_COL_NUM(list2_idx)  = col;
02761 
02762       OPND_FLD(opnd) = IR_Tbl_Idx;
02763       OPND_IDX(opnd) = sub_idx;
02764 
02765       if (exp_desc->type == Character) {
02766          gen_whole_substring(&opnd, 1);
02767       }
02768 
02769       NTR_IR_TBL(asg_idx);
02770       IR_OPR(asg_idx) = Asg_Opr;
02771       IR_TYPE_IDX(asg_idx) = exp_desc->type_idx;
02772       IR_LINE_NUM(asg_idx) = line;
02773       IR_COL_NUM(asg_idx)  = col;
02774       COPY_OPND(IR_OPND_L(asg_idx), opnd);
02775 
02776       COPY_OPND(IR_OPND_R(asg_idx), (*r_opnd));
02777 
02778       gen_sh(Before, Assignment_Stmt, line, col,
02779              FALSE, FALSE, TRUE);
02780 
02781       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
02782       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
02783 
02784    }
02785    else {
02786 
02787       /* increment target_sub_idx first so we can check it */
02788 
02789       /* tmp_idx holds the product of the shapes. It is used twice. */
02790 
02791       tmp_idx                   = gen_compiler_tmp(line,col, Priv, TRUE);
02792       AT_SEMANTICS_DONE(tmp_idx)= TRUE;
02793       ATD_TYPE_IDX(tmp_idx)     = SA_INTEGER_DEFAULT_TYPE;
02794       ATD_STOR_BLK_IDX(tmp_idx) = SCP_SB_STACK_IDX(curr_scp_idx);
02795 
02796       NTR_IR_TBL(asg_idx2);
02797       IR_OPR(asg_idx2)        = Asg_Opr;
02798       IR_TYPE_IDX(asg_idx2) = SA_INTEGER_DEFAULT_TYPE;
02799       IR_LINE_NUM(asg_idx2)   = line;
02800       IR_COL_NUM(asg_idx2)    = col;
02801       IR_FLD_L(asg_idx2)      = AT_Tbl_Idx;
02802       IR_IDX_L(asg_idx2)      = tmp_idx;
02803       IR_LINE_NUM_L(asg_idx2) = line;
02804       IR_COL_NUM_L(asg_idx2)  = col;
02805 
02806       COPY_OPND(opnd, exp_desc->shape[0]);
02807       OPND_LINE_NUM(opnd) = line;
02808       OPND_COL_NUM(opnd)  = col;
02809 
02810       for (i = 1; i < exp_desc->rank; i++) {                
02811          NTR_IR_TBL(mult_idx);
02812          IR_OPR(mult_idx) = Mult_Opr;
02813          IR_TYPE_IDX(mult_idx) = SA_INTEGER_DEFAULT_TYPE;
02814          IR_LINE_NUM(mult_idx) = line;
02815          IR_COL_NUM(mult_idx)  = col;
02816 
02817          COPY_OPND(IR_OPND_L(mult_idx), opnd);
02818  
02819          COPY_OPND(IR_OPND_R(mult_idx), exp_desc->shape[i]);
02820          IR_LINE_NUM_R(mult_idx) = line;
02821          IR_COL_NUM_R(mult_idx)  = col;
02822 
02823          OPND_FLD(opnd) = IR_Tbl_Idx;
02824          OPND_IDX(opnd) = mult_idx;
02825       }
02826 
02827       COPY_OPND(IR_OPND_R(asg_idx2), opnd);
02828 
02829       gen_sh(Before, Assignment_Stmt, line, col,
02830              FALSE, FALSE, TRUE);
02831 
02832       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx2;
02833       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
02834 
02835 
02836       NTR_IR_TBL(asg_idx);
02837       IR_OPR(asg_idx) = Asg_Opr;
02838       IR_TYPE_IDX(asg_idx) = SA_INTEGER_DEFAULT_TYPE;
02839       IR_LINE_NUM(asg_idx) = line;
02840       IR_COL_NUM(asg_idx)  = col;
02841       IR_FLD_L(asg_idx)    = AT_Tbl_Idx;
02842       IR_IDX_L(asg_idx)    = target_sub_idx;
02843       IR_LINE_NUM_L(asg_idx) = line;
02844       IR_COL_NUM_L(asg_idx)  = col;
02845       NTR_IR_TBL(plus_idx);
02846       IR_OPR(plus_idx) = Plus_Opr;
02847       IR_TYPE_IDX(plus_idx) = SA_INTEGER_DEFAULT_TYPE;
02848       IR_LINE_NUM(plus_idx) = line;
02849       IR_COL_NUM(plus_idx)  = col;
02850       IR_FLD_R(asg_idx) = IR_Tbl_Idx;
02851       IR_IDX_R(asg_idx) = plus_idx;
02852 
02853       IR_FLD_L(plus_idx) = AT_Tbl_Idx;
02854       IR_IDX_L(plus_idx) = target_sub_idx;
02855       IR_LINE_NUM_L(plus_idx) = line;
02856       IR_COL_NUM_L(plus_idx)  = col;
02857       IR_FLD_R(plus_idx) = AT_Tbl_Idx;
02858       IR_IDX_R(plus_idx) = tmp_idx;
02859       IR_LINE_NUM_R(plus_idx) = line;
02860       IR_COL_NUM_R(plus_idx)  = col;
02861 
02862       gen_sh(Before, Assignment_Stmt, line, col,
02863              FALSE, FALSE, TRUE);
02864 
02865       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
02866       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
02867 
02868       if (size_limit_attr) {
02869          attr_idx = find_left_attr(target_base_opnd);
02870          test_size_stmts(attr_idx, target_sub_idx, size_limit_attr);
02871       }
02872 
02873       NTR_IR_TBL(sub_idx);
02874       IR_OPR(sub_idx) = Section_Subscript_Opr;
02875       IR_TYPE_IDX(sub_idx) = exp_desc->type_idx;
02876       IR_LINE_NUM(sub_idx) = line;
02877       IR_COL_NUM(sub_idx)  = col;
02878       COPY_OPND(IR_OPND_L(sub_idx), (*target_base_opnd));
02879 
02880       NTR_IR_LIST_TBL(list2_idx);
02881       IR_FLD_R(sub_idx) = IL_Tbl_Idx;
02882       IR_IDX_R(sub_idx) = list2_idx;
02883       IR_LIST_CNT_R(sub_idx) = 1;
02884 
02885       NTR_IR_TBL(trip_idx);
02886       IR_OPR(trip_idx) = Triplet_Opr;
02887       IR_TYPE_IDX(trip_idx) = SA_INTEGER_DEFAULT_TYPE;
02888       IR_LINE_NUM(trip_idx) = line;
02889       IR_COL_NUM(trip_idx)  = col;
02890 
02891       IL_FLD(list2_idx) = IR_Tbl_Idx;
02892       IL_IDX(list2_idx) = trip_idx;
02893 
02894       NTR_IR_LIST_TBL(list2_idx);
02895       IR_FLD_L(trip_idx) = IL_Tbl_Idx;
02896       IR_IDX_L(trip_idx) = list2_idx;
02897       IR_LIST_CNT_L(trip_idx) = 3;
02898 
02899       NTR_IR_TBL(minus_idx);
02900       IR_OPR(minus_idx) = Minus_Opr;
02901       IR_TYPE_IDX(minus_idx) = SA_INTEGER_DEFAULT_TYPE;
02902       IR_LINE_NUM(minus_idx) = line;
02903       IR_COL_NUM(minus_idx)  = col;
02904       IR_FLD_L(minus_idx) = AT_Tbl_Idx;
02905       IR_IDX_L(minus_idx) = target_sub_idx;
02906       IR_LINE_NUM_L(minus_idx) = line;
02907       IR_COL_NUM_L(minus_idx)  = col;
02908       IR_FLD_R(minus_idx) = AT_Tbl_Idx;
02909       IR_IDX_R(minus_idx) = tmp_idx;
02910       IR_LINE_NUM_R(minus_idx) = line;
02911       IR_COL_NUM_R(minus_idx)  = col;
02912 
02913       IL_FLD(list2_idx) = IR_Tbl_Idx;
02914       IL_IDX(list2_idx) = minus_idx;
02915 
02916       NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list2_idx));
02917       IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = list2_idx;
02918       list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02919 
02920       NTR_IR_TBL(minus_idx);
02921       IR_OPR(minus_idx) = Minus_Opr;
02922       IR_TYPE_IDX(minus_idx) = SA_INTEGER_DEFAULT_TYPE;
02923       IR_LINE_NUM(minus_idx) = line;
02924       IR_COL_NUM(minus_idx)  = col;
02925       IR_FLD_L(minus_idx) = AT_Tbl_Idx;
02926       IR_IDX_L(minus_idx) = target_sub_idx;
02927       IR_LINE_NUM_L(minus_idx) = line;
02928       IR_COL_NUM_L(minus_idx)  = col;
02929       IR_FLD_R(minus_idx) = CN_Tbl_Idx;
02930       IR_IDX_R(minus_idx) = CN_INTEGER_ONE_IDX;
02931       IR_LINE_NUM_R(minus_idx) = line;
02932       IR_COL_NUM_R(minus_idx)  = col;
02933 
02934       IL_FLD(list2_idx) = IR_Tbl_Idx;
02935       IL_IDX(list2_idx) = minus_idx;
02936 
02937       NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list2_idx));
02938       IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list2_idx)) = list2_idx;
02939       list2_idx = IL_NEXT_LIST_IDX(list2_idx);
02940       IL_FLD(list2_idx) = CN_Tbl_Idx;
02941       IL_IDX(list2_idx) = CN_INTEGER_ONE_IDX;
02942       IL_LINE_NUM(list2_idx) = line;
02943       IL_COL_NUM(list2_idx)  = col;
02944 
02945       OPND_FLD(opnd) = IR_Tbl_Idx;
02946       OPND_IDX(opnd) = sub_idx;
02947 
02948       if (exp_desc->type == Character) {
02949          gen_whole_substring(&opnd, exp_desc->rank);
02950       }
02951 
02952       NTR_IR_TBL(asg_idx);
02953       IR_OPR(asg_idx) = Flat_Array_Asg_Opr;
02954       IR_TYPE_IDX(asg_idx) = exp_desc->type_idx;
02955       IR_LINE_NUM(asg_idx) = line;
02956       IR_COL_NUM(asg_idx)  = col;
02957       COPY_OPND(IR_OPND_L(asg_idx), opnd);
02958 
02959       COPY_OPND(IR_OPND_R(asg_idx), (*r_opnd));
02960 
02961       gen_sh(Before, Assignment_Stmt, line, col,
02962              FALSE, FALSE, TRUE);
02963 
02964       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
02965       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
02966 
02967       
02968    }
02969 
02970 
02971    TRACE (Func_Exit, "do_single_asg", NULL);
02972 
02973    return;
02974 
02975 }  /* do_single_asg */
02976 
02977 /******************************************************************************\
02978 |*                                                                            *|
02979 |* Description:                                                               *|
02980 |*      This routine drives the generation of assignment stmts for structure  *|
02981 |*      constructors.                                                         *|
02982 |*                                                                            *|
02983 |* Input parameters:                                                          *|
02984 |*      top_opnd - top of constructor tree.                                   *|
02985 |*      target_base_opnd - left hand side base (of derived type).             *|
02986 |*                                                                            *|
02987 |* Output parameters:                                                         *|
02988 |*      NONE                                                                  *|
02989 |*                                                                            *|
02990 |* Returns:                                                                   *|
02991 |*      NOTHING                                                               *|
02992 |*                                                                            *|
02993 \******************************************************************************/
02994 
02995 static void create_struct_constructor_asg(opnd_type     *top_opnd,
02996                                           opnd_type     *target_base_opnd)
02997 
02998 {
02999    int                  asg_idx;
03000    int                  attr_idx;
03001    int                  col;
03002    int                  ir_idx;
03003    expr_arg_type        l_exp_desc;
03004    opnd_type            l_opnd;
03005    int                  line;
03006    int                  list_idx;
03007    opnd_type            opnd;
03008    int                  sn_idx;
03009    int                  struct_idx;
03010 
03011 
03012    TRACE (Func_Entry, "create_struct_constructor_asg", NULL);
03013 
03014 # ifdef _DEBUG
03015    if (OPND_FLD((*top_opnd)) != IR_Tbl_Idx ||
03016        IR_OPR(OPND_IDX((*top_opnd))) != Struct_Construct_Opr) {
03017       find_opnd_line_and_column(top_opnd, &line, &col);
03018       PRINTMSG(line, 987, Internal, col);
03019    }
03020 # endif
03021 
03022    ir_idx = OPND_IDX((*top_opnd));
03023 
03024    list_idx = IR_IDX_R(ir_idx);
03025    sn_idx   = ATT_FIRST_CPNT_IDX(IR_IDX_L(ir_idx));
03026 
03027    while (list_idx) {
03028       find_opnd_line_and_column((opnd_type *) &IL_OPND(list_idx), &line, &col);
03029 
03030       attr_idx = SN_ATTR_IDX(sn_idx);
03031 
03032       NTR_IR_TBL(struct_idx);
03033       IR_OPR(struct_idx) = Struct_Opr;
03034       IR_TYPE_IDX(struct_idx) = ATD_TYPE_IDX(attr_idx);
03035       IR_LINE_NUM(struct_idx) = line;
03036       IR_COL_NUM(struct_idx)  = col;
03037       COPY_OPND(IR_OPND_L(struct_idx), (*target_base_opnd));
03038       IR_FLD_R(struct_idx) = AT_Tbl_Idx;
03039       IR_IDX_R(struct_idx) = attr_idx;
03040       IR_LINE_NUM_R(struct_idx) = line;
03041       IR_COL_NUM_R(struct_idx) = col;
03042       
03043       
03044       OPND_FLD(l_opnd) = IR_Tbl_Idx;
03045       OPND_IDX(l_opnd) = struct_idx;
03046 
03047       if (! ATD_POINTER(attr_idx)) {
03048 
03049          if (ATD_ARRAY_IDX(attr_idx)) {
03050             gen_whole_subscript(&l_opnd, &l_exp_desc);
03051          }
03052          else if (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == Character) {
03053             gen_whole_substring(&l_opnd, 0);
03054          }
03055       }
03056 
03057       NTR_IR_TBL(asg_idx);
03058       IR_OPR(asg_idx) = Asg_Opr;
03059       IR_TYPE_IDX(asg_idx) = ATD_TYPE_IDX(attr_idx);
03060       IR_LINE_NUM(asg_idx) = line;
03061       IR_COL_NUM(asg_idx) = col;
03062       COPY_OPND(IR_OPND_L(asg_idx), l_opnd);
03063 
03064 /* BHJ may want to analyse each item and prevent the sub constructors */
03065 
03066       l_exp_desc = arg_info_list[IL_ARG_DESC_IDX(list_idx)].ed;
03067       COPY_OPND(opnd, IL_OPND(list_idx));
03068       expand_stmts(&opnd, &l_exp_desc);
03069 
03070 
03071       COPY_OPND(IR_OPND_R(asg_idx), opnd);
03072 
03073       if (ATD_POINTER(attr_idx)) {
03074 
03075          /* first initialize the dv */
03076 
03077          gen_dv_whole_def_init(&l_opnd, attr_idx, Before);
03078 
03079          IR_OPR(asg_idx) = Ptr_Asg_Opr;
03080 
03081          /* do the stmt thing here */
03082 
03083          COPY_OPND(l_opnd, IR_OPND_L(asg_idx));
03084 
03085          if (l_exp_desc.pointer || l_exp_desc.allocatable) {
03086             ptr_assign_from_ptr(&l_opnd, &opnd);
03087             list_idx  = IL_NEXT_LIST_IDX(list_idx);
03088             sn_idx    = SN_SIBLING_LINK(sn_idx);
03089             continue;
03090          }
03091          else if (l_exp_desc.target) {
03092             dope_vector_setup(&opnd, &l_exp_desc, &l_opnd,
03093                                    TRUE);
03094          }
03095       }
03096 
03097       gen_sh(Before, Assignment_Stmt, line, col,
03098              FALSE, FALSE, TRUE);
03099 
03100       SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
03101       SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
03102 
03103 
03104       list_idx  = IL_NEXT_LIST_IDX(list_idx);
03105       sn_idx    = SN_SIBLING_LINK(sn_idx);
03106    }
03107 
03108    TRACE (Func_Exit, "create_struct_constructor_asg", NULL);
03109 
03110    return;
03111 
03112 }  /* create_struct_constructor_asg */
03113 
03114 /******************************************************************************\
03115 |*                                                                            *|
03116 |* Description:                                                               *|
03117 |*      Generate the stmts to increment the subscript tmp for run time array  *|
03118 |*      constructors.                                                         *|
03119 |*                                                                            *|
03120 |* Input parameters:                                                          *|
03121 |*      target_sub_idx - attr idx for subscript attr.                         *|
03122 |*                                                                            *|
03123 |* Output parameters:                                                         *|
03124 |*      NONE                                                                  *|
03125 |*                                                                            *|
03126 |* Returns:                                                                   *|
03127 |*      NOTHING                                                               *|
03128 |*                                                                            *|
03129 \******************************************************************************/
03130 
03131 static void increment_subscript(int     target_sub_idx)
03132 
03133 {
03134    int          asg_idx;
03135    int          plus_idx;
03136 
03137    TRACE (Func_Entry, "increment_subscript", NULL);
03138 
03139    NTR_IR_TBL(asg_idx);
03140    IR_OPR(asg_idx) = Asg_Opr;
03141    IR_TYPE_IDX(asg_idx) = SA_INTEGER_DEFAULT_TYPE;
03142    IR_LINE_NUM(asg_idx) = stmt_start_line;
03143    IR_COL_NUM(asg_idx)  = stmt_start_col;
03144    IR_FLD_L(asg_idx)    = AT_Tbl_Idx;
03145    IR_IDX_L(asg_idx)    = target_sub_idx;
03146    IR_LINE_NUM_L(asg_idx) = stmt_start_line;
03147    IR_COL_NUM_L(asg_idx)  = stmt_start_col;
03148    NTR_IR_TBL(plus_idx);
03149    IR_OPR(plus_idx) = Plus_Opr;
03150    IR_TYPE_IDX(plus_idx) = SA_INTEGER_DEFAULT_TYPE;
03151    IR_LINE_NUM(plus_idx) = stmt_start_line;
03152    IR_COL_NUM(plus_idx)  = stmt_start_col;
03153    IR_FLD_R(asg_idx) = IR_Tbl_Idx;
03154    IR_IDX_R(asg_idx) = plus_idx;
03155 
03156    IR_FLD_L(plus_idx) = AT_Tbl_Idx;
03157    IR_IDX_L(plus_idx) = target_sub_idx;
03158    IR_LINE_NUM_L(plus_idx) = stmt_start_line;
03159    IR_COL_NUM_L(plus_idx)  = stmt_start_col;
03160    IR_FLD_R(plus_idx) = CN_Tbl_Idx;
03161    IR_IDX_R(plus_idx) = CN_INTEGER_ONE_IDX;
03162    IR_LINE_NUM_R(plus_idx) = stmt_start_line;
03163    IR_COL_NUM_R(plus_idx)  = stmt_start_col;
03164 
03165    gen_sh(Before, Assignment_Stmt, stmt_start_line, stmt_start_col,
03166           FALSE, FALSE, TRUE);
03167 
03168    SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
03169    SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
03170 
03171 
03172    TRACE (Func_Exit, "increment_subscript", NULL);
03173 
03174    return;
03175 
03176 }  /* increment_subscript */
03177 
03178 /******************************************************************************\
03179 |*                                                                            *|
03180 |* Description:                                                               *|
03181 |*      Insert the size test for the realloc call.                            *|
03182 |*                                                                            *|
03183 |* Input parameters:                                                          *|
03184 |*      target_dope_idx - dope vector attr idx                                *|
03185 |*      target_sub_idx  - subscript attr idx.                                 *|
03186 |*      size_idx        - attr idx for attr size.                             *|
03187 |*                                                                            *|
03188 |* Output parameters:                                                         *|
03189 |*      NONE                                                                  *|
03190 |*                                                                            *|
03191 |* Returns:                                                                   *|
03192 |*      NOTHING                                                               *|
03193 |*                                                                            *|
03194 \******************************************************************************/
03195 
03196 static void test_size_stmts(int         target_dope_idx,
03197                             int         target_sub_idx,
03198                             int         size_idx)
03199 
03200 {
03201    int          asg_idx;
03202    int          br_idx;
03203    int          call_idx;
03204    int          dv_idx;
03205    int          ir_idx;
03206    int          lt_idx;
03207    int          label_idx;
03208    int          list_idx;
03209    int          minus_idx;
03210    int          plus_idx;
03211    int          realloc_size_attr;
03212    int          save_curr_stmt_sh_idx;
03213 
03214 
03215    TRACE (Func_Entry, "test_size_stmts", NULL);
03216 
03217    save_curr_stmt_sh_idx = curr_stmt_sh_idx;
03218 
03219    /* gen branch around label */
03220 
03221    label_idx = gen_internal_lbl(stmt_start_line);
03222 
03223    gen_sh(Before, Continue_Stmt, stmt_start_line, stmt_start_col, 
03224           FALSE, TRUE, TRUE);
03225 
03226    curr_stmt_sh_idx = SH_PREV_IDX(curr_stmt_sh_idx);
03227 
03228    NTR_IR_TBL(ir_idx);
03229    SH_IR_IDX(curr_stmt_sh_idx) = ir_idx;
03230    IR_OPR(ir_idx)              = Label_Opr;
03231    IR_TYPE_IDX(ir_idx)         = TYPELESS_DEFAULT_TYPE;
03232    IR_LINE_NUM(ir_idx)         = stmt_start_line;
03233    IR_COL_NUM(ir_idx)          = stmt_start_col;
03234    IR_FLD_L(ir_idx)            = AT_Tbl_Idx;
03235    IR_IDX_L(ir_idx)            = label_idx;
03236    IR_COL_NUM_L(ir_idx)        = stmt_start_col;
03237    IR_LINE_NUM_L(ir_idx)       = stmt_start_line;
03238 
03239    AT_DEFINED(label_idx)       = TRUE;
03240    ATL_DEF_STMT_IDX(label_idx) = curr_stmt_sh_idx;
03241 
03242    SH_P2_SKIP_ME(curr_stmt_sh_idx) = TRUE;
03243 
03244 
03245    /* now push back test */
03246 
03247    NTR_IR_TBL(br_idx);
03248    IR_OPR(br_idx) = Br_True_Opr;
03249    IR_TYPE_IDX(br_idx) = LOGICAL_DEFAULT_TYPE;
03250    IR_LINE_NUM(br_idx) = stmt_start_line;
03251    IR_COL_NUM(br_idx)  = stmt_start_col;
03252 
03253    NTR_IR_TBL(lt_idx);
03254    IR_OPR(lt_idx) = Lt_Opr;
03255    IR_TYPE_IDX(lt_idx) = LOGICAL_DEFAULT_TYPE;
03256    IR_LINE_NUM(lt_idx) = stmt_start_line;
03257    IR_COL_NUM(lt_idx)  = stmt_start_col;
03258 
03259    IR_FLD_L(lt_idx) = AT_Tbl_Idx;
03260    IR_IDX_L(lt_idx) = target_sub_idx;
03261    IR_LINE_NUM_L(lt_idx) = stmt_start_line;
03262    IR_COL_NUM_L(lt_idx)  = stmt_start_col;
03263    
03264    IR_FLD_R(lt_idx) = AT_Tbl_Idx;
03265    IR_IDX_R(lt_idx) = size_idx;
03266    IR_LINE_NUM_R(lt_idx) = stmt_start_line;
03267    IR_COL_NUM_R(lt_idx)  = stmt_start_col;
03268 
03269    IR_FLD_L(br_idx) = IR_Tbl_Idx;
03270    IR_IDX_L(br_idx) = lt_idx;
03271 
03272    IR_FLD_R(br_idx) = AT_Tbl_Idx;
03273    IR_IDX_R(br_idx) = label_idx;
03274    IR_LINE_NUM_R(br_idx) = stmt_start_line;
03275    IR_COL_NUM_R(br_idx)  = stmt_start_col;
03276 
03277    gen_sh(Before, If_Stmt, stmt_start_line, stmt_start_col,
03278           FALSE, FALSE, TRUE);
03279 
03280    SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = br_idx;
03281    SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
03282 
03283    /* now for the realloc call */
03284    /* new size is in bits. (elements * element bit size) */
03285 
03286    
03287    if (glb_tbl_idx[Realloc_Attr_Idx] == NULL_IDX) {
03288       glb_tbl_idx[Realloc_Attr_Idx] = create_lib_entry_attr(REALLOC_LIB_ENTRY,
03289                                                             REALLOC_NAME_LEN,
03290                                                             stmt_start_line,
03291                                                             stmt_start_col);
03292    }
03293 
03294    ADD_ATTR_TO_LOCAL_LIST(glb_tbl_idx[Realloc_Attr_Idx]);
03295 
03296    /* increment size tmp */
03297 
03298    NTR_IR_TBL(asg_idx);
03299    IR_OPR(asg_idx) = Asg_Opr;
03300    IR_TYPE_IDX(asg_idx) = SA_INTEGER_DEFAULT_TYPE;
03301    IR_LINE_NUM(asg_idx) = stmt_start_line;
03302    IR_COL_NUM(asg_idx)  = stmt_start_col;
03303    IR_FLD_L(asg_idx) = AT_Tbl_Idx;
03304    IR_IDX_L(asg_idx) = size_idx;
03305    IR_LINE_NUM_L(asg_idx) = stmt_start_line;
03306    IR_COL_NUM_L(asg_idx)  = stmt_start_col;
03307 
03308    NTR_IR_TBL(ir_idx);
03309    IR_OPR(ir_idx) = Plus_Opr;
03310    IR_TYPE_IDX(ir_idx) = SA_INTEGER_DEFAULT_TYPE;
03311    IR_LINE_NUM(ir_idx) = stmt_start_line;
03312    IR_COL_NUM(ir_idx)  = stmt_start_col;
03313    IR_FLD_R(ir_idx) = AT_Tbl_Idx;
03314    IR_IDX_R(ir_idx) = size_idx;
03315    IR_LINE_NUM_R(ir_idx) = stmt_start_line;
03316    IR_COL_NUM_R(ir_idx)  = stmt_start_col;
03317 
03318    NTR_IR_TBL(plus_idx);
03319    IR_OPR(plus_idx) = Plus_Opr;
03320    IR_TYPE_IDX(plus_idx) = SA_INTEGER_DEFAULT_TYPE;
03321    IR_LINE_NUM(plus_idx) = stmt_start_line;
03322    IR_COL_NUM(plus_idx)  = stmt_start_col;
03323    IR_FLD_L(ir_idx) = IR_Tbl_Idx;
03324    IR_IDX_L(ir_idx) = plus_idx;
03325 
03326    IR_FLD_R(plus_idx) = CN_Tbl_Idx;
03327    IR_IDX_R(plus_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 
03328                                     CONSTRUCTOR_GUESS_SIZE);
03329    IR_LINE_NUM_R(plus_idx) = stmt_start_line;
03330    IR_COL_NUM_R(plus_idx)  = stmt_start_col;
03331 
03332    NTR_IR_TBL(minus_idx);
03333    IR_OPR(minus_idx) = Minus_Opr;
03334    IR_TYPE_IDX(minus_idx) = SA_INTEGER_DEFAULT_TYPE;
03335    IR_LINE_NUM(minus_idx) = stmt_start_line;
03336    IR_COL_NUM(minus_idx)  = stmt_start_col;
03337    IR_FLD_L(minus_idx) = AT_Tbl_Idx;
03338    IR_IDX_L(minus_idx) = target_sub_idx;
03339    IR_LINE_NUM_L(minus_idx) = stmt_start_line;
03340    IR_COL_NUM_L(minus_idx)  = stmt_start_col;
03341    IR_FLD_R(minus_idx) = AT_Tbl_Idx;
03342    IR_IDX_R(minus_idx) = size_idx;
03343    IR_LINE_NUM_R(minus_idx) = stmt_start_line;
03344    IR_COL_NUM_R(minus_idx)  = stmt_start_col;
03345 
03346    IR_FLD_L(plus_idx) = IR_Tbl_Idx;
03347    IR_IDX_L(plus_idx) = minus_idx;
03348 
03349    IR_FLD_R(asg_idx) = IR_Tbl_Idx;
03350    IR_IDX_R(asg_idx) = ir_idx;
03351 
03352    gen_sh(Before, Assignment_Stmt, stmt_start_line, stmt_start_col, 
03353           FALSE, FALSE, TRUE);
03354    SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = asg_idx;
03355    SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
03356 
03357    /* compute new bit size */
03358 
03359    GEN_COMPILER_TMP_ASG(asg_idx,
03360                         realloc_size_attr,
03361                         TRUE,   /* Semantics is done */
03362                         stmt_start_line,
03363                         stmt_start_col,
03364                         SA_INTEGER_DEFAULT_TYPE,
03365                         Priv);
03366 
03367    NTR_IR_TBL(ir_idx);
03368    IR_OPR(ir_idx) = Mult_Opr;
03369    IR_TYPE_IDX(ir_idx) = SA_INTEGER_DEFAULT_TYPE;
03370    IR_LINE_NUM(ir_idx) = stmt_start_line;
03371    IR_COL_NUM(ir_idx)  = stmt_start_col;
03372    IR_FLD_L(ir_idx) = AT_Tbl_Idx;
03373    IR_IDX_L(ir_idx) = size_idx;
03374    IR_LINE_NUM_L(ir_idx) = stmt_start_line;
03375    IR_COL_NUM_L(ir_idx)  = stmt_start_col;
03376    
03377    NTR_IR_TBL(dv_idx);
03378    IR_OPR(dv_idx) = Dv_Access_El_Len;
03379    IR_TYPE_IDX(dv_idx) = SA_INTEGER_DEFAULT_TYPE;
03380    IR_LINE_NUM(dv_idx) = stmt_start_line;
03381    IR_COL_NUM(dv_idx)  = stmt_start_col;
03382    IR_FLD_L(dv_idx) = AT_Tbl_Idx;
03383    IR_IDX_L(dv_idx) = target_dope_idx;
03384    IR_LINE_NUM_L(dv_idx) = stmt_start_line;
03385    IR_COL_NUM_L(dv_idx)  = stmt_start_col;
03386 
03387    IR_FLD_R(ir_idx) = IR_Tbl_Idx;
03388    IR_IDX_R(ir_idx) = dv_idx;
03389 
03390    IR_FLD_R(asg_idx) = IR_Tbl_Idx;
03391    IR_IDX_R(asg_idx) = ir_idx;
03392 
03393    gen_sh(Before, Assignment_Stmt, stmt_start_line,
03394           stmt_start_col, FALSE, FALSE, TRUE);
03395 
03396    SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))     = asg_idx;
03397    SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
03398 
03399    /* now for the call */
03400 
03401    NTR_IR_TBL(call_idx);
03402    IR_OPR(call_idx) = Call_Opr;
03403    IR_TYPE_IDX(call_idx) = TYPELESS_DEFAULT_TYPE;
03404    IR_LINE_NUM(call_idx) = stmt_start_line;
03405    IR_COL_NUM(call_idx)  = stmt_start_col;
03406    IR_FLD_L(call_idx) = AT_Tbl_Idx;
03407    IR_IDX_L(call_idx) = glb_tbl_idx[Realloc_Attr_Idx];
03408    IR_LINE_NUM_L(call_idx) = stmt_start_line;
03409    IR_COL_NUM_L(call_idx)  = stmt_start_col;
03410 
03411    NTR_IR_LIST_TBL(list_idx);
03412    IR_FLD_R(call_idx) = IL_Tbl_Idx;
03413    IR_IDX_R(call_idx) = list_idx;
03414    IR_LIST_CNT_R(call_idx) = 2;
03415 
03416    NTR_IR_TBL(ir_idx);
03417    IR_OPR(ir_idx) = Aloc_Opr;
03418    IR_TYPE_IDX(ir_idx) = CRI_Ptr_8;
03419    IR_LINE_NUM(ir_idx) = stmt_start_line;
03420    IR_COL_NUM(ir_idx)  = stmt_start_col;
03421 
03422    IL_FLD(list_idx) = IR_Tbl_Idx;
03423    IL_IDX(list_idx) = ir_idx;
03424 
03425    IR_FLD_L(ir_idx) = AT_Tbl_Idx;
03426    IR_IDX_L(ir_idx) = target_dope_idx;
03427    IR_LINE_NUM_L(ir_idx) = stmt_start_line;
03428    IR_COL_NUM_L(ir_idx)  = stmt_start_col;
03429 
03430    NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
03431    list_idx = IL_NEXT_LIST_IDX(list_idx);
03432 
03433    NTR_IR_TBL(ir_idx);
03434    IR_OPR(ir_idx)       = Aloc_Opr;
03435    IR_TYPE_IDX(ir_idx)  = CRI_Ptr_8;
03436    IR_LINE_NUM(ir_idx)  = stmt_start_line;
03437    IR_COL_NUM(ir_idx)   = stmt_start_col;
03438 
03439    IL_FLD(list_idx)     = IR_Tbl_Idx;
03440    IL_IDX(list_idx)     = ir_idx;
03441 
03442    IR_FLD_L(ir_idx)     = AT_Tbl_Idx;
03443    IR_IDX_L(ir_idx)     = realloc_size_attr;
03444    IR_LINE_NUM_L(ir_idx)        = stmt_start_line;
03445    IR_COL_NUM_L(ir_idx) = stmt_start_col;
03446 
03447    gen_sh(Before, Call_Stmt, stmt_start_line,
03448           stmt_start_col, FALSE, FALSE, TRUE);
03449 
03450    SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))     = call_idx;
03451    SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE;
03452 
03453 
03454    curr_stmt_sh_idx = save_curr_stmt_sh_idx;
03455 
03456    TRACE (Func_Exit, "test_size_stmts", NULL);
03457 
03458    return;
03459 
03460 }  /* test_size_stmts */
03461 
03462 /******************************************************************************\
03463 |*                                                                            *|
03464 |* Description:                                                               *|
03465 |*      Process the character length for run time constructors replacing lcv's*|
03466 |*      with their start values.                                              *|
03467 |*                                                                            *|
03468 |* Input parameters:                                                          *|
03469 |*      top_opnd - top of char_len expression.                                *|
03470 |*                                                                            *|
03471 |* Output parameters:                                                         *|
03472 |*      NONE                                                                  *|
03473 |*                                                                            *|
03474 |* Returns:                                                                   *|
03475 |*      NOTHING                                                               *|
03476 |*                                                                            *|
03477 \******************************************************************************/
03478 
03479 void process_char_len(opnd_type *top_opnd)
03480 
03481 {
03482    expr_arg_type        exp_desc;
03483    int                  list_idx;
03484    opnd_type            opnd;
03485    cif_usage_code_type  save_xref_state;
03486 
03487 
03488    TRACE (Func_Entry, "process_char_len", NULL);
03489 
03490    switch (OPND_FLD((*top_opnd))) {
03491       case IR_Tbl_Idx:
03492          COPY_OPND(opnd, IR_OPND_L(OPND_IDX((*top_opnd))));
03493          process_char_len(&opnd);
03494          COPY_OPND(IR_OPND_L(OPND_IDX((*top_opnd))), opnd);
03495 
03496          COPY_OPND(opnd, IR_OPND_R(OPND_IDX((*top_opnd))));
03497          process_char_len(&opnd);
03498          COPY_OPND(IR_OPND_R(OPND_IDX((*top_opnd))), opnd);
03499 
03500          if (IR_OPR(OPND_IDX((*top_opnd))) == Call_Opr) {
03501             /* get new arg_descriptors for the arguments */
03502             list_idx = IR_IDX_R(OPND_IDX((*top_opnd)));
03503 
03504             while (list_idx) {
03505 
03506                if (IL_FLD(list_idx) != NO_Tbl_Idx) {
03507 
03508                   COPY_OPND(opnd, IL_OPND(list_idx));
03509                   exp_desc.rank = 0;
03510                   save_xref_state = xref_state;
03511                   xref_state      = CIF_No_Usage_Rec;
03512                   expr_sem(&opnd, &exp_desc);
03513                   xref_state      = save_xref_state;
03514 
03515                   /* save exp_desc */
03516                   arg_info_list_base      = arg_info_list_top;
03517                   arg_info_list_top       = arg_info_list_base + 1;
03518 
03519                   if (arg_info_list_top >= arg_info_list_size) {
03520                      enlarge_info_list_table();
03521                   }
03522 
03523                   arg_info_list[arg_info_list_top] = 
03524                                   arg_info_list[IL_ARG_DESC_IDX(list_idx)];
03525                   IL_ARG_DESC_IDX(list_idx) = arg_info_list_top;
03526                   arg_info_list[arg_info_list_top].ed = exp_desc;
03527                }
03528 
03529                list_idx = IL_NEXT_LIST_IDX(list_idx);
03530             }
03531          }
03532          break;
03533 
03534       case AT_Tbl_Idx:
03535 
03536          if (AT_OBJ_CLASS(OPND_IDX((*top_opnd))) == Data_Obj &&
03537              ATD_IMP_DO_LCV(OPND_IDX((*top_opnd)))) {
03538 
03539             gen_opnd(&opnd, ATD_TMP_IDX(OPND_IDX((*top_opnd))),
03540                      (fld_type) ATD_FLD(OPND_IDX((*top_opnd))),
03541                      OPND_LINE_NUM((*top_opnd)),
03542                      OPND_COL_NUM((*top_opnd)));
03543             copy_subtree(&opnd, &opnd);
03544 
03545             process_char_len(&opnd);
03546             COPY_OPND((*top_opnd), opnd);
03547          }
03548          break;
03549 
03550       case IL_Tbl_Idx:
03551 
03552          list_idx = OPND_IDX((*top_opnd));
03553 
03554          while (list_idx) {
03555             COPY_OPND(opnd, IL_OPND(list_idx));
03556             process_char_len(&opnd);
03557             COPY_OPND(IL_OPND(list_idx), opnd);
03558 
03559             list_idx = IL_NEXT_LIST_IDX(list_idx);
03560          }
03561          break;
03562 
03563       case NO_Tbl_Idx:
03564          break;
03565    }
03566 
03567    TRACE (Func_Exit, "process_char_len", NULL);
03568 
03569    return;
03570 
03571 }  /* process_char_len */
03572 
03573 /******************************************************************************\
03574 |*                                                                            *|
03575 |* Description:                                                               *|
03576 |*      <description>                                                         *|
03577 |*                                                                            *|
03578 |* Input parameters:                                                          *|
03579 |*      NONE                                                                  *|
03580 |*                                                                            *|
03581 |* Output parameters:                                                         *|
03582 |*      NONE                                                                  *|
03583 |*                                                                            *|
03584 |* Returns:                                                                   *|
03585 |*      NOTHING                                                               *|
03586 |*                                                                            *|
03587 \******************************************************************************/
03588 
03589 static void expand_stmts(opnd_type      *top_opnd,
03590                          expr_arg_type  *exp_desc)
03591 
03592 {
03593 
03594 
03595    TRACE (Func_Entry, "expand_stmts", NULL);
03596 
03597    check_for_constructors(top_opnd, exp_desc);
03598 
03599    process_deferred_functions(top_opnd);
03600 
03601    TRACE (Func_Exit, "expand_stmts", NULL);
03602 
03603    return;
03604 
03605 }  /* expand_stmts */
03606 
03607 /******************************************************************************\
03608 |*                                                                            *|
03609 |* Description:                                                               *|
03610 |*      <description>                                                         *|
03611 |*                                                                            *|
03612 |* Input parameters:                                                          *|
03613 |*      NONE                                                                  *|
03614 |*                                                                            *|
03615 |* Output parameters:                                                         *|
03616 |*      NONE                                                                  *|
03617 |*                                                                            *|
03618 |* Returns:                                                                   *|
03619 |*      NOTHING                                                               *|
03620 |*                                                                            *|
03621 \******************************************************************************/
03622 
03623 static void check_for_constructors(opnd_type            *top_opnd,
03624                                    expr_arg_type        *exp_desc)
03625 
03626 {
03627    int                  ir_idx;
03628    int                  list_idx;
03629    expr_arg_type        loc_exp_desc;
03630    boolean              ok;
03631    opnd_type            tmp_opnd;
03632 
03633    TRACE (Func_Entry, "check_for_constructors", NULL);
03634 
03635    switch (OPND_FLD((*top_opnd))) {
03636    case IR_Tbl_Idx:
03637       ir_idx = OPND_IDX((*top_opnd));
03638 
03639       switch (IR_OPR(ir_idx)) {
03640 
03641       case Array_Construct_Opr :
03642 
03643          loc_exp_desc = arg_info_list[IR_IDX_L(ir_idx)].ed;
03644 /*         ok = create_runtime_array_constructor(top_opnd, &loc_exp_desc);*/
03645 /*keep source level array constructor ----fzhao */
03646          ok = TRUE;
03647          if (exp_desc != NULL) {
03648             COPY_SHAPE((exp_desc->shape),
03649                        loc_exp_desc.shape, loc_exp_desc.rank);
03650          }
03651          break;
03652 
03653       case Constant_Array_Construct_Opr :
03654 
03655          loc_exp_desc = arg_info_list[IR_IDX_L(ir_idx)].ed;
03656          ok = create_constructor_constant(top_opnd, &loc_exp_desc);
03657          if (exp_desc != NULL) {
03658             COPY_SHAPE((exp_desc->shape),
03659                        loc_exp_desc.shape, loc_exp_desc.rank);
03660          }
03661          break;
03662 
03663       case Struct_Construct_Opr :
03664          ok = create_runtime_struct_constructor(top_opnd);
03665          break;
03666 
03667       case Constant_Struct_Construct_Opr :
03668          ok = create_constructor_constant(top_opnd, &loc_exp_desc);
03669          break;
03670 
03671       default:
03672          if (exp_desc != NULL) {
03673             loc_exp_desc.dope_vector = exp_desc->dope_vector;
03674             loc_exp_desc.pointer = exp_desc->pointer;
03675             loc_exp_desc.reference = exp_desc->reference;
03676             loc_exp_desc.tmp_reference = exp_desc->tmp_reference;
03677          }
03678 
03679          COPY_OPND(tmp_opnd, IR_OPND_L(ir_idx));
03680          check_for_constructors(&tmp_opnd, exp_desc);
03681          COPY_OPND(IR_OPND_L(ir_idx), tmp_opnd);
03682 
03683          COPY_OPND(tmp_opnd, IR_OPND_R(ir_idx));
03684          check_for_constructors(&tmp_opnd, exp_desc);
03685          COPY_OPND(IR_OPND_R(ir_idx), tmp_opnd);
03686 
03687          if (exp_desc != NULL) {
03688             exp_desc->dope_vector = loc_exp_desc.dope_vector;
03689             exp_desc->pointer = loc_exp_desc.pointer;
03690             exp_desc->reference = loc_exp_desc.reference;
03691             exp_desc->tmp_reference = loc_exp_desc.tmp_reference;
03692          }
03693 
03694          break;
03695 
03696       }
03697       break;
03698 
03699    case IL_Tbl_Idx:
03700       list_idx = OPND_IDX((*top_opnd));
03701 
03702       while (list_idx) {
03703          COPY_OPND(tmp_opnd, IL_OPND(list_idx));
03704          check_for_constructors(&tmp_opnd, exp_desc);
03705          COPY_OPND(IL_OPND(list_idx), tmp_opnd);
03706 
03707          list_idx = IL_NEXT_LIST_IDX(list_idx);
03708       }
03709       break;
03710    }
03711 
03712    TRACE (Func_Exit, "check_for_constructors", NULL);
03713 
03714    return;
03715 
03716 }  /* check_for_constructors */