Open64: osprey/crayf90/fe90/s

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_end.c 5.2 06/16/99 10:02:23\n";
00038 
00039 
00040 # include "defines.h"   /* Machine dependent ifdefs */
00041 
00042 # include "host.m"    /* Host machine dependent macros.*/
00043 # include "host.h"    /* Host machine dependent header.*/
00044 # include "target.m"    /* Target machine dependent macros.*/
00045 # include "target.h"    /* Target machine dependent header.*/
00046 
00047 # include "globals.m"
00048 # include "tokens.m"
00049 # include "sytb.m"
00050 # include "s_globals.m"
00051 # include "debug.m"
00052 
00053 # include "globals.h"
00054 # include "tokens.h"
00055 # include "sytb.h"
00056 # include "s_globals.h"
00057 
00058 
00059 /*****************************************************************\
00060 |* Function prototypes of static functions declared in this file *|
00061 \*****************************************************************/
00062 
00063 
00064 
00065 /******************************************************************************\
00066 |*                        *|
00067 |* Description:                     *|
00068 |*  ADD DESCRIPTION HERE                  *|
00069 |*                        *|
00070 |* Input parameters:                    *|
00071 |*  NONE                      *|
00072 |*                        *|
00073 |* Output parameters:                   *|
00074 |*  NONE                      *|
00075 |*                        *|
00076 |* Returns:                     *|
00077 |*  NONE                      *|
00078 |*                        *|
00079 \******************************************************************************/
00080 
00081 void end_stmt_semantics (void)
00082 
00083 {
00084    int          new_end_idx;
00085    int          new_start_idx;
00086    int          ptr;
00087 
00088 
00089    TRACE (Func_Entry, "end_stmt_semantics", NULL);
00090 
00091    ptr = SCP_EXIT_IR_SH_IDX(curr_scp_idx);
00092 
00093    if (ptr) {
00094       while (SH_NEXT_IDX(ptr) != NULL_IDX) {
00095          ptr = SH_NEXT_IDX(ptr);
00096       }
00097 
00098       copy_entry_exit_sh_list(SCP_EXIT_IR_SH_IDX(curr_scp_idx), ptr,
00099                               &new_start_idx, &new_end_idx);
00100 
00101       insert_sh_chain_before(new_start_idx);
00102    }
00103 
00104    if (opt_flags.inline_lvl > Inline_Lvl_0 ||
00105        opt_flags.modinline || dump_flags.preinline) {
00106       gen_directive_ir(Inline_Cdir_Opr);
00107    }
00108 
00109    if (cdir_switches.bounds) {
00110       gen_directive_ir(Nobounds_Cdir_Opr);
00111    }
00112 
00113    TRACE (Func_Exit, "end_stmt_semantics", NULL);
00114 
00115    return;
00116 
00117 }  /* end_stmt_semantics */
00118 
00119 
00120 /******************************************************************************\
00121 |*                                                                            *|
00122 |* Description:                                                               *|
00123 |*      ADD DESCRIPTION HERE                                                  *|
00124 |*                                                                            *|
00125 |* Input parameters:                                                          *|
00126 |*      NONE                                                                  *|
00127 |*                                                                            *|
00128 |* Output parameters:                                                         *|
00129 |*      NONE                                                                  *|
00130 |*                                                                            *|
00131 |* Returns:                                                                   *|
00132 |*      NONE                                                                  *|
00133 |*                                                                            *|
00134 \******************************************************************************/
00135 
00136 void end_subroutine_semantics (void)
00137 
00138 {
00139    int          new_end_idx;
00140    int          new_start_idx;
00141    int          ptr;
00142 
00143 
00144    TRACE (Func_Entry, "end_subroutine_semantics", NULL);
00145 
00146    ptr = SCP_EXIT_IR_SH_IDX(curr_scp_idx);
00147 
00148    if (ptr) {
00149       while (SH_NEXT_IDX(ptr) != NULL_IDX) {
00150          ptr = SH_NEXT_IDX(ptr);
00151       }
00152 
00153       copy_entry_exit_sh_list(SCP_EXIT_IR_SH_IDX(curr_scp_idx), ptr,
00154                               &new_start_idx, &new_end_idx);
00155    
00156       insert_sh_chain_before(new_start_idx);
00157    }
00158 
00159    if (opt_flags.inline_lvl > Inline_Lvl_0 ||
00160        opt_flags.modinline || dump_flags.preinline) {
00161       gen_directive_ir(Inline_Cdir_Opr);
00162    }
00163 
00164    if (cdir_switches.bounds) {
00165       gen_directive_ir(Nobounds_Cdir_Opr);
00166    }
00167 
00168    TRACE (Func_Exit, "end_subroutine_semantics", NULL);
00169 
00170    return;
00171 
00172 }  /* end_subroutine_semantics */
00173 
00174 
00175 /******************************************************************************\
00176 |*                        *|
00177 |* Description:                     *|
00178 |*  Complete the processing of the END statement for a FUNCTION           *|
00179 |*      subprogram.                   *|
00180 |*                        *|
00181 |* Input parameters:                    *|
00182 |*  NONE                      *|
00183 |*                        *|
00184 |* Output parameters:                   *|
00185 |*  NONE                      *|
00186 |*                        *|
00187 |* Returns:                     *|
00188 |*  NONE                      *|
00189 |*                        *|
00190 \******************************************************************************/
00191 
00192 void end_function_semantics (void)
00193 
00194 {
00195    int                  idx;
00196    int                  ir_idx;
00197    int                  new_end_idx;
00198    size_offset_type     new_size;
00199    int                  new_start_idx;
00200    int                  ptr;
00201    int                  rslt_idx;
00202    size_offset_type     result;
00203    size_offset_type     size;
00204 
00205 
00206    TRACE (Func_Entry, "end_function_semantics", NULL);
00207 
00208    rslt_idx = ATP_RSLT_IDX(SCP_ATTR_IDX(curr_scp_idx));
00209 
00210    if (!ATD_IM_A_DOPE(rslt_idx) &&
00211        ATD_ARRAY_IDX(rslt_idx) == NULL_IDX &&
00212        TYP_TYPE(ATD_TYPE_IDX(rslt_idx)) != Structure &&
00213        TYP_TYPE(ATD_TYPE_IDX(rslt_idx)) != Character) {
00214 
00215       ir_idx      = SH_IR_IDX(curr_stmt_sh_idx);
00216 
00217 # ifdef _SEPARATE_FUNCTION_RETURNS
00218 
00219       if (SCP_ALT_ENTRY_CNT(curr_scp_idx) != 0 &&
00220           SCP_RETURN_LABEL(curr_scp_idx) != NULL_IDX) {
00221 
00222          /* change return to goto to multiple return code block */
00223 
00224          IR_OPR(ir_idx)   = Br_Uncond_Opr;
00225          IR_FLD_R(ir_idx) = AT_Tbl_Idx;
00226          IR_IDX_R(ir_idx) = SCP_RETURN_LABEL(curr_scp_idx);
00227          IR_LINE_NUM_R(ir_idx)  = IR_LINE_NUM(ir_idx);
00228          IR_COL_NUM_R(ir_idx)   = IR_COL_NUM(ir_idx);
00229       }
00230       else {
00231          IR_FLD_R(ir_idx)       = AT_Tbl_Idx;
00232          IR_IDX_R(ir_idx)       = rslt_idx;
00233          IR_LINE_NUM_R(ir_idx)  = IR_LINE_NUM(ir_idx);
00234          IR_COL_NUM_R(ir_idx)   = IR_COL_NUM(ir_idx);
00235       }
00236 # else
00237 
00238       IR_FLD_R(ir_idx)    = AT_Tbl_Idx;
00239       IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
00240       IR_COL_NUM_R(ir_idx)  = IR_COL_NUM(ir_idx);
00241 
00242       if (SCP_ENTRY_IDX(curr_scp_idx)) {
00243          idx  = SCP_ENTRY_IDX(curr_scp_idx);
00244          size = stor_bit_size_of(rslt_idx, TRUE, FALSE);
00245 
00246          /* KAY - Do not allow n$pes in alternate entry function results */
00247 
00248          while (idx != NULL_IDX) {
00249             new_size  = stor_bit_size_of(ATP_RSLT_IDX(AL_ATTR_IDX(idx)),
00250                                            TRUE,
00251                                            FALSE);
00252             size_offset_logical_calc(&new_size, &size, Gt_Opr, &result);
00253 
00254             if (THIS_IS_TRUE(result.constant, result.type_idx)) {
00255                size = new_size;
00256                rslt_idx = ATP_RSLT_IDX(AL_ATTR_IDX(idx));
00257             }
00258             idx   = AL_NEXT_IDX(idx);
00259          }
00260       }
00261 
00262       IR_IDX_R(ir_idx)    = rslt_idx;
00263 # endif
00264    }
00265    else {
00266 
00267       /* Set the function result even if this ends up looking like a          */
00268       /* subroutine.  This lets PDGCS get function not defined messages right.*/
00269 
00270       ir_idx      = SH_IR_IDX(curr_stmt_sh_idx);
00271       IR_FLD_R(ir_idx)    = AT_Tbl_Idx;
00272       IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
00273       IR_COL_NUM_R(ir_idx)  = IR_COL_NUM(ir_idx);
00274       IR_IDX_R(ir_idx)    = rslt_idx;
00275    }
00276 
00277    ptr = SCP_EXIT_IR_SH_IDX(curr_scp_idx);
00278 
00279    if (ptr) {
00280       while (SH_NEXT_IDX(ptr) != NULL_IDX) {
00281          ptr = SH_NEXT_IDX(ptr);
00282       }
00283 
00284       copy_entry_exit_sh_list(SCP_EXIT_IR_SH_IDX(curr_scp_idx), ptr,
00285                               &new_start_idx, &new_end_idx);
00286 
00287       insert_sh_chain_before(new_start_idx);
00288    }
00289 
00290    if (opt_flags.inline_lvl > Inline_Lvl_0 ||
00291        opt_flags.modinline || dump_flags.preinline) {
00292       ir_idx = gen_directive_ir(Inline_Cdir_Opr);
00293    }
00294 
00295    if (cdir_switches.bounds) {
00296       ir_idx = gen_directive_ir(Nobounds_Cdir_Opr);
00297    }
00298 
00299    TRACE (Func_Exit, "end_function_semantics", NULL);
00300 
00301    return;
00302 
00303 }  /* end_function_semantics */
00304 
00305 /******************************************************************************\
00306 |*                                                                            *|
00307 |* Description:                                                               *|
00308 |*      This procedure completes the processing of the END FORALL statement.  *|
00309 |*                                                                            *|
00310 |* Input parameters:                                                          *|
00311 |*      NONE                                                                  *|
00312 |*                                                                            *|
00313 |* Output parameters:                                                         *|
00314 |*      NONE                                                                  *|
00315 |*                                                                            *|
00316 |* Returns:                                                                   *|
00317 |*      NONE                                                                  *|
00318 |*                                                                            *|
00319 \******************************************************************************/
00320 
00321 void end_forall_semantics (void)
00322 
00323 {
00324    int                  ir_idx;
00325    int      list_idx;
00326    int                  sh_idx;
00327 
00328 
00329    TRACE (Func_Entry, "end_forall_semantics", NULL);
00330 
00331    sh_idx = SH_PARENT_BLK_IDX(curr_stmt_sh_idx);
00332 
00333    if (SH_ERR_FLG(curr_stmt_sh_idx) || SH_ERR_FLG(sh_idx)) {
00334       goto EXIT;
00335    }
00336 
00337 # ifdef _DEBUG
00338    if (sh_idx == NULL_IDX) {
00339       PRINTMSG(SH_GLB_LINE(curr_stmt_sh_idx), 626, Internal,
00340                SH_COL_NUM(curr_stmt_sh_idx),
00341                "SH_PARENT_BLK_IDX", "end_forall_semantics");
00342    }
00343 # endif
00344 
00345    ir_idx = SH_IR_IDX(sh_idx);
00346 
00347 # ifdef _DEBUG
00348    if (IR_OPR(ir_idx) != Forall_Opr) {
00349       PRINTMSG(SH_GLB_LINE(curr_stmt_sh_idx), 626, Internal,
00350                SH_COL_NUM(curr_stmt_sh_idx),
00351                "Forall_Opr", "end_forall_semantics");
00352    }
00353 # endif
00354 
00355    list_idx = IR_IDX_R(ir_idx);
00356 
00357    while (list_idx &&
00358           IL_FLD(list_idx) == IL_Tbl_Idx) {
00359 
00360       AT_ATTR_LINK(IL_IDX(IL_IDX(list_idx))) = NULL_IDX;
00361       AT_IGNORE_ATTR_LINK(IL_IDX(IL_IDX(list_idx))) = FALSE;
00362 
00363       list_idx = IL_NEXT_LIST_IDX(list_idx);
00364    }
00365 
00366 EXIT:
00367 
00368    active_forall_sh_idx = SH_PARENT_BLK_IDX(active_forall_sh_idx);
00369 
00370    if (active_forall_sh_idx == NULL_IDX) {
00371       within_forall_construct = FALSE;
00372    }
00373 
00374    TRACE (Func_Exit, "end_forall_semantics", NULL);
00375 
00376    return;
00377 
00378 }  /* end_forall_semantics */
00379 
00380 #ifndef _HIGH_LEVEL_IF_FORM
00381 
00382 
00383 /******************************************************************************\
00384 |*                        *|
00385 |* Description:                     *|
00386 |*  Complete the processing of the END SELECT statement.          *|
00387 |*                        *|
00388 |* Input parameters:                    *|
00389 |*  NONE                      *|
00390 |*                        *|
00391 |* Output parameters:                   *|
00392 |*  NONE                      *|
00393 |*                        *|
00394 |* Returns:                     *|
00395 |*  NONE                      *|
00396 |*                        *|
00397 \******************************************************************************/
00398 
00399 void end_if_semantics (void)
00400 
00401 {
00402    int    if_ir_idx;
00403    int    if_sh_idx;
00404    int    il_idx;
00405    int    ir_idx;
00406    int    lbl_idx;
00407    int    sh_idx;
00408    opnd_type  tmp_opnd;
00409 
00410 
00411    TRACE (Func_Entry, "end_if_semantics", NULL);
00412 
00413 
00414    /* Walk back through the IF construct to find the IF construct SH.         */
00415    /* If it's marked in error, bail.                */
00416 
00417    if_sh_idx = SH_PARENT_BLK_IDX(curr_stmt_sh_idx);
00418 
00419    while (SH_STMT_TYPE(if_sh_idx) != If_Cstrct_Stmt) {
00420 
00421       if (SH_STMT_TYPE(if_sh_idx) == Else_Stmt) {
00422          if_sh_idx = IR_IDX_L(SH_IR_IDX(if_sh_idx));
00423       }
00424       else {
00425          if_sh_idx = IL_IDX(IL_NEXT_LIST_IDX(IR_IDX_R(SH_IR_IDX(if_sh_idx))));
00426       }
00427    }
00428 
00429    if (SH_ERR_FLG(if_sh_idx)) {
00430       goto EXIT;
00431    }
00432 
00433    lbl_idx = IL_IDX(IL_NEXT_LIST_IDX(IR_IDX_R(SH_IR_IDX(if_sh_idx))));
00434    AT_DEFINED(lbl_idx)       = TRUE;
00435    AT_DEF_LINE(lbl_idx)      = stmt_start_line;
00436    ATL_DEF_STMT_IDX(lbl_idx) = curr_stmt_sh_idx;
00437    AT_REFERENCED(lbl_idx)    = Referenced;
00438 
00439 
00440    /* If the last clause of the IF construct is an ELSE IF, generate a        */
00441    /* CONTINUE statement to define its branch-around label.                   */
00442 
00443    if (SH_STMT_TYPE(SH_PARENT_BLK_IDX(curr_stmt_sh_idx)) == Else_If_Stmt) {
00444       gen_sh(Before, Continue_Stmt, stmt_start_line, stmt_start_col,
00445              FALSE,
00446              TRUE,          /* Labeled.       */
00447              TRUE);         /* Compiler-generated */
00448 
00449       sh_idx              = SH_PREV_IDX(curr_stmt_sh_idx);
00450       NTR_IR_TBL(ir_idx);
00451       SH_IR_IDX(sh_idx)   = ir_idx;
00452       IR_OPR(ir_idx)      = Label_Opr;
00453       IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE;
00454       IR_LINE_NUM(ir_idx) = stmt_start_line;
00455       IR_COL_NUM(ir_idx)  = stmt_start_col;
00456       IR_LINE_NUM_L(ir_idx) = stmt_start_line;
00457       IR_COL_NUM_L(ir_idx)  = stmt_start_col;
00458       IR_FLD_L(ir_idx)    = AT_Tbl_Idx;
00459       lbl_idx             =
00460          IL_IDX(IR_IDX_R(SH_IR_IDX(SH_PARENT_BLK_IDX(curr_stmt_sh_idx))));
00461       IR_IDX_L(ir_idx)    = lbl_idx; 
00462 
00463       AT_DEFINED(lbl_idx)       = TRUE;
00464       AT_DEF_LINE(lbl_idx)      = stmt_start_line;
00465       ATL_DEF_STMT_IDX(lbl_idx) = sh_idx;
00466       AT_REFERENCED(lbl_idx)    = Referenced;
00467    }
00468 
00469 
00470    /* Generate a CONTINUE statement to define the "end IF" label.             */
00471    /* If there were no ELSE IF's and no ELSE, get the label from the first IL */
00472    /* attached to the right operand of the If_Opr IR attached to the If_Cstrct*/
00473    /* SH.  Otherwise, get the label from the second IL.           */
00474 
00475    gen_sh(Before, Continue_Stmt, stmt_start_line, stmt_start_col,
00476           FALSE,
00477           TRUE,           /* Labeled.       */
00478           TRUE);          /* Compiler-generated */
00479 
00480    sh_idx                            = SH_PREV_IDX(curr_stmt_sh_idx);
00481    NTR_IR_TBL(ir_idx);
00482    SH_IR_IDX(sh_idx)                 = ir_idx;
00483    IR_OPR(ir_idx)                    = Label_Opr;
00484    IR_TYPE_IDX(ir_idx)               = TYPELESS_DEFAULT_TYPE;
00485    IR_LINE_NUM(ir_idx)               = stmt_start_line;
00486    IR_COL_NUM(ir_idx)                = stmt_start_col;
00487    IR_LINE_NUM_L(ir_idx)             = stmt_start_line;
00488    IR_COL_NUM_L(ir_idx)              = stmt_start_col;
00489    IR_FLD_L(ir_idx)                  = AT_Tbl_Idx;
00490 
00491    if_ir_idx = SH_IR_IDX(if_sh_idx);
00492 
00493    if (SH_STMT_TYPE(SH_PARENT_BLK_IDX(curr_stmt_sh_idx)) == If_Cstrct_Stmt) {
00494       lbl_idx = IL_IDX(IR_IDX_R(if_ir_idx)); 
00495    }
00496    else {
00497       lbl_idx = IL_IDX(IL_NEXT_LIST_IDX(IR_IDX_R(if_ir_idx)));
00498    }
00499    
00500    IR_IDX_L(ir_idx)           = lbl_idx;
00501 
00502    AT_DEFINED(lbl_idx)        = TRUE;
00503    AT_DEF_LINE(lbl_idx)       = stmt_start_line;
00504    ATL_DEF_STMT_IDX(lbl_idx)  = sh_idx;
00505    AT_REFERENCED(lbl_idx)     = Referenced;
00506 
00507 
00508    /* Walk back through the IF construct and transfer the branch around label */
00509    /* for each ELSE IF and for the IF itself to the right operand of each     */
00510    /* Br_True IR (replacing the IL list).  The IL_OPND is copied to a temp    */
00511    /* first because sometimes assignments get a little funky using these      */
00512    /* macros if the target is also being used to access the source.           */
00513    /* LRR:  If we're gettting tight on space, could also delete the IL nodes. */
00514 
00515    if_sh_idx = SH_PARENT_BLK_IDX(curr_stmt_sh_idx);
00516 
00517    while (SH_STMT_TYPE(if_sh_idx) != If_Cstrct_Stmt) {
00518 
00519       if (SH_STMT_TYPE(if_sh_idx) == Else_Stmt) {
00520          sh_idx            = if_sh_idx;
00521          if_sh_idx         = IR_IDX_L(SH_IR_IDX(if_sh_idx));
00522          SH_IR_IDX(sh_idx) = NULL_IDX;
00523       }
00524       else {
00525          il_idx = IL_NEXT_LIST_IDX(IR_IDX_R(SH_IR_IDX(if_sh_idx)));
00526          COPY_OPND(tmp_opnd, IL_OPND(IR_IDX_R(SH_IR_IDX(if_sh_idx))));
00527          COPY_OPND(IR_OPND_R(SH_IR_IDX(if_sh_idx)), tmp_opnd);
00528          if_sh_idx = IL_IDX(il_idx);
00529       }
00530    }
00531 
00532    COPY_OPND(tmp_opnd, IL_OPND(IR_IDX_R(if_ir_idx)));
00533    COPY_OPND(IR_OPND_R(if_ir_idx), tmp_opnd);
00534 
00535 EXIT:
00536 
00537    TRACE (Func_Exit, "end_if_semantics", NULL);
00538 
00539    return;
00540 
00541 }  /* end_if_semantics */
00542 
00543 #endif
00544 
00545 
00546 /******************************************************************************\
00547 |*                        *|
00548 |* Description:                     *|
00549 |*  Complete the processing of the END SELECT statement.          *|
00550 |*                        *|
00551 |* Input parameters:                    *|
00552 |*  NONE                      *|
00553 |*                        *|
00554 |* Output parameters:                   *|
00555 |*  NONE                      *|
00556 |*                        *|
00557 |* Returns:                     *|
00558 |*  NONE                      *|
00559 |*                        *|
00560 \******************************************************************************/
00561 
00562 void end_select_semantics (void)
00563 
00564 {
00565    int  i;
00566    int  il_idx;
00567    int  ir_idx;
00568    int  next_il_idx;
00569 
00570 
00571    TRACE (Func_Entry, "end_select_semantics", NULL);
00572 
00573    if (! SH_ERR_FLG(SH_PARENT_BLK_IDX(curr_stmt_sh_idx))) {
00574 
00575       ir_idx = SH_IR_IDX(SH_PARENT_BLK_IDX(curr_stmt_sh_idx));
00576       SH_IR_IDX(SH_PARENT_BLK_IDX(curr_stmt_sh_idx)) = IR_IDX_L(ir_idx);
00577 
00578       il_idx = IR_IDX_R(ir_idx);
00579      
00580       for (i = 1;  i <= IR_LIST_CNT_R(ir_idx); i++) {
00581          next_il_idx = IL_NEXT_LIST_IDX(il_idx);
00582          FREE_IR_LIST_NODE(il_idx);
00583          il_idx = next_il_idx;
00584       }
00585 
00586       FREE_IR_NODE(ir_idx);
00587    }
00588 
00589    TRACE (Func_Exit, "end_select_semantics", NULL);
00590 
00591    return;
00592 
00593 }  /* end_select_semantics */
00594 
00595 
00596 /******************************************************************************\
00597 |*                        *|
00598 |* Description:                     *|
00599 |*  Complete the processing of the END WHERE statement.               *|
00600 |*                        *|
00601 |* Input parameters:                    *|
00602 |*  NONE                      *|
00603 |*                        *|
00604 |* Output parameters:                   *|
00605 |*  NONE                      *|
00606 |*                        *|
00607 |* Returns:                     *|
00608 |*  NONE                      *|
00609 |*                        *|
00610 \******************************************************************************/
00611 
00612 void end_where_semantics (void)
00613 
00614 {
00615    int    sh_idx;
00616 
00617    TRACE (Func_Entry, "end_where_semantics", NULL);
00618 
00619    where_ir_idx = NULL_IDX;
00620 
00621    if (where_dealloc_stmt_idx) {
00622       SH_NEXT_IDX(where_dealloc_stmt_idx) = SH_NEXT_IDX(curr_stmt_sh_idx);
00623       SH_PREV_IDX(where_dealloc_stmt_idx) = curr_stmt_sh_idx;
00624       SH_PREV_IDX(SH_NEXT_IDX(curr_stmt_sh_idx)) = where_dealloc_stmt_idx;
00625       SH_NEXT_IDX(curr_stmt_sh_idx) = where_dealloc_stmt_idx;
00626       
00627       where_dealloc_stmt_idx = NULL_IDX;
00628    }
00629 
00630    sh_idx = SH_PARENT_BLK_IDX(curr_stmt_sh_idx);
00631 
00632    while (sh_idx != NULL_IDX &&
00633           SH_STMT_TYPE(sh_idx) != Where_Cstrct_Stmt) {
00634       sh_idx = SH_PARENT_BLK_IDX(sh_idx);
00635    }
00636 
00637    if (sh_idx != NULL_IDX &&
00638        (SH_PARENT_BLK_IDX(sh_idx) == NULL_IDX ||
00639         (SH_STMT_TYPE(SH_PARENT_BLK_IDX(sh_idx)) != Where_Cstrct_Stmt &&
00640          SH_STMT_TYPE(SH_PARENT_BLK_IDX(sh_idx)) != Else_Where_Stmt &&
00641          SH_STMT_TYPE(SH_PARENT_BLK_IDX(sh_idx)) != Else_Where_Mask_Stmt))) {
00642 
00643       alloc_block_start_idx = NULL_IDX;
00644       alloc_block_end_idx = NULL_IDX;
00645    }
00646 
00647    if (sh_idx != NULL_IDX &&
00648        SH_PARENT_BLK_IDX(sh_idx) != NULL_IDX) {
00649 
00650       sh_idx = SH_PARENT_BLK_IDX(sh_idx);
00651 
00652       if (SH_STMT_TYPE(sh_idx) == Where_Cstrct_Stmt ||
00653           SH_STMT_TYPE(sh_idx) == Else_Where_Stmt ||
00654           SH_STMT_TYPE(sh_idx) == Else_Where_Mask_Stmt) {
00655 
00656          if (IR_FLD_L(SH_IR_IDX(sh_idx)) == IL_Tbl_Idx) {
00657             where_ir_idx = IL_IDX(IR_IDX_L(SH_IR_IDX(sh_idx)));
00658          }
00659       }
00660       else if (SH_STMT_TYPE(sh_idx) == Forall_Cstrct_Stmt) {
00661          active_forall_sh_idx = sh_idx;
00662       }
00663 # ifdef _DEBUG
00664       else {
00665          PRINTMSG(SH_GLB_LINE(sh_idx), 626, Internal, SH_COL_NUM(sh_idx),
00666                   "Forall_Opr", "end_where_semantics");
00667       }
00668 # endif
00669    }
00670 
00671    TRACE (Func_Exit, "end_where_semantics", NULL);
00672 
00673    return;
00674 
00675 }  /* end_where_semantics */
osprey/crayf90/fe90/s_end.c
