osprey/be/be/omp_lower.cxx

Go to the documentation of this file.

/*
 * Copyright 2004, 2005, 2006 PathScale, Inc.  All Rights Reserved.
 */

/*

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

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

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

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

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

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

  http://www.sgi.com

  For further information regarding this notice, see:

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

*/


/* ====================================================================
 * Module: omp_lower.cxx
 * $Revision: 1.25 $
 * $Date: 05/12/22 15:18:19-08:00 $
 * $Author: gautam@jacinth.keyresearch $
 * $Source: /scratch/mee/2.4-65/kpro64-pending/be/be/SCCS/s.omp_lower.cxx $
 *
 * Revision history:
 *  26-Jun-97 : First created by Dave Kohr
 *
 * Description:
 * Functions for transforming WHIRL trees based on OpenMP pragmas.
 *
 * Exported functions:
 * OMP_Prelower() : Transform Open MP pragmas to same form as MP ones
 * ==================================================================== */

#define __STDC_LIMIT_MACROS
#include <stdint.h>
#include <sys/types.h>
#if ! defined(BUILD_OS_DARWIN)
#include <elf.h>        /* for wn.h */
#endif /* ! defined(BUILD_OS_DARWIN) */

#include "defs.h"
#include "wn.h"
#include "erbe.h"

#include "symtab.h"

#include "mtypes.h"
#include "wn_util.h"
#include "config_targ.h"
#include "const.h"
#include "cxx_template.h"
#include "cxx_hash.h"
#include "pu_info.h"
#include "omp_lower.h"
#include "srcpos.h"
#include "tracing.h"
#include "lnopt_main.h"
#include "wn_simp.h"
#include "strtab.h"
#include "region_util.h"
#include "config.h"
#include "prompf.h"
#include "anl_driver.h"
#include "cxx_memory.h"
#include "wb_buffer.h"
#include "wb_carray.h"
#include "wb_browser.h"
#include "wb.h"
#include "wb_omp.h"
#include "privatize_common.h"
#include "targ_const.h"
#include "dra_export.h"
#include "be_symtab.h"

#if !defined(BUILD_OS_DARWIN) && !defined(BUILD_SKIP_PROMPF)
#pragma weak Anl_File_Path
#pragma weak New_Construct_Id
#endif /* ! defined(BUILD_OS_DARWIN) */

/***********************************************************************
 * Local constants, types, etc.
 ***********************************************************************/

static const mINT32 NUM_HASH_ELEMENTS = 1021;

typedef HASH_TABLE<ST_IDX, BOOL> ST_TO_BOOL_HASH;

typedef enum {  // what kind of scope rule determined a var's scope
  BY_EXPLICIT_CLAUSE, // explicit SHARED(var) or PRIVATE(var) clause
  BY_DEFAULT_CLAUSE,  // DEFAULT(SHARED) or DEFAULT(PRIVATE) clause
  BY_THREADPRIVATE,   // explicit THREADPRIVATE directive
  BY_DEFAULT_SHARED,  // by the rule that DEFAULT(SHARED) is the default
  BY_REDUCTION        // var is a reduction variable
} SCOPE_RULE_KIND;

  // Dynamic array of Whirl nodes.  We use these for 2 purposes: to
  // represent the pragmas applying to a nest of parallel constructs
  // (listed from outermost to innermost), and to represent the set of
  // parallel constructs nested within a parallel construct (immediate
  // children only, rather than all descendant constructs).
typedef DYN_ARRAY<WN *> WN_LIST;

typedef STACK<WN *> STACK_OF_WN;

typedef STACK<WN_LIST *> WN_LIST_STACK;

/* critical_st is a stack of STs: each omp_critical_begin pushes the
 * ST onto this stack, each omp_critical_end pops the ST.
 * This variable is used to ensure that the critical_section "name"
 * appears in both critical-begin and critical-end, making
 * code-generation subsequently in the MP-lowerer much easier.
 */
DYN_ARRAY<ST*> critical_st;

typedef HASH_TABLE<WN *, BOOL> WN_TO_BOOL_HASH;


/***********************************************************************
 * Local variable definitions
 ***********************************************************************/

static MEM_POOL omp_pool;
static MEM_POOL Omp_Local_Pool;
static WN_MAP Omp_Parent_Map = WN_MAP_UNDEFINED;
  // index variable privatization pragmas generated by OMP Prelowerer
WN_TO_BOOL_HASH *Index_Priv_From_OMPL;


/***********************************************************************
 * Local macros
 ***********************************************************************/

#define Set_Parent(wn, p) (WN_MAP_Set(Omp_Parent_Map, wn, (void*)  p))
#define Get_Parent(wn) ((WN*) WN_MAP_Get(Omp_Parent_Map, (WN*) wn))


/*
Note: at some points in the code, the usual interpretation of the type
WN_PRAGMA_DEFAULT_KIND is modified: instead of referring to the kind of
DEFAULT scope in effect for a parallel region, we use it to refer to the
scope in effect for a specific variable.  In these cases, the value
WN_PRAGMA_DEFAULT_UNKNOWN means no scope is specified (either explicitly or
by DEFAULT), WN_PRAGMA_DEFAULT_SHARED and WN_PRAGMA_DEFAULT_PRIVATE have
the obvious meanings, and WN_PRAGMA_DEFAULT_NONE should never occur.  We
use WN_PRAGMA_DEFAULT_KIND in these cases rather than define another
nearly-identical enum.
*/


/***********************************************************************
 * Local function declarations
 ***********************************************************************/

static ST *Mem_Ref_To_Var(WN *wn);
static WN_PRAGMA_DEFAULT_KIND
  Var_Scope_In_Region(ST *st, WN *pragma_block, SCOPE_RULE_KIND *how,
                      WN **scope_prag = NULL);
static WN_PRAGMA_DEFAULT_KIND
  Var_Scope(ST *st, WN_LIST *pragma_block_list, SCOPE_RULE_KIND *how,
            WN **scope_prag = NULL);
static WN *Par_Region_Pragma_Block(WN *wn, BOOL *is_worksharing);
static BOOL Pragmas_For_Par_Region(WN *pragma_blk, BOOL *is_worksharing);
static WN *Translate_OMP_to_MP(WN *pu);
static void
  Infer_Reduction_Operators(WN *wn, WN_LIST_STACK *reduction_stack);
static OPERATOR Reduction_Operator(WN *redn_pragma, WN *assign_stmt);
static BOOL ST_is_Index_Var_For_Enclosing_PDO(ST *var_st, WN *wn);
static void Apply_Default_Scopes(WN *pu, WN_LIST *construct_pragma_block_list);
static void
Apply_Par_Region_Default_Scopes(WN *wn, ST_TO_BOOL_HASH *processed,
                                WN *pragma_block,
                                WN_LIST *construct_pragma_block_list,
        WN_PRAGMA_DEFAULT_KIND defsc);
static void
Privatize_Index_Vars_And_Check_Final_Scopes(
    WN *wn, WN_LIST *pragma_block_list, WN *enclosing_pdo,
    ST_TO_BOOL_HASH *processed, WN_LIST *nested_constructs,
    BOOL top_of_construct);
static mINT32 WN_Find_Linenum(WN *wn);
static BOOL Is_Assumed_Size_Or_Shape_Array(TY *ty);
static BOOL Can_Apply_Default_Private(ST *st, WN *pragma_block);
static BOOL ST_Is_Const(ST *st);
static void OMP_File_Init();
static void Parentize(WN *wn);
static WN *Is_Section_Begin(WN *wn);
static WN *Lower_Master(WN *wn);
static void Lower_Fetch_And_Op(WN *wn);
static void Lower_Atomic(WN *wn);
static void Convert_Section_To_Pdo(WN *sections, WN *pragma);

static TY_IDX Get_Func_Zero_Arg_TY ();
static TY_IDX Get_Func_One_Arg_TY ();
static BOOL Is_Ordered_Do (WN* wn);
static WN *Add_Ordered_XPragmas (WN* wn);
static void Add_Memory_Barriers (WN *wn);
static void Convert_Simple_To_Interleaved (WN *wn);
static void Convert_Just_Chunksize_To_Dynamic (WN *wn);

#ifdef TARG_SL2 //fork_joint
static WN *Is_SL2_Section_Begin(WN *wn);
static void Convert_SL2_Section_To_Pdo(WN *sections, WN *pragma);
#endif 

//-----------------------------------------------------------------------
// NAME: OMP_Prompf_Init
// FUNCTION: Initialize PROMPF processing for current function.
//-----------------------------------------------------------------------

static void OMP_Prompf_Init(WN* func_nd)
{
#ifndef BUILD_SKIP_PROMPF
  if (Run_prompf) {
    Prompf_Info->Enable();
    Prompf_Info->Mark_Omp();
    WB_OMP_Set_Prompf_Info(Prompf_Info);
  }
#endif
}

//-----------------------------------------------------------------------
// NAME: OMP_Prompf_Finish
// FUNCTION: Finish off PROMPF processing for current function.
//-----------------------------------------------------------------------

static void OMP_Prompf_Finish()
{
#ifndef BUILD_SKIP_PROMPF
  if (Run_prompf) {
    const char *path = Anl_File_Path();
    FILE *fp_anl = fopen(path, "a");
    Prompf_Info->Print_Compact(fp_anl, PTL_OMP);
    fclose(fp_anl);
    Prompf_Info->Disable();
  }
#endif
}


/***********************************************************************
 * Given a PU_Info and a WN for a program unit, perform the first step of
 * OMP lowering on that PU.
 *
 * Return the WN for the lowered PU.
 ***********************************************************************/

#if defined(BUILD_OS_DARWIN)
/* Bug in gcc 4.0.1? Previous extern "C" declaration in omp_lower.h ignored */
extern "C" { WN *OMP_Prelower(PU_Info *current_pu, WN *pu); }
#endif /* defined(BUILD_OS_DARWIN) */

WN *OMP_Prelower(PU_Info *current_pu, WN *pu)
{
  // one time initializations
  static BOOL omp_initialized = FALSE;
  if (!omp_initialized) {
    OMP_File_Init();
    omp_initialized = TRUE;
  }

  MEM_POOL_Popper popper(&omp_pool);

  WN_TO_BOOL_HASH index_priv_set(NUM_HASH_ELEMENTS, &omp_pool);
  Index_Priv_From_OMPL = &index_priv_set;

    // Rename_Privatized_COMMON() doesn't know about parent maps, so run it now
  RENAMING_STACK rename_common_stack(&omp_pool);
  rename_common_stack.Push(CXX_NEW(RENAMING_SCOPE(NULL, &omp_pool),
                                   &omp_pool));
  Rename_Privatized_COMMON(pu, &rename_common_stack);
  Is_True(rename_common_stack.Elements() == 1,
          ("OMP_Prelower(): rename_common_stack.Elements() != 1"));

# ifdef KEY
  RENAMING_SCOPE rename_common(NULL, &omp_pool);
  RENAMING_SCOPE rename_common_blk(NULL, &omp_pool);
  RENAMING_STACK rename_scope_stack(&omp_pool);
  rename_scope_stack.Push(CXX_NEW(RENAMING_SCOPE(NULL, &omp_pool),
                                   &omp_pool));
  Rename_Threadprivate_COMMON(pu, pu, pu, 
                             &rename_scope_stack, 
                             &rename_common,
                             &rename_common_blk);
# endif

    // create parent map
  Omp_Parent_Map = WN_MAP_Create(&omp_pool);
  Set_Parent(pu, NULL); // since we can't determine it
  Parentize(pu);  
  WB_OMP_Set_Parent_Map(Omp_Parent_Map); 
  OMP_Prompf_Init(pu); 

  critical_st.Set_Mem_Pool (&omp_pool);

  pu = Translate_OMP_to_MP(pu);
#if defined(TARG_SL2)
  if(Cur_PU_Feedback)
  Cur_PU_Feedback->Verify("sl2 psection conversion");
#endif

#if defined(TARG_SL) && defined(TARG_SL2)
  if(Cur_PU_Feedback)
    Cur_PU_Feedback->Verify("sl2 psection conversion");
#endif

  FmtAssert (critical_st.Elements() == 0,
             ("Mismatch in begin-critical and end-critical pragmas"));
  critical_st.Free_array ();

  WN_LIST_STACK reduction_stack(&omp_pool);

  Infer_Reduction_Operators(pu, &reduction_stack);

  WN_LIST pragma_block_list(&omp_pool);  // initially-empty list of pragmas
  Apply_Default_Scopes(pu, &pragma_block_list);

  Is_True(pragma_block_list.Lastidx() < 0,
          ("unmatched scope push in Apply_Default_Scopes()"));

    // initially-empty processed vars
  ST_TO_BOOL_HASH processed_set(NUM_HASH_ELEMENTS, &omp_pool);
  WN_LIST nested_set(&omp_pool);  // initially-empty nested constructs

  Privatize_Index_Vars_And_Check_Final_Scopes(
      pu, &pragma_block_list, NULL, &processed_set, &nested_set, TRUE);

  Is_True(pragma_block_list.Lastidx() < 0,
          ("unmatched scope push in "
     "Privatize_Index_Vars_And_Check_Final_Scopes()"));

  WN_MAP_Delete(Omp_Parent_Map);
  OMP_Prompf_Finish(); 

  return pu;
}


/***********************************************************************
 * Given a WN that corresponds to a store (STID or ISTORE), return the
 * symbol being stored into.
 ***********************************************************************/

static ST *Store_ST(WN *wn)
{
  ST *st = NULL;

  switch (WN_operator(wn)) {
  case OPR_STID:
    st = WN_st(wn); // store into scalar
    break;

  case OPR_ISTORE:
    {
      WN *kid1 = WN_kid1(wn);

      switch (WN_operator(kid1)) {
      case OPR_ARRAY:
        Is_True(WN_operator(WN_kid0(kid1)) == OPR_LDA ||
                WN_operator(WN_kid0(kid1)) == OPR_LDID,
                ("expected LDA or LDID as kid0 of ARRAY"));
        st = WN_st(WN_kid0(kid1));  // store into array element
        break;

      case OPR_LDID:
        st = WN_st(kid1); // store via pointer

      default:
        Is_True(0, ("could not find symbol for target of ISTORE"));
      }
    }
    break;

  default:
    Is_True(0, ("could not find symbol for target of store"));
  }

  return st;
}


/***********************************************************************
 * Given a WN, determine whether or not it can possibly perform a load
 * or store of (memory reference to) a variable.  If it can't, return NULL;
 * otherwise, return a pointer to the variable's symbol table entry.
 ***********************************************************************/

static ST *Mem_Ref_To_Var(WN *wn)
{
  Is_True(wn, ("Mem_Ref_To_Var(): NULL wn argument"));
/*
all DRK comments:
For now, we just handle easy cases: LDA, LDID, and STID.  Need to handle
  all other cases, once I figure them out
Need to look at which pragmas (like prefetch) can be mem refs
*/

  switch (WN_operator(wn)) {
  case OPR_LDA:
  case OPR_LDID:
  case OPR_STID:
    break;
  default:
    return NULL;
  }

  ST *retval = WN_st(wn);

    // Screen out references to things that aren't variables in the
    // original program.
  if (ST_class(retval) != CLASS_VAR)
    return NULL;

  return retval;
}

/***********************************************************************
 * Given an ST and the pragma block for the Whirl region for a parallel
 * region or work-sharing construct that uses the ST, return the scope of
 * the ST.  Also, in output parameter how, return what kind of rule
 * determined ST's scope.  If output parameter scope_prag is not NULL,
 * and the scope was determined by a scope or DEFAULT pragma,
 * then return that pragma in *scope_prag. If pragma_block doesn't specify
 * an explict scope for ST or a default scope and the Whirl region was not
 * an OMP parallel region, the return value is WN_PRAGMA_DEFAULT_UNKNOWN,
 * and the return parameter how is undefined.  If pragma_block specifies
 * that ST is a reduction variable, the return value is
 * WN_PRAGMA_DEFAULT_PRIVATE and return parameter how is BY_REDUCTION.
 * If ST is a THREADPRIVATE COMMON block or element of such a block,
 * the return value is WN_PRAGMA_DEFAULT_PRIVATE and return parameter how
 * is BY_THREADPRIVATE.
 ***********************************************************************/

static WN_PRAGMA_DEFAULT_KIND
Var_Scope_In_Region(ST *st, WN *pragma_block, SCOPE_RULE_KIND *how,
                    WN **scope_prag)
{
    // Check if st is THREADPRIVATE.  The THREADPRIVATE bit is set on
    // the split common block (if there is one), or else the source
    // common block (if there is no split common).
  ST *split_blk;
  ST *common_blk = ST_Source_COMMON_Block(st, &split_blk);

  if (ST_is_thread_private(st) ||
      (split_blk && ST_is_thread_private(split_blk)) ||
      (common_blk && ST_is_thread_private(common_blk))) {
    *how = BY_THREADPRIVATE;
    return WN_PRAGMA_DEFAULT_PRIVATE;
  }

    // search for explicit scope or reduction clause
  WN_PRAGMA_DEFAULT_KIND defsc = WN_PRAGMA_DEFAULT_UNKNOWN;
  BOOL dummy, is_par_region = Pragmas_For_Par_Region(pragma_block, &dummy);

  *how = BY_EXPLICIT_CLAUSE;
  for (WN *prag = WN_first(pragma_block); prag; prag = WN_next(prag))
    if (WN_opcode(prag) == OPC_PRAGMA) {
      WN_PRAGMA_ID prag_id = (WN_PRAGMA_ID) WN_pragma(prag);

      switch (prag_id) {
      case WN_PRAGMA_LOCAL:
      case WN_PRAGMA_LASTLOCAL:
      case WN_PRAGMA_FIRSTPRIVATE:
      case WN_PRAGMA_SHARED:
      case WN_PRAGMA_REDUCTION:
        {
          ST *prag_st = WN_st(prag);

          if (prag_st == st || split_blk == prag_st ||
              common_blk == prag_st) {
            if (prag_id == WN_PRAGMA_SHARED) {
              if (scope_prag)
                *scope_prag = prag;
              return WN_PRAGMA_DEFAULT_SHARED;
            } else {
              if (prag_id == WN_PRAGMA_REDUCTION)
                *how = BY_REDUCTION;
              if (scope_prag)
                *scope_prag = prag;
              return WN_PRAGMA_DEFAULT_PRIVATE;
            }
          }
        }
        break;
      case WN_PRAGMA_DEFAULT: // found a DEFAULT clause
        defsc = (WN_PRAGMA_DEFAULT_KIND) WN_pragma_arg1(prag);
        if (scope_prag)
          *scope_prag = prag;
        break;
      default:
        break;
      }
    }

  *how = BY_DEFAULT_CLAUSE; // apply DEFAULT clause, if any
  switch (defsc) {
  case WN_PRAGMA_DEFAULT_SHARED:
  case WN_PRAGMA_DEFAULT_PRIVATE:
    return defsc;
  default:
    break;
  }

  if (is_par_region) {
    *how = BY_DEFAULT_SHARED; // no clauses found, use default DEFAULT(SHARED)
    return WN_PRAGMA_DEFAULT_SHARED;
  }

  return WN_PRAGMA_DEFAULT_UNKNOWN;
}


/***********************************************************************
 * Given an ST and the list of pragmas for the parallel constructs within
 * which a use of the ST appears, return the scope of the ST based on
 * those pragmas.  Also, in output parameter how, return what kind of rule
 * determined ST's scope.  If none of the constructs were parallel regions
 * and none specified a scope for ST, the return value is
 * WN_PRAGMA_DEFAULT_UNKNOWN and return parameter how is undefined.
 * Reduction variables and THREADPRIVATE COMMON blocks are handled as per
 * Var_Scope_In_Region().
 ***********************************************************************/

static WN_PRAGMA_DEFAULT_KIND
Var_Scope(ST *st, WN_LIST *pragma_block_list, SCOPE_RULE_KIND *how,
          WN **scope_prag)
{
  WN_PRAGMA_DEFAULT_KIND retval;
  *how = BY_DEFAULT_SHARED;

  Is_True(pragma_block_list->Lastidx() >= 0,
          ("Var_Scope() called outside a parallel construct"));

    // search for innermost scope clause that applies to st
  for (INT idx = pragma_block_list->Lastidx(); idx >= 0; idx--) {
    if ((retval = Var_Scope_In_Region(st, (*pragma_block_list)[idx],
                                      how, scope_prag) ) !=
        WN_PRAGMA_DEFAULT_UNKNOWN)
      break;
  }

  return retval;
}


/***********************************************************************
 * If the given WN is a parallel region (i.e. wn is a region, and one of
 * its pragmas denotes a parallel region), return the block of pragmas that
 * applies to the region.  Otherwise, return NULL.  Return parameter
 * is_worksharing is TRUE if wn was a worksharing construct (combined in
 * a parallel region or not), FALSE otherwise.
 ***********************************************************************/

static WN *Par_Region_Pragma_Block(WN *wn, BOOL *is_worksharing)
{
  Is_True(wn, ("Par_Region_Pragma_Block(): NULL wn argument"));

  *is_worksharing = FALSE;
  if (WN_opcode(wn) != OPC_REGION)
    return NULL;

  WN *pragma_blk = WN_region_pragmas(wn);

  return Pragmas_For_Par_Region(pragma_blk, is_worksharing) ? pragma_blk :
         NULL;
}


/***********************************************************************
 * If the given list of WN's are pragmas for a parallel region, return
 * TRUE, otherwise return FALSE.  Return parameter is_worksharing is TRUE
 * if the pragmas are for a worksharing construct (whether or not it's
 * combined into a parallel region), and FALSE otherwise.
 ***********************************************************************/

static BOOL Pragmas_For_Par_Region(WN *pragma_blk, BOOL *is_worksharing)
{
  Is_True(pragma_blk, ("Pragmas_For_Par_Region(): NULL pragma_blk argument"));

  WN *prag = WN_first(pragma_blk);

  *is_worksharing = FALSE;

  if (!prag)
    return FALSE;

  switch (WN_pragma(prag)) {
  case WN_PRAGMA_PARALLEL_BEGIN:  // PARALLEL SECTIONS already lowered to PDO
    return TRUE;

  case WN_PRAGMA_PARALLEL_DO:
  case WN_PRAGMA_DOACROSS:
    if (WN_pragma_arg1(prag) != 0)
      return FALSE;               // prag was generated by FE to mark loops
                                  // in a NEST clause for LNO
    *is_worksharing = TRUE;
    return TRUE;

  case WN_PRAGMA_PDO_BEGIN:
    if (WN_pragma_arg1(prag) != 0)
      return FALSE;
    *is_worksharing = TRUE;
    break;
 
  case WN_PRAGMA_SINGLE_PROCESS_BEGIN:
    *is_worksharing = TRUE;
    break;

  default:
    break;
  }

  return FALSE;
}


/***********************************************************************
 * Determine whether type ty is that of an assumed size or assumed shape
 * array.
 *
 * Since OMP doesn't work with F90, and assumed-shape arrays exist only
 * in F90, we don't yet check for assumed-shape arrays--DRK.
 ***********************************************************************/
static BOOL Is_Assumed_Size_Or_Shape_Array(TY *ty)
{
  // array parameters are passed by reference, so we must follow 1 link
  if (TY_kind(*ty) == KIND_POINTER)
    ty = &(Ty_Table[TY_pointed(*ty)]);

  if (TY_kind(*ty) != KIND_ARRAY)
    return FALSE; // must not be an array

  // I think that an assumed-shape array would have kind STRUCT (e.g. the
  // structure for the dope vector) and have the ENTERED flag set--DRK

  for (INT i = 0; i < TY_AR_ndims (*ty); i++) { // examine each dimension
      // non-constant bound with no variable to specify the bound
      // signifies assumed size
    if ((!TY_AR_const_lbnd(*ty, i) && !TY_AR_lbnd_var(*ty, i)) ||
        (!TY_AR_const_ubnd(*ty, i) && !TY_AR_ubnd_var(*ty, i)))
      return TRUE;
  }

  return FALSE; // all dimensions had their bounds defined
}


/***********************************************************************
 * Determine whether a variable (st) is allowed to be privatized due to the
 * DEFAULT(PRIVATE) clause, based on the rules in the OMP spec.
 * pragma_block is the block of pragmas that apply in the parallel region
 * in which st is referenced.
 ***********************************************************************/

static BOOL
Can_Apply_Default_Private(ST *st, WN *pragma_block)
{
    // The cases below refer to those on page 11 ("Data Environment"
    // section) of the June 24 draft of the OMP spec.  Using this
    // function to screen out variables that can't be privatized handles
    // case 9.  Only cases 2, 4, 6, 8, and 9 affect DEFAULT processing.

    // PV 707883 : privatization breaks storage association between old and
    // new ST's, so warn in cases when we try to apply DEFAULT(PRIVATE) to
    // equivalenced ST's
  if (ST_is_equivalenced(st)) {
    ErrMsgLine(EC_MPLOWER_defpriv_equiv, WN_Find_Linenum(pragma_block), st);
    return FALSE;
  }

    // case 2:  Can't re-privatize on an enclosed DO loop.  This case
    // should be observed because we run
    // Privatize_Index_Vars_And_Check_Final_Scopes() after
    // Apply_Default_Scopes().

  TY *ty = &(Ty_Table[ST_type(st)]);

    // case 4: Can't privatize assumed size or assumed shape arrays.
  if (Is_Assumed_Size_Or_Shape_Array(ty))
    return FALSE;

    // case 6: Can't privatize a pointee of a Cray pointer.  This case
    // should never happen because the front end translates a use of a
    // pointee into an ILOAD or ISTORE through the corresponding pointer.

    // case 8: Can't privatize a COMMON block element if the COMMON
    // block that contains it has already been privatized.
  ST *split_blk, *common_block = ST_Source_COMMON_Block(st, &split_blk);

  if (common_block) {
      // check for PRIVATE pragma on common_block
    for (WN *prag = WN_first(pragma_block); prag; prag = WN_next(prag))
      if (WN_opcode(prag) == OPC_PRAGMA &&
          WN_PRAGMA_LOCAL == (WN_PRAGMA_ID) WN_pragma(prag) &&
          (split_blk == WN_st(prag) || common_block == WN_st(prag)) )
        return FALSE; // common_block has already been privatized
  }

  return TRUE;
}


/***********************************************************************
 * If st is declared "const" (as in C), return TRUE, otherwise return
 * FALSE.
 ***********************************************************************/

static BOOL ST_Is_Const(ST *st)
{
  TY_IDX ty_idx = ST_type(st);
  if (TY_is_const(ty_idx))
    return TRUE;  // const variable

  if (TY_kind(ty_idx) != KIND_ARRAY)
    return FALSE;

  TY_IDX elt_ty_idx = TY_etype(ty_idx);
  if (TY_is_const(elt_ty_idx))
    return TRUE;  // array of const element type

  return FALSE;
}


/***********************************************************************
 * If the target of the STORE or ISTORE node is the same as specified in
 * the reduction node, return TRUE, otherwise return FALSE.
 ***********************************************************************/

extern BOOL
WN_Store_Target_Matches_Reduction(WN *store, WN *reduction)
{
  const OPERATOR store_oper = WN_operator(store);
  const OPERATOR reduction_oper = WN_operator(reduction);

  Is_True(store_oper == OPR_STID || store_oper == OPR_ISTORE,
          ("bad store_oper == %d", store_oper));
  Is_True(reduction_oper == OPR_PRAGMA || reduction_oper == OPR_XPRAGMA,
          ("bad reduction_oper == %d", reduction_oper));

  if (store_oper == OPR_STID && reduction_oper == OPR_PRAGMA &&
      WN_st(store) == WN_st(reduction) &&
      WN_offset(store) == WN_pragma_arg1(reduction))
    return TRUE;

  if (store_oper == OPR_ISTORE && reduction_oper == OPR_XPRAGMA &&
      WN_Simp_Compare_Trees(WN_kid1(store), WN_kid0(reduction)) == 0)
    return TRUE;

  return FALSE;
}


/***********************************************************************
 * Determine the reduction operator for MP-style reduction clauses (which
 * specify the variable but not the operator).  Also, check reduction
 * variable usage for correctness, for both MP and OMP cases.  We do this
 * in a separate pass from Translate_OMP_to_MP because it requires non-
 * local information (e.g. the reduction_stack argument).
 *
 * Arguments:
 *  wn : input/output : the Whirl tree to process
 *  reduction_stack : input : A stack of lists of PRAGMA/XPRAGMA WN's.
 *    Each WN corresponds to a REDUCTION clause.  Each list contains all
 *    the clauses for a parallel construct.  The height of a list in the
 *    stack corresponds to its nesting depth.
 *
 * We're deferring for now the actual substitution of a localized scalar
 * for the reduction variable--DRK
 ***********************************************************************/

static void
Infer_Reduction_Operators(WN *wn, WN_LIST_STACK *reduction_stack)
{
  const OPERATOR oper = WN_operator(wn);
  WN *recurse_parent = wn;  // Parent of nodes into which to recurse
  BOOL do_pop = FALSE, is_worksharing;
  WN_LIST *redn_pragmas;  // Reduction pragmas for region inside wn

  if (oper == OPR_STID || oper == OPR_ISTORE) {
    WN *redn_pragma = NULL; // REDUCTION clause that matches wn.
    WN_LIST *redn_list;
    INT i, j;

      // search for topmost clause that refers to the target of the store
    for (i = 0; i < reduction_stack->Elements() && !redn_pragma; i++) {
      for (j = 0, redn_list = reduction_stack->Top_nth(i);
           j < redn_list->Elements(); j++) {
        WN *prag = (*redn_list)[j];

        if (WN_Store_Target_Matches_Reduction(wn, prag)) {
          redn_pragma = prag;
          break;
  }
      }
    }

    if (redn_pragma) {
      OPERATOR redn_oper = Reduction_Operator(redn_pragma, wn);

      if (WN_pragma_arg2(redn_pragma) == OPERATOR_UNKNOWN)
        WN_pragma_arg2(redn_pragma) = redn_oper;
      else if (WN_pragma_arg2(redn_pragma) != redn_oper &&
               redn_oper != OPERATOR_UNKNOWN) {
          // This error occurs when either the operator specified in the
          // REDUCTION clause differs from the update expression (for OMP),
          // or there are multiple update expressions (which is itself
          // illegal) with different operators (non-OMP).  Probably we
          // should distinguish all these cases.
#ifndef KEY
        // There is no way to be sure that we have a bad operator, this
        // message can aid in debugging, but we cannot give wrong warnings
        // for that.
        ErrMsgLine(EC_MPLOWER_red_conflict, WN_Find_Linenum(wn),
             Store_ST(wn));
#else
        DevWarn ("Probably inconsistent reduction operator for variable %s",
                 ST_name (Store_ST(wn)));
#endif
      }
    }

    recurse_parent = NULL;  // No child of a store can be a store

  } else if (Par_Region_Pragma_Block(wn, &is_worksharing) != NULL ||
             is_worksharing) {
    redn_pragmas = CXX_NEW(WN_LIST(&omp_pool), &omp_pool);

    for (WN *prag = WN_first(WN_region_pragmas(wn)); prag;
         prag = WN_next(prag))
      if (WN_pragma(prag) == WN_PRAGMA_REDUCTION)
        redn_pragmas->AddElement(prag);

    reduction_stack->Push(redn_pragmas);
    do_pop = TRUE;
    recurse_parent = WN_region_body(wn);
  }

  if (recurse_parent) {
    OPCODE rpar_opc = WN_opcode(recurse_parent);

    if (!OPCODE_is_leaf(rpar_opc)) {
      if (rpar_opc == OPC_BLOCK) {
        for (WN *kid = WN_first(recurse_parent); kid; kid = WN_next(kid))
          Infer_Reduction_Operators(kid, reduction_stack);
      } else {
        for (INT kidno = 0; kidno < WN_kid_count(recurse_parent); kidno++) { 
          WN *kid = WN_kid(recurse_parent, kidno);
          if (kid)
            Infer_Reduction_Operators(kid, reduction_stack);
        }
      }
    }
  }

  if (do_pop) {
    redn_pragmas = reduction_stack->Pop();
    CXX_DELETE(redn_pragmas, &omp_pool);
  }
}


/***********************************************************************
 * Try to determine the operator being used in the assignment statement
 * (store) assign_stmt to update the reduction variable named in the pragma
 * redn_pragma.  Give warnings if we can't figure it out, or if something
 * looks funny about the form of the update expression.
 ***********************************************************************/

static OPERATOR Reduction_Operator(WN *redn_pragma, WN *assign_stmt)
{
  WN *opnode = WN_kid0(assign_stmt);
  OPERATOR oper = WN_operator(opnode);

    // skip over various conversion/precedence operators
  while (oper == OPR_CVT   || oper == OPR_CVTL    || oper == OPR_PAREN ||
         oper == OPR_TRUNC || oper == OPR_COMPLEX || oper == OPR_REALPART ||
         oper == OPR_IMAGPART) {
    opnode = WN_kid0(opnode);
    oper = WN_operator(opnode);
  }

  BOOL oper_ok = TRUE;

  switch (oper) {
  case OPR_LAND:  // used for .AND.
  case OPR_LIOR:  // used for .OR.
  case OPR_EQ:    // used for .EQV.
  case OPR_NE:    // used for .NEQV.
  case OPR_CAND:  // used for &&
  case OPR_CIOR:  // used for ||
  case OPR_MAX:
  case OPR_MIN:
  case OPR_ADD:
  case OPR_MPY:
  case OPR_SUB:
  case OPR_BAND:
  case OPR_BIOR:
  case OPR_BXOR:
  case OPR_DIV: // an extension to what the OMP spec requires
    break;
  default:
    oper_ok = FALSE;
    break;
  }

  if (!oper_ok) {
#ifndef KEY
    // There is no way to be sure that we have a bad operator
    ErrMsgLine(EC_MPLOWER_red_badop, WN_Find_Linenum(assign_stmt),
               Store_ST(assign_stmt));
#endif // !KEY
    return OPERATOR_UNKNOWN;
  }

    // By checking that the reduction variable in redn_pragma (call it "x")
    // appears precisely once on the RHS in assign_stmt, in the leftmost or
    // rightmost position, we could check for these kinds of errors:
    //      x = a * b (reduction variable not referenced)
    //      x = x + x + a (referenced too many times)
    //      x = a + x + b (illegal expression form)
    // I'm deferring these checks though--DRK

  return oper;
}


/***********************************************************************
 * If var_st is the index variable of a parallel DO loop that encloses wn,
 * return TRUE, otherwise return FALSE.
 ***********************************************************************/

static BOOL ST_is_Index_Var_For_Enclosing_PDO(ST *var_st, WN *wn)
{
  for ( ; wn; wn = Get_Parent(wn)) {
      // test if wn is a parallel DO loop
    BOOL is_worksharing;
    (void) Par_Region_Pragma_Block(wn, &is_worksharing);
    if (!is_worksharing)
      continue;
    WN *construct_prag = WN_first(WN_region_pragmas(wn));
    switch (WN_pragma(construct_prag)) {
    case WN_PRAGMA_PARALLEL_DO:
    case WN_PRAGMA_DOACROSS:
    case WN_PRAGMA_PDO_BEGIN:
      break;
    default:
      continue;
    }

      // test if var_st is index var. for the parallel DO loop
    WN *do_wn = WN_first(WN_region_body(wn));
    for ( ; do_wn; do_wn = WN_next(do_wn)) {
      if (WN_operator(do_wn) == OPR_DO_LOOP &&
          var_st == WN_st(WN_index(do_wn)))
        return TRUE;
    }
  }

  return FALSE;
}


/***********************************************************************
 * Translate certain OMP constructs in pu into the corresponding Whirl
 * consisting of SGI MP constructs (i.e., translate from OMP into a form
 * that lower_mp() can understand).  The OMP constructs that get translated
 * in this step are those that require only local information and involve
 * only local transforms (i.e. they don't require a complete walk of
 * the tree).  This includes SINGLE/MASTER, SECTIONS, and named
 * CRITICAL sections.
 ***********************************************************************/

static BOOL Inside_Region(WN* wn_barrier, WN_PRAGMA_ID pragma_id)
{
  for (WN* wn = wn_barrier; wn != NULL; wn = Get_Parent(wn)) {
    if (WN_opcode(wn) == OPC_REGION) {
      for (WN* wnn = WN_first(WN_region_pragmas(wn)); wnn != NULL;
          wnn = WN_next(wnn)) {
        if (WN_operator(wnn) == OPR_PRAGMA && WN_pragma(wnn) == pragma_id)
          return TRUE;
      }
    }
  }
  return FALSE;
}

static BOOL Immed_Inside_Par_Begin(WN* wn_barrier)
{
  for (WN* reg = wn_barrier; reg; reg = Get_Parent(reg)) {
    if (WN_opcode(reg) == OPC_REGION) {
      for (WN* wn = WN_first(WN_region_pragmas(reg)); wn; wn = WN_next(wn)) {
        if (WN_operator(wn) == OPR_PRAGMA && WN_pragma_omp(wn)) {
          if (WN_pragma(wn) == WN_PRAGMA_PARALLEL_BEGIN) {
            return TRUE;
          }
          if (WN_pragma(wn) == WN_PRAGMA_SINGLE_PROCESS_BEGIN ||
              WN_pragma(wn) == WN_PRAGMA_PARALLEL_DO ||
              WN_pragma(wn) == WN_PRAGMA_PDO_BEGIN) {
            return FALSE;
          }
        }
      }
    }
  }
  return FALSE;
}

static WN *Translate_OMP_to_MP(WN *wn)
{
  OPCODE opcode = WN_opcode(wn);
  WN *section = Is_Section_Begin(wn);

#ifdef TARG_SL2 //fork_joint
   WN* sl2_section = Is_SL2_Section_Begin(wn);
   if(sl2_section) {
       Convert_SL2_Section_To_Pdo(wn, sl2_section);
   } 
#endif 
  
  if (section) {
    Convert_Section_To_Pdo(wn,section);
  }

//  wn = Lower_Master(wn);
  
  if (WN_operator(wn) == OPR_INTRINSIC_CALL) {
    Lower_Fetch_And_Op(wn);
    return NULL;
  }

  if (WN_opcode(wn) == OPC_REGION && RID_TYPE_mp(REGION_get_rid(wn))) {
    // It is an MP region. Add memory barriers around it if necessary
#ifndef KEY
    Add_Memory_Barriers (wn);
#endif
    // If it is a loop with SIMPLE schedtype plus CHUNK,
    // then convert to INTERLEAVE
    Convert_Simple_To_Interleaved (wn);

    Convert_Just_Chunksize_To_Dynamic (wn);
  }

  // Lower atomic when processing the next instruction
  // since the processing will delete the atomic pragma
  // and the following one
  if (OPCODE_is_store(opcode)) {
    WN *prev = WN_prev(wn);
    if (prev && WN_operator(prev) == OPR_PRAGMA) {
      if (WN_pragma(prev) == WN_PRAGMA_ATOMIC) {
        Lower_Atomic(prev);
        return NULL;
      }
    }
  }

  if (Is_Ordered_Do(wn)) {
    Add_Ordered_XPragmas (wn);
  }

  if (opcode == OPC_PRAGMA &&
      WN_pragma_omp(wn) &&
      WN_pragma(wn) == WN_PRAGMA_CRITICAL_SECTION_BEGIN) {

    // push the ST, even if NULL
    critical_st.AddElement (WN_st(wn));
  }

  if (opcode == OPC_PRAGMA &&
      WN_pragma_omp(wn) &&
      WN_pragma(wn) == WN_PRAGMA_BARRIER) {
    if (critical_st.Elements() > 0) {
      ErrMsgSrcpos(EC_MPLOWER_Generic_Error, WN_Get_Linenum(wn),
        "The C$OMP BARRIER directive cannot be specified within a C$OMP CRITICAL region");
    } else if (!Immed_Inside_Par_Begin(wn)) {
      if (Inside_Region(wn, WN_PRAGMA_PARALLEL_DO)) {
        ErrMsgSrcpos(EC_MPLOWER_Generic_Error, WN_Get_Linenum(wn),
          "The C$OMP BARRIER directive cannot be specified within a C$OMP PARALLEL DO region");
      } else if (Inside_Region(wn, WN_PRAGMA_PDO_BEGIN)) {
        ErrMsgSrcpos(EC_MPLOWER_Generic_Error, WN_Get_Linenum(wn),
          "The C$OMP BARRIER directive cannot be specified within a C$OMP DO region");
      } else if (Inside_Region(wn, WN_PRAGMA_SINGLE_PROCESS_BEGIN)) {
        ErrMsgSrcpos(EC_MPLOWER_Generic_Error, WN_Get_Linenum(wn),
          "The C$OMP BARRIER directive cannot be specified within a C$OMP SINGLE region");
      }
    }
  }

  if (opcode == OPC_PRAGMA &&
      WN_pragma_omp(wn) &&
      WN_pragma(wn) == WN_PRAGMA_CRITICAL_SECTION_END) {

    FmtAssert (critical_st.Elements() > 0,
               ("Encountered an end-critical without a matching critical"));
    ST *crit_begin_st = critical_st[critical_st.Lastidx()];

/*
change next assertion check back to this:

    if (WN_st(wn) != NULL) {
      FmtAssert (ST_class(WN_st(wn)) == CLASS_CONST, ("non-CONST class"));
    }

    FmtAssert (WN_st(wn) == NULL ||
               WN_st(wn) == crit_begin_st,
               ("Name on end-critical must match name on begin-critical"));

once front end bug is fixed, though the mismatch allowed for
WN_st(wn) == NULL is fishy--DRK
*/

      // this IF is assertion code to be changed back--DRK
    // for test purpose. csc. maybe REMOVED later

    // Adding crit_begin_st !=NULL check.
    // because cfe may generate a NULL st CRITICAL_SECTION_BEGIN,
    // but with a zero-length st CRITICAL_SECTION_END.
    // TODO: fix this after the cfe altered.
    // csc.
    if (crit_begin_st != NULL && WN_st(wn) != NULL) {
      FmtAssert (ST_class(WN_st(wn)) == CLASS_CONST, ("non-CONST class"));
      FmtAssert (ST_class(crit_begin_st) == CLASS_CONST, ("non-CONST class"));

      TCON &wn_tcon = Tcon_Table[ST_tcon(*WN_st(wn))];
      TCON &crit_begin_tcon = Tcon_Table[ST_tcon(*crit_begin_st)];
      const INT wn_str_len = Targ_String_Length(wn_tcon);
      const INT crit_begin_str_len = Targ_String_Length(crit_begin_tcon);

      FmtAssert (wn_str_len == crit_begin_str_len, ("length mismatch"));
      FmtAssert (strncmp(Targ_String_Address(wn_tcon),
                         Targ_String_Address(crit_begin_tcon), wn_str_len) ==
                 0, ("Name on end-critical differs from begin-critical"));
    }

    if (crit_begin_st == NULL && WN_st(wn) != NULL)
    {
  //hack for cfe generated non-name critical section.
  //csc.
      WN_st_idx(wn) = ST_st_idx(critical_st[critical_st.Lastidx()]);
      
    }
    if (WN_st(wn) == NULL) {
      // copy latest entry from critical
      WN_st_idx(wn) = ST_st_idx(critical_st[critical_st.Lastidx()]);
    }
    // Pop the topmost entry
    critical_st.Decidx ();
  }

  // recurse
  if (opcode == OPC_BLOCK) {
    WN *kid = WN_first(wn);
    while (kid) {
      WN *next_kid = WN_next(kid);
      Translate_OMP_to_MP(kid);
      kid = next_kid;
    }
  } else {
    for (INT kidno=0; kidno<WN_kid_count(wn); kidno++) {
      Translate_OMP_to_MP(WN_kid(wn,kidno));
    }
  }
  return wn;  
}

/***********************************************************************
 *
 * Given a WHIRL node for a WHIRL region that is an MP region
 * add memory barriers before and after it (as appropriate).
 *
 ***********************************************************************/
static void Add_Memory_Barriers (WN *wn) {

  WN *pwn = WN_first(WN_region_pragmas(wn));
  BOOL add_barriers = FALSE;
  while (pwn) {
    Is_True (WN_opcode(pwn) == OPC_PRAGMA ||
             WN_opcode(pwn) == OPC_XPRAGMA,
             ("Expected a PRAGMA node in region pragma block"));

    // for a PDO-nest add barriers around only the outermost MP region
    // this is given by WN_pragma_arg1(pwn) which is the index of the loop
    if (WN_pragma(pwn) == WN_PRAGMA_PARALLEL_BEGIN ||
        (WN_pragma(pwn) == WN_PRAGMA_PDO_BEGIN && WN_pragma_arg1(pwn) == 0) ||
        WN_pragma(pwn) == WN_PRAGMA_SINGLE_PROCESS_BEGIN) {
      add_barriers = TRUE;
      break;
    }
    pwn = WN_next(pwn);
  }
  if (add_barriers) {
    if (WN_pragma(pwn) == WN_PRAGMA_SINGLE_PROCESS_BEGIN) {
      // forward barrier just before SINGLE
      WN_INSERT_BlockBefore (Get_Parent(wn), wn, WN_CreateBarrier(TRUE,0));

      // backward at start of region body
      WN_INSERT_BlockBefore (WN_region_body(wn), WN_first(WN_region_body(wn)),
                             WN_CreateBarrier(FALSE,0));
      // forward at end of region body
      WN_INSERT_BlockAfter (WN_region_body(wn), WN_last(WN_region_body(wn)),
                            WN_CreateBarrier(TRUE,0));

      // backward barrier just after SINGLE
      WN_INSERT_BlockAfter (Get_Parent(wn), wn, WN_CreateBarrier(FALSE,0));
    } else {
      // forward then backward just before
#ifdef KEY
      if (WN_prev(wn) && 
          (WN_operator(WN_prev(wn)) != OPR_BACKWARD_BARRIER ||
           WN_operator(WN_prev(wn)) != OPR_FORWARD_BARRIER)){
#endif
        WN_INSERT_BlockBefore (Get_Parent(wn), wn, WN_CreateBarrier(TRUE,0));
        WN_INSERT_BlockBefore (Get_Parent(wn), wn, WN_CreateBarrier(FALSE,0));
      }
      // forward then backward just after
      WN_INSERT_BlockAfter (Get_Parent(wn), wn, WN_CreateBarrier(FALSE,0));
      WN_INSERT_BlockAfter (Get_Parent(wn), wn, WN_CreateBarrier(TRUE,0));
    }
    Parentize (Get_Parent(wn));
  }
}


  
//-----------------------------------------------------------------------
// NAME: Convert_Just_Chunksize_To_Dynamic
// FUNCTION: Ensures that the region 'wn_region' has a WN_PRAGMA_SCHED-
//   TYPE_DYNAMIC pragma if it has a WN_PRAGMA_CHUNKSIZE and no explicitly
//   mentioned scheduling type. This is a requirement for old-style PCF
//   pragmas. It should never happen for OMP pragmas since there is no
//   way to specify just a chunksize in OpenMP.
//-----------------------------------------------------------------------

static void Convert_Just_Chunksize_To_Dynamic (WN *wn_region) {

  WN* wn_first_pragma = WN_first(WN_region_pragmas(wn_region));
  WN* wn_schedtype = NULL; 
  WN* wn_chunksize = NULL; 

  for (WN* wn = wn_first_pragma; wn != NULL; wn = WN_next(wn)) { 
    if (WN_opcode(wn) == OPC_PRAGMA && WN_pragma(wn)==WN_PRAGMA_MPSCHEDTYPE) {
      switch (WN_pragma_arg1(wn)) { 
      case WN_PRAGMA_SCHEDTYPE_SIMPLE:
      case WN_PRAGMA_SCHEDTYPE_DYNAMIC:
      case WN_PRAGMA_SCHEDTYPE_GSS:
      case WN_PRAGMA_SCHEDTYPE_INTERLEAVE:
      case WN_PRAGMA_SCHEDTYPE_RUNTIME: 
        wn_schedtype = wn;
      case WN_PRAGMA_SCHEDTYPE_PSEUDOLOWERED:
        FmtAssert(TRUE, ("Should not have seen this pragma yet."));
      } 
    }
    if (WN_opcode(wn) == OPC_XPRAGMA && WN_pragma(wn) == WN_PRAGMA_CHUNKSIZE)
      wn_chunksize = wn; 
  }
  if (wn_chunksize != NULL && wn_schedtype == NULL) {
    wn_schedtype = WN_CreatePragma(WN_PRAGMA_MPSCHEDTYPE, (ST_IDX) NULL, 
                                   WN_PRAGMA_SCHEDTYPE_DYNAMIC, 0); 
    WN_INSERT_BlockAfter(WN_region_pragmas(wn_region), wn_first_pragma, 
                          wn_schedtype);
    Set_Parent (wn_schedtype, WN_region_pragmas(wn_region));
  } 
}

/***********************************************************************
 *
 * OMP schedtype SIMPLE+CHUNK == INTERLEAVED.
 * So if we find such a schedtype, then we convert it to INTERLEAVED
 * right up front.
 *
 ***********************************************************************/
static void Convert_Simple_To_Interleaved (WN *wn) {

  WN *pragma_wn = WN_first(WN_region_pragmas(wn));
  WN *sched_wn = NULL;
  WN *chunk_wn = NULL;

  if (!WN_pragma_omp(pragma_wn)) return;

  while (pragma_wn) {
    if (WN_opcode(pragma_wn) == OPC_PRAGMA &&
        WN_pragma(pragma_wn) == WN_PRAGMA_MPSCHEDTYPE) {
      sched_wn = pragma_wn;
    }
    if (WN_opcode(pragma_wn) == OPC_XPRAGMA &&
        WN_pragma(pragma_wn) == WN_PRAGMA_CHUNKSIZE) {
      chunk_wn = pragma_wn;
    }
    pragma_wn = WN_next(pragma_wn);
  }

  if (sched_wn &&
      WN_pragma_arg1(sched_wn) == WN_PRAGMA_SCHEDTYPE_SIMPLE &&
      chunk_wn) {
    // it is simple scheduling with chunksize; switch it to interleaved
    WN_pragma_arg1(sched_wn) = WN_PRAGMA_SCHEDTYPE_INTERLEAVE;
  }
}

static WN * New_Label()
{
  LABEL_IDX label;
  (void) New_LABEL (CURRENT_SYMTAB, label);
  return WN_CreateLabel (label, 0, NULL);
}

// Convert a section into a pdo
static void Convert_Section_To_Pdo(WN *sections, WN *pragma)
{
  MEM_POOL_Popper popper(&Omp_Local_Pool);

  if ((WN_PRAGMA_ID)WN_pragma(pragma)==WN_PRAGMA_PSECTION_BEGIN) {
    WN_pragma(pragma) = WN_PRAGMA_PDO_BEGIN;
  } else {
    WN_pragma(pragma) = WN_PRAGMA_PARALLEL_DO;
  }
  WN_pragma_arg1(pragma) = 0;
  WN_pragma_arg2(pragma) = 1;
  if (Prompf_Info != NULL && Prompf_Info->Is_Enabled())
    WN_MAP32_Set(Prompf_Id_Map, pragma, 0);

  // delete the end sections if it exists
  WN *end_sec = WN_last(WN_region_body(sections));
  if (end_sec && WN_opcode(end_sec) == OPC_PRAGMA &&
      ((WN_PRAGMA_ID)WN_pragma(end_sec) == WN_PRAGMA_PSECTION_END)) {
    WN_Delete(WN_EXTRACT_FromBlock(WN_region_body(sections),end_sec));
  }

  // Walk the code, replacing each section with a label
  // recall that the first section might be implicit
  // store the labels in a stack
  STACK_OF_WN *sec_stack = CXX_NEW(STACK_OF_WN(&Omp_Local_Pool),
          &Omp_Local_Pool);
  WN *tmp = WN_first(WN_region_body(sections));

  // special case possible implicit section at beginning
  if (!tmp || WN_opcode(tmp) != OPC_PRAGMA ||
      ((WN_PRAGMA_ID)WN_pragma(tmp) != WN_PRAGMA_SECTION)) {
    WN *label = New_Label();
    WN_INSERT_BlockAfter(WN_region_body(sections),NULL,label);
    Set_Parent(label,WN_region_body(sections));
    sec_stack->Push(label);
    if (tmp) {
      WN_Set_Linenum(label,WN_Get_Linenum(tmp));
      WN_CopyMap(label, WN_MAP_FEEDBACK,tmp);
    }
  }

  // now find the other sections
  while (tmp) {
    WN *next = WN_next(tmp);
    if (WN_opcode(tmp) == OPC_PRAGMA &&
        ((WN_PRAGMA_ID)WN_pragma(tmp) == WN_PRAGMA_SECTION)) {
      if (Prompf_Info != NULL && Prompf_Info->Is_Enabled()) {
        INT section_id = WN_MAP32_Get(Prompf_Id_Map, tmp);
        Prompf_Info->OMPL_Eliminate_Section(section_id);
      }
      WN *label = New_Label();
      WN_INSERT_BlockBefore(WN_region_body(sections),tmp,label);
      Set_Parent(label,WN_region_body(sections));
      sec_stack->Push(label);
      if (next) {
  WN_Set_Linenum(label,WN_Get_Linenum(next));
        WN_CopyMap(label, WN_MAP_FEEDBACK,next);
      }
      WN_DELETE_FromBlock(WN_region_body(sections),tmp);
    }
    tmp = next;
  }

  // Create a new do loop
  ST *index_st = MTYPE_To_PREG(MTYPE_I4);
  WN_OFFSET index_offset = Create_Preg(MTYPE_I4,"omp_section");
  WN *index = WN_CreateIdname(index_offset,index_st);
  WN *lb = WN_StidIntoPreg(MTYPE_I4,index_offset, index_st,
      WN_CreateIntconst(OPC_I4INTCONST, 0 ));
//  WN *ub = WN_LT (MTYPE_I4, WN_LdidPreg (MTYPE_I4,index_offset ),
//                   WN_CreateIntconst(OPC_I4INTCONST,sec_stack->Elements()));
  //  modified by csc. The standard do model of Intel's RTL
  //  need a ub operator of LE/GE type.
  WN *ub = WN_LE (MTYPE_I4, WN_LdidPreg (MTYPE_I4,index_offset ),
                   WN_CreateIntconst(OPC_I4INTCONST,sec_stack->Elements()-1));
  WN *incr = WN_StidIntoPreg ( MTYPE_I4, index_offset, index_st,
    WN_Add(MTYPE_I4, WN_LdidPreg ( MTYPE_I4,index_offset),
      WN_CreateIntconst ( OPC_I4INTCONST,(INT64)1 )));
  WN *new_do = WN_CreateDO(index,lb,ub,incr,WN_CreateBlock(),NULL);

  WN_Set_Linenum(lb,WN_Get_Linenum(sections));
  WN_Set_Linenum(incr,WN_Get_Linenum(sections));
  WN_Set_Linenum(new_do,WN_Get_Linenum(sections));
  if (Cur_PU_Feedback) {
    INT32 region_fb = WN_MAP32_Get(WN_MAP_FEEDBACK,sections);
    WN_MAP32_Set(WN_MAP_FEEDBACK,new_do,region_fb);
    WN_MAP32_Set(WN_MAP_FEEDBACK,lb,region_fb);
    WN_MAP32_Set(WN_MAP_FEEDBACK,incr,sec_stack->Elements()*region_fb);
  }

  // Put a compgoto inside the loop
  WN *comp_goto_block = WN_CreateBlock();
  WN *cgoto = WN_CreateCompgoto(sec_stack->Elements(),
        WN_LdidPreg ( MTYPE_I4,index_offset),
        comp_goto_block,NULL,0);
  WN_Set_Linenum(cgoto,WN_Get_Linenum(new_do));
  WN_CopyMap(cgoto, WN_MAP_FEEDBACK,new_do);

  INT i;
  for (i=0; i<sec_stack->Elements(); i++) {
    WN *label_goto = 
      WN_CreateGoto((ST*) NULL,WN_label_number(sec_stack->Bottom_nth(i)));
    WN_Set_Linenum(label_goto,WN_Get_Linenum(new_do));
    WN_CopyMap(label_goto, WN_MAP_FEEDBACK,new_do);
    WN_INSERT_BlockBefore(comp_goto_block,NULL,label_goto);
  }
  WN_INSERT_BlockAfter(WN_do_body(new_do),NULL,cgoto);
  Parentize(new_do);


  // Move all the code after the compgoto
  WN *region_body = WN_region_body(sections);
  while (WN_last(region_body)) {
    WN *wn = WN_EXTRACT_FromBlock(region_body,WN_last(region_body));
    WN_INSERT_BlockAfter(WN_do_body(new_do),cgoto,wn);
    Set_Parent(wn,WN_do_body(new_do));
  }

  // Create a new label at the end of the do loop
  // Put a jump to this label at the end of every section
  WN *exit_label = New_Label();
  for (i=1; i<sec_stack->Elements(); i++) {
    WN *exit_goto = 
      WN_CreateGoto((ST*) NULL,WN_label_number(exit_label));
    WN_Set_Linenum(exit_goto,WN_Get_Linenum(sec_stack->Bottom_nth(i-1)));
    WN_CopyMap(exit_goto, WN_MAP_FEEDBACK,sec_stack->Bottom_nth(i-1));
    WN_INSERT_BlockBefore(WN_do_body(new_do),
  sec_stack->Bottom_nth(i),exit_goto);
    Set_Parent(exit_goto,WN_do_body(new_do));
  }
  WN_INSERT_BlockBefore(WN_do_body(new_do),NULL,exit_label);
  Set_Parent(exit_label,WN_do_body(new_do));
  WN_Set_Linenum(exit_label,WN_Get_Linenum(new_do));
  WN_CopyMap(exit_label, WN_MAP_FEEDBACK,new_do);

  // Insert the do
  WN_INSERT_BlockAfter(WN_region_body(sections),NULL,new_do);
  Set_Parent(new_do,WN_region_body(sections));

  // If the number of sections is >= 9, schedule the pdo dynamically
  if (sec_stack->Elements() >= 9) {
    WN *sched_pragma = WN_CreatePragma(WN_PRAGMA_MPSCHEDTYPE,(ST*) 0,
                                       WN_PRAGMA_SCHEDTYPE_DYNAMIC,0);
    WN_INSERT_BlockAfter(WN_region_pragmas(sections),pragma,sched_pragma);
    Set_Parent(sched_pragma,WN_region_pragmas(sections));
  }
#ifdef KEY
  else
  {
    // bug 5201: Give the DO loop a static schedule with chunksize 1
    WN *sched_pragma = WN_CreatePragma(WN_PRAGMA_MPSCHEDTYPE,(ST*) 0,
                                       WN_PRAGMA_SCHEDTYPE_SIMPLE,0);
    WN_INSERT_BlockAfter(WN_region_pragmas(sections),pragma,sched_pragma);

    WN *chunksize = WN_CreateXpragma (WN_PRAGMA_CHUNKSIZE, (ST_IDX)NULL, 1);
    WN_kid0 (chunksize) = WN_Intconst (MTYPE_U4, 1);
    WN_INSERT_BlockAfter(WN_region_pragmas(sections),sched_pragma,chunksize);

    Set_Parent(sched_pragma,WN_region_pragmas(sections));
    Set_Parent(chunksize,WN_region_pragmas(sections));
  }
#endif // KEY

  // Mark the do loop index variable as local
  WN *local_pragma = WN_CreatePragma(WN_PRAGMA_LOCAL, index_st,index_offset,0);
  WN_INSERT_BlockAfter(WN_region_pragmas(sections),pragma,local_pragma);
  Set_Parent(local_pragma,WN_region_pragmas(sections));

  if (Prompf_Info != NULL && Prompf_Info->Is_Enabled()) {
    INT loop_id = WN_MAP32_Get(Prompf_Id_Map, sections);
    FmtAssert(loop_id != 0,
      ("Convert_Section_To_Pdo: Expected id on sections"));
    WN_MAP32_Set(Prompf_Id_Map, new_do, loop_id);
    Prompf_Info->OMPL_Sections_To_Loop(loop_id); 
  } 
}

// Is this a p section begin
// If yes, return a pointer to the pragma
static WN *Is_Section_Begin(WN *wn)
{
  if (WN_opcode(wn) != OPC_REGION) {
    return FALSE;
  }
  WN *pragmas = WN_region_pragmas(wn);
  if (pragmas) {
    WN *pragma = WN_first(pragmas);
    while (pragma) {
      if (WN_opcode(pragma) == OPC_PRAGMA) {
        if ((WN_PRAGMA_ID)WN_pragma(pragma)==WN_PRAGMA_PSECTION_BEGIN) {
    return pragma;
        } else if 
    ((WN_PRAGMA_ID)WN_pragma(pragma)==WN_PRAGMA_PARALLEL_SECTIONS) {
    return pragma;
        }
      }
      pragma = WN_next(pragma);
    }
  }
  return NULL;
}



#ifdef TARG_SL2 //fork_joint
static void Convert_SL2_Section_To_Pdo(WN *sections, WN *pragma)
{
  MEM_POOL_Popper popper(&Omp_Local_Pool);

  WN_pragma_arg1(pragma) = 0;
  WN_pragma_arg2(pragma) = 1;

// add one exit for enclosing region 
  Is_True(WN_opcode(sections) == OPC_REGION,  ("expected a region node")); 

  // delete the end sections if it exists
  WN *end_sec = WN_last(WN_region_body(sections));
  if (end_sec && WN_opcode(end_sec) == OPC_PRAGMA &&
      ((WN_PRAGMA_ID)WN_pragma(end_sec) == WN_PRAGMA_PSECTION_END)) {
    WN_Delete(WN_EXTRACT_FromBlock(WN_region_body(sections),end_sec));
  }
 
  // Walk the code, replacing each section with a label
  // recall that the first section might be implicit
  // store the labels in a stack
  STACK_OF_WN *sec_stack = CXX_NEW(STACK_OF_WN(&Omp_Local_Pool),
          &Omp_Local_Pool);
  WN *tmp = WN_first(WN_region_body(sections));
  WN* parent = WN_region_body(sections);
  // now find the other sections
  BOOL first_region = TRUE;
  while (tmp) {
    WN *next = WN_next(tmp);
    if(WN_opcode(tmp) == OPC_REGION && WN_first(WN_region_pragmas(tmp)) && 
    (WN_pragma(WN_first(WN_region_pragmas(tmp))) == WN_PRAGMA_BARRIER)) 
    {

       //added by xma, not to create c2_joint in fe, but in vho to enable annotation for parallel program
       WN_INSERT_BlockAfter(WN_region_body(tmp), WN_last(WN_region_body(tmp)),
                            WN_Create_Intrinsic (OPR_INTRINSIC_CALL, MTYPE_V, MTYPE_V,
              INTRN_C2_JOINT, 0, 0));

      WN_DELETE_FromBlock(WN_region_pragmas(tmp),  WN_first(WN_region_pragmas(tmp)));

      if( first_region )
        first_region = FALSE;
      else {
        if(Cur_PU_Feedback) {
          Cur_PU_Feedback->Annot(tmp, FB_EDGE_CALL_OUTGOING, FB_FREQ_ZERO);
          Cur_PU_Feedback->FB_reset_in_out_same_node(tmp);
        } 
      }
    }


    if (WN_opcode(tmp) == OPC_PRAGMA &&
        ((WN_PRAGMA_ID)WN_pragma(tmp) == WN_PRAGMA_SL2_SECTION)) {
      WN *label = New_Label();
      WN_INSERT_BlockBefore(WN_region_body(sections),tmp,label);
      Set_Parent(label,WN_region_body(sections));
      sec_stack->Push(label);
      if (next) {
        WN_Set_Linenum(label,WN_Get_Linenum(next));
        WN* next_rgn=next;
        while(next_rgn!=NULL && WN_operator(next_rgn)!=OPR_REGION) {
          next_rgn=WN_next(next_rgn);
        }
        FmtAssert(next_rgn!=NULL, ("Convert_SL2_Section_To_Pdo: cannot find next region"));
        if(Cur_PU_Feedback) {
           FB_FREQ fb_into_region = Cur_PU_Feedback->Query(next_rgn, FB_EDGE_CALL_INCOMING);
           FB_Info_Invoke fb_label(fb_into_region);
           Cur_PU_Feedback->Annot_invoke(label, fb_label);
        }
      }
      WN_DELETE_FromBlock(WN_region_body(sections),tmp);
    }
    tmp = next;
  }


 WN_OFFSET index_offset = Create_Preg(MTYPE_I4,"sl2_section");

  WN *comp_goto_block = WN_CreateBlock();

  WN *cgoto = WN_CreateCompgoto(sec_stack->Elements(),
        WN_LdidPreg ( MTYPE_I4,index_offset),
        comp_goto_block,NULL,0);

/* need distinguish is major fork or minor fork */ 
  if((WN_PRAGMA_ID) WN_pragma(pragma) == WN_PRAGMA_SL2_MINOR_PSECTION_BEGIN) 
// minor thread
  {
    WN_Set_is_compgoto_for_minor(cgoto);  
  }
  else if((WN_PRAGMA_ID) WN_pragma(pragma) == WN_PRAGMA_SL2_MAJOR_PSECTION_BEGIN ) //main thread
  {
      WN_Set_is_compgoto_para(cgoto); 
  }   

  WN_Set_Linenum(cgoto,WN_Get_Linenum(sections));



  INT i;
  for (i=0; i<sec_stack->Elements(); i++) {
    WN *label_goto = 
    WN_CreateGoto((ST*) NULL,WN_label_number(sec_stack->Bottom_nth(i)));
    WN_Set_Linenum(label_goto,WN_Get_Linenum(sections));
    WN* label=sec_stack->Bottom_nth(i);
    WN_CopyMap(label_goto, WN_MAP_FEEDBACK, label);
    WN_INSERT_BlockBefore(comp_goto_block,NULL,label_goto);
  }

  if(Cur_PU_Feedback) {
    INT32 cgoto_size = sec_stack->Elements();
    FB_Info_Switch fb_info_sw(cgoto_size + 1 );
    fb_info_sw[ FB_EDGE_SWITCH_INDEX( FB_EDGE_SWITCH_DEFAULT ) ]= FB_FREQ_UNKNOWN;
    for(i=0;i<cgoto_size;i++)  {
      WN* label=sec_stack->Bottom_nth(i);
      FB_Info_Invoke fb_info_iv = Cur_PU_Feedback->Query_invoke( label );
      fb_info_sw[ FB_EDGE_SWITCH_INDEX( FB_EDGE_SWITCH( i ) ) ] =  fb_info_iv.freq_invoke;
    }
    Cur_PU_Feedback->Annot_switch(cgoto, fb_info_sw);
  }

  WN* tmp_block = WN_CreateBlock();
  WN_Set_Linenum(tmp_block, WN_Get_Linenum(sections));
  WN_INSERT_BlockAfter(tmp_block, NULL, cgoto);

  // Move all the code after the compgoto
  WN *region_body = WN_region_body(sections);
  while (WN_last(region_body)) {
    WN *wn = WN_EXTRACT_FromBlock(region_body,WN_last(region_body));
    WN_INSERT_BlockAfter(tmp_block, cgoto, wn);
    Set_Parent(wn, tmp_block);
  }

  // Create a new label at the end of the do loop
  // Put a jump to this label at the end of every section
  WN *exit_label = New_Label();
  for (i=1; i<sec_stack->Elements(); i++) {
    WN *exit_goto = WN_CreateGoto((ST*) NULL,WN_label_number(exit_label));
    WN_Set_Linenum(exit_goto,WN_Get_Linenum(sec_stack->Bottom_nth(i-1)));
    if(Cur_PU_Feedback) {
      WN* prev_label=sec_stack->Bottom_nth(i-1);    
      WN* exit_rgn=WN_next(prev_label);
      while(exit_rgn!=NULL && WN_operator(exit_rgn)!=OPR_REGION) {
         exit_rgn=WN_next(exit_rgn);
      }   
      FmtAssert(exit_rgn!=NULL, ("Convert_SL2_Section_To_Pdo: cannot find next region"));
      if(Cur_PU_Feedback) {
           FB_FREQ fb_out_region = Cur_PU_Feedback->Query(exit_rgn, FB_EDGE_CALL_OUTGOING);
           FB_Info_Invoke fb_goto(fb_out_region);
           Cur_PU_Feedback->Annot_invoke(exit_goto, fb_goto);
      }
    }
    WN_INSERT_BlockBefore(tmp_block,
  sec_stack->Bottom_nth(i),exit_goto);
    Set_Parent(exit_goto, tmp_block);
  }

  if(Cur_PU_Feedback) 
    Cur_PU_Feedback->Annot(exit_label, FB_EDGE_INCOMING, 
        Cur_PU_Feedback->Query(sections, FB_EDGE_CALL_OUTGOING));

  WN_INSERT_BlockBefore(tmp_block, NULL,exit_label);
//  Set_Parent(exit_label, tmp_block);
//  WN_Set_Linenum(exit_label,WN_Get_Linenum(sections));
  // Insert the do
  WN_INSERT_BlockAfter(WN_region_body(sections), NULL, tmp_block);
  Parentize(WN_region_body(sections));
/* add barrier. */ 
}


static WN *Is_SL2_Section_Begin(WN *wn)
{
  if (WN_opcode(wn) != OPC_REGION) {
    return FALSE;
  }
  WN *pragmas = WN_region_pragmas(wn);
  if (pragmas) {
    WN *pragma = WN_first(pragmas);
    while (pragma) {
      if (WN_opcode(pragma) == OPC_PRAGMA) {
        if ((WN_PRAGMA_ID)WN_pragma(pragma)==WN_PRAGMA_SL2_MAJOR_PSECTION_BEGIN
    || (WN_PRAGMA_ID) WN_pragma(pragma) == WN_PRAGMA_SL2_MINOR_PSECTION_BEGIN) {
    return pragma;
        } 
      }
      pragma = WN_next(pragma);
    }
  }
  return NULL;
}
#endif //fork_joint




// Create an st for a call to OMP_GET_THREAD_NUM
static ST *Create_Omp_Get_Thread_Num()
{
  static ST *result=NULL;
  if (result) return result;

  TY_IDX func_ty_idx;
  TY& func_ty = New_TY(func_ty_idx);

  TY_Init (func_ty, 0, KIND_FUNCTION, MTYPE_UNKNOWN,
           Save_Str(".omp_get_thread_num_"));

  TYLIST_IDX tylist_idx;
  TYLIST& tylist = New_TYLIST (tylist_idx);
  Set_TY_tylist (func_ty, tylist_idx);
  Set_TYLIST_type (tylist, Be_Type_Tbl(MTYPE_I4));
  Set_TYLIST_type (New_TYLIST(tylist_idx), 0);

  PU_IDX pu_idx;
  PU& pu = New_PU(pu_idx);
  PU_Init(pu, func_ty_idx, CURRENT_SYMTAB);

  /* Make a ST: add function to global symbol table */
  result = New_ST (GLOBAL_SYMTAB);
  ST_Init (result,
           Save_Str("omp_get_thread_num_"),
           CLASS_FUNC,
           SCLASS_EXTERN,
           EXPORT_PREEMPTIBLE,
           pu_idx);
  return result;
}

// Lower the atomic directive

// Replace atomic with critical __OMP_CRITICAL_ATOMIC_XX
// where xx is the type
static void Atomic_Using_Critical(WN *atomic, WN *store)
{
  WN *parent = Get_Parent(atomic);
  INT64 line = WN_Get_Linenum(atomic);

  char name[25];
  switch (WN_desc(store)) {
    case MTYPE_I1: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_I1");
      break;
    case MTYPE_I2: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_I2");
      break;
    case MTYPE_I4: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_I4");
      break;
    case MTYPE_I8: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_I8");
      break;
    case MTYPE_U1: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_U1");
      break;
    case MTYPE_U2: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_U2");
      break;
    case MTYPE_U4: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_U4");
      break;
    case MTYPE_U8: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_U8");
      break;
    case MTYPE_F4: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_F4");
      break;
    case MTYPE_F8: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_F8");
      break;
#ifdef TARG_IA64
    case MTYPE_F10: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_F10");
      break;
#endif
    case MTYPE_FQ: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_FQ");
      break;
    case MTYPE_C4: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_C4");
      break;
    case MTYPE_C8: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_C8");
      break;
#ifdef TARG_IA64
    case MTYPE_C10:
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_C10");
      break;
#endif
    case MTYPE_CQ: 
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_CQ");
      break;
    default:
      sprintf(name,"%s","__OMP_CRITICAL_ATOMIC_??");
      break;
  }
  name[24] = 0;
  TCON tc = Host_To_Targ_String ( MTYPE_STRING, name,strlen(name));
  ST *string = Gen_String_Sym (&tc, MTYPE_To_TY(MTYPE_STRING), FALSE );
  WN *critical1 = WN_CreatePragma(WN_PRAGMA_CRITICAL_SECTION_BEGIN,string,0,0);
  WN_set_pragma_compiler_generated(critical1);
  WN_set_pragma_omp(critical1);
  WN_INSERT_BlockBefore(parent,atomic,critical1);
  Set_Parent(critical1,parent);
  WN_Set_Linenum(critical1,line);
  WN_CopyMap(critical1, WN_MAP_FEEDBACK,atomic);

  WN *bb = WN_CreateBarrier(FALSE, 0);
  WN_INSERT_BlockBefore(parent,atomic,bb);
  Set_Parent(bb,parent);
  WN_Set_Linenum(bb,line);
  WN_CopyMap(bb, WN_MAP_FEEDBACK,atomic);

  WN *fb = WN_CreateBarrier(TRUE, 0);
  WN_INSERT_BlockAfter(parent,store,fb);
  Set_Parent(fb,parent);
  WN_Set_Linenum(fb,line);
  WN_CopyMap(fb, WN_MAP_FEEDBACK,atomic);

  WN* critical2 = WN_CreatePragma(WN_PRAGMA_CRITICAL_SECTION_END,string,0,0);
  WN_set_pragma_compiler_generated(critical2);
  WN_set_pragma_omp(critical2);
  WN_INSERT_BlockAfter(parent,fb,critical2);
  Set_Parent(critical2,parent);
  WN_Set_Linenum(critical2,line);
  WN_CopyMap(critical2, WN_MAP_FEEDBACK,atomic);
  
  if (Prompf_Info != NULL && Prompf_Info->Is_Enabled()) {
    INT old_id = WN_MAP32_Get(Prompf_Id_Map, atomic);
    WN_MAP32_Set(Prompf_Id_Map, critical1, old_id);
    WN_MAP32_Set(Prompf_Id_Map, critical2, old_id);
    Prompf_Info->OMPL_Atomic_To_Critical_Section(old_id);
  }

  WN_DELETE_FromBlock(parent,atomic);
}


// Is this op a Direct load or store
static BOOL Direct_Memory(WN *wn1)
{
  OPERATOR oper = WN_operator(wn1);
  return oper == OPR_LDID || oper == OPR_STID;
}

static BOOL Equiv_Expression(WN *wn1, WN *wn2)
{
  if (!WN_Equiv(wn1,wn2)) return FALSE;
  for (INT kidno=0; kidno<WN_kid_count(wn1); kidno++) {
    if (!Equiv_Expression(WN_kid(wn1,kidno),WN_kid(wn2,kidno))) {
      return FALSE;
    }
  }
  return TRUE;
}

// Are the two operations memory refs to the same location
static BOOL Same_Location(WN *wn1, WN *wn2)
{
  OPCODE opc1 = WN_opcode(wn1);
  OPCODE opc2 = WN_opcode(wn2);
  if (!OPCODE_is_load(opc1) && !OPCODE_is_store(opc1)) return FALSE;
  if (!OPCODE_is_load(opc2) && !OPCODE_is_store(opc2)) return FALSE;
  if (WN_offset(wn1) != WN_offset(wn2)) return FALSE;
  if (Direct_Memory(wn1)) {
    if (!Direct_Memory(wn2)) return FALSE;
    return WN_st(wn1) == WN_st(wn2);
  } 
 if (Direct_Memory(wn2)) return FALSE;
 WN *addr_kid1, *addr_kid2;
 if (OPCODE_is_store(opc1)) {
   addr_kid1 = WN_kid1(wn1);
 } else {
   addr_kid1 = WN_kid0(wn1);
 }
 if (OPCODE_is_store(opc2)) {
   addr_kid2 = WN_kid1(wn2);
 } else {
   addr_kid2 = WN_kid0(wn2);
 }
 return Equiv_Expression(addr_kid1,addr_kid2);
}

// Find under wn the location refered to in loc
// return NULL if you do not find it
static WN *Find_Same_Location(WN *loc,WN *wn)
{
  if (Same_Location(loc,wn)) {
    return wn;
  } else {
    for (INT kidno=0; kidno<WN_kid_count(wn); kidno++) {
      WN *tmp;
      tmp = Find_Same_Location(loc,WN_kid(wn,kidno));
      if (tmp) return tmp;
    }
    return NULL;
  }
}

#ifdef KEY
// Find under wn the location refered to in loc, also return its parent
// return NULL if you do not find it
static WN *Find_Same_Location_And_Parent(WN *loc, WN *wn,
                                         WN ** parent, int * kidnum)
{
  if (Same_Location(loc,wn)) {
    return wn;
  } else {
    // Don't expect it to be inside a block
    if (WN_operator (wn) == OPR_BLOCK)
      return NULL;
    for (INT kidno=0; kidno<WN_kid_count(wn); kidno++) {
      WN *tmp;
      tmp = Find_Same_Location_And_Parent(loc,WN_kid(wn,kidno), parent, kidnum);
      if (tmp)
      {
        if (WN_kid (wn, kidno) == tmp)
        {
          *kidnum = kidno;
          *parent = wn;
        }
        return tmp;
      }
    }
    return NULL;
  }
}

// For atomic operations of the form
//
// x binop= expr
//
// sometimes we have 'x' buried into the whole expression
//
// e.g. x += y + 1
// i.e. x = x + y + 1
// we often associate as
// x = (x + y) + 1
// omp-lowerer expects x to be on top, so fix such expressions
// Replace x by zero, and add 'x' to the result
// Currently this function expects 'binop' to be +/-
// Return true if the rhs format has been fixed.
static BOOL format_rhs_atomic_stmt (WN * store)
{
  WN * op = WN_kid0 (store);
  // We probably don't need this for operations other than +/-
  if (WN_operator (op) != OPR_ADD && WN_operator (op) != OPR_SUB)
    return FALSE;
  // Now find the load of the lhs st buried somewhere down
                                                                                
  WN * parent;
  int kidno;
  WN * find = Find_Same_Location_And_Parent (store, op, &parent, &kidno);
  FmtAssert (find, ("Invalid atomic operation stmt"));
  Is_True (WN_kid (parent, kidno) == find, ("Operand mismatch"));
                                                                                
  WN_kid (parent, kidno) = WN_Intconst (WN_rtype (find), 0);
  // Avoid a call to the simplifier
  WN * add = WN_Create (OPR_ADD, WN_rtype (op), MTYPE_V, 2);
  WN_kid0 (add) = find;
  WN_kid1 (add) = op;
  WN_kid0 (store) = add;
  return TRUE;
}
#endif // KEY

/***********************************************************************
 *
 * Allocate and return a SYMBOL* for a local variable of type mtype.
 *
 **********************************************************************/
static ST * Create_Local_Symbol (const char* name, TYPE_ID mtype) 
{
  ST* st         = New_ST(CURRENT_SYMTAB);
  ST_Init (st,
           Save_Str(name),
           CLASS_VAR,
           SCLASS_AUTO,
           EXPORT_LOCAL,
           Be_Type_Tbl(mtype));

  Set_ST_is_temp_var(st);
  return st;
}

//
// Localize a new local variable if it's inside a parallel region
// This routine is useful for "temps" only, in that it will assume
// that the given st is accessed in a LOCAL context, and needs to be
// privatized in *all* enclosing parallel regions.
//
static void Update_Private(ST *st, WN *wn)
{

  //
  // Build a vector of enclosing parallel regions
  //
  WN_VECTOR wnv(Malloc_Mem_Pool);
 
  WN *tmp = wn;
  while (tmp) {
    if (WN_opcode(tmp) == OPC_REGION &&
        RID_TYPE_mp(REGION_get_rid(tmp))) {
      wnv.push_back (tmp);
    }
    tmp = Get_Parent(tmp);
  }
  
  Add_Pragma_To_MP_Regions (&wnv, WN_PRAGMA_LOCAL,
                            st, 0, Omp_Parent_Map, FALSE);

}

// Implement atomic using compare-and-swap
// For patterned cases:
// x = x op expr gets transformed into
// 
// bool done = false
// tmp = expr
// while (!done) {
//   x2 = x 
//   x3 = x op tmp
//   done = compare-and-swap(x,x2,x3)
// }
//
// For unpatterned cases
// x = f(y) gets transformed into
//
// bool done = false
// while (!done) {
//   x2 = x 
//   x3 = f(y)
//   done = compare-and-swap(x,x2,x3)
// }
//
//
// If x2 and/or x3 are set, use these variables for x2 and/or x3
// (assume offset 0)
//
// return NULL on error

WN *
Atomic_Using_Swap(WN *atomic, WN *store, WN *operation, WN *parent,
                  Update_Private_Func upf, ST *x2, ST *x3)
{
  WN *retblock = WN_CreateBlock();

  INT64 line = WN_Get_Linenum(atomic);
  OPCODE store_opc = WN_opcode(store);

  // Find which kid is which
  WN *expr_kid;
  WN *var_kid;
  WN *bnot=NULL;

  // Special case BNOT(BXOR) since compound operation
  if (WN_operator(operation) == OPR_BNOT) {
    bnot = operation;
    operation = WN_kid0(operation);
  }

  BOOL unpatterned = FALSE;
  if (Same_Location(store,WN_kid0(operation))) {
    var_kid = WN_kid0(operation);
    expr_kid = WN_kid1(operation);
  } else if (WN_kid_count(operation) == 2 &&
       Same_Location(store,WN_kid1(operation))) {
    var_kid = WN_kid1(operation);
    expr_kid = WN_kid0(operation);
  } else {
    var_kid = Find_Same_Location(store,operation);
    if (!var_kid) {
      ErrMsgSrcpos(EC_MPLOWER_Generic_Error, WN_Get_Linenum(atomic),
     "OMP ATOMIC: Right hand side not of appropriate form. \n");
      return NULL;
    }
    unpatterned = TRUE;
  }

  // What type for the operations
  TYPE_ID type = OPCODE_desc(store_opc);
  TYPE_ID swap_type;
  if (type == MTYPE_I4 || type == MTYPE_U4 || type == MTYPE_F4) {
    swap_type = MTYPE_I4;
  } else { 
    Is_True(type == MTYPE_I8 || type == MTYPE_U8 || type == MTYPE_F8,
      ("Bad type in Atomic_Using_Swap"));
    swap_type = MTYPE_I8;
  }

  // Initialize the boolean
  ST *done_st = MTYPE_To_PREG(Boolean_type);
  WN_OFFSET done_offset = Create_Preg(Boolean_type,"done");
  WN *stid = WN_StidIntoPreg ( Boolean_type, done_offset,done_st,
      WN_CreateIntconst(OPCODE_make_op(OPR_INTCONST,Boolean_type,MTYPE_V),0));
  WN_INSERT_BlockBefore(retblock, NULL, stid);
  WN_Set_Linenum(stid,line);
  WN_CopyMap(stid, WN_MAP_FEEDBACK,atomic);

  // Copy the expr into a temp
  ST *expr_st=NULL;
  if (!unpatterned) {
    WN *expr_copy = WN_COPY_Tree(expr_kid);
    expr_st = Create_Local_Symbol("rhs_tmp",type);
    stid = WN_Stid(type,0,expr_st,Be_Type_Tbl(type),
      expr_copy);
    WN_INSERT_BlockBefore(retblock, NULL, stid);
    WN_Set_Linenum(stid,line);
    WN_CopyMap(stid, WN_MAP_FEEDBACK,atomic);
    if (upf) Update_Private(expr_st,parent);
  }

  // Create the while
  WN *while_wn=WN_CreateWhileDo(WN_LNOT(WN_LdidPreg(Boolean_type,done_offset)),
        WN_CreateBlock());
  WN_INSERT_BlockBefore(retblock, NULL, while_wn);
  WN_Set_Linenum(while_wn,line);
  WN_CopyMap(while_wn, WN_MAP_FEEDBACK,atomic);

  // copy 'x' into 'x2'
  WN *var_copy = WN_COPY_Tree(var_kid);
#ifdef KEY // bug 5264
  if (MTYPE_is_float(type) != MTYPE_is_float(swap_type)) {
#else
  if (type != swap_type) {
#endif
    var_copy = WN_Tas(swap_type,Be_Type_Tbl(swap_type),var_copy);
  }
  ST *var_st;
  if (!x2) {
    var_st = Create_Local_Symbol("var_tmp",swap_type);
  } else {
    var_st = x2;
  }
  stid = WN_Stid(swap_type,0,var_st,
      Be_Type_Tbl(swap_type),
      var_copy);
  WN_INSERT_BlockBefore(WN_while_body(while_wn),NULL,stid);
  WN_Set_Linenum(stid,line);
  WN_CopyMap(stid, WN_MAP_FEEDBACK,atomic);

  // double barrier to prevent later phases from
  // reordering the two reads of x
  WN *bar = WN_CreateBarrier(TRUE, 0);
  WN_INSERT_BlockAfter(WN_while_body(while_wn),stid,bar);
  WN_Set_Linenum(bar,line);
  WN_CopyMap(bar, WN_MAP_FEEDBACK,atomic);
  bar = WN_CreateBarrier(FALSE, 0);
  WN_INSERT_BlockAfter(WN_while_body(while_wn),stid,bar);
  WN_Set_Linenum(bar,line);
  WN_CopyMap(bar, WN_MAP_FEEDBACK,atomic);

  if (upf) Update_Private(var_st,parent);

  // if !unpatterned put x op tmp into x3
  // else put f(y) into x3
  ST *result_st;
  WN *new_op;
  if (!x3) {
    result_st = Create_Local_Symbol("result_tmp",swap_type);
  } else {
    result_st = x3;
  }
  if (!unpatterned) {
    new_op = WN_CopyNode(operation);
#ifdef KEY
    WN *new_var_kid = WN_Ldid(swap_type, 0, var_st, Be_Type_Tbl(type));
    if (MTYPE_is_float(type) != MTYPE_is_float(swap_type))
      new_var_kid = WN_Tas(type, Be_Type_Tbl(type), new_var_kid);  // bug 5552
#endif

    if (expr_kid == WN_kid1(operation)) {
#ifdef KEY  // bug 5512
      WN_kid0(new_op) = new_var_kid;
#else
      WN_kid0(new_op) = WN_COPY_Tree(var_kid);
#endif
      WN_kid1(new_op) = WN_Ldid(type,0,expr_st,
      Be_Type_Tbl(type));
    } else {
      Is_True(expr_kid == WN_kid0(operation),("Bad kid in Atomic_Using_Swap"));
#ifdef KEY  // bug 5512
      WN_kid1(new_op) = new_var_kid;
#else
      WN_kid1(new_op) = WN_COPY_Tree(var_kid);
#endif
      WN_kid0(new_op) = WN_Ldid(type,0,expr_st,
      Be_Type_Tbl(type));
    }
    if (bnot) {
      new_op = WN_Bnot(WN_rtype(bnot),new_op);
    }
  } else {
    new_op = WN_COPY_Tree(operation);
  }
#ifdef KEY // bug 5264
  if (MTYPE_is_float(type) != MTYPE_is_float(swap_type)) {
#else
  if (type != swap_type) {
#endif
    new_op = WN_Tas(swap_type,Be_Type_Tbl(swap_type),new_op);
  }
  stid = WN_Stid(swap_type,0,result_st,
        Be_Type_Tbl(swap_type),
        new_op);
  WN_INSERT_BlockBefore(WN_while_body(while_wn),NULL,stid);
  WN_Set_Linenum(stid,line);
  if (upf) Update_Private(result_st,parent);

  WN *fb = WN_CreateBarrier(TRUE, 0);
  WN_INSERT_BlockAfter(WN_while_body(while_wn),stid,fb);
  WN_Set_Linenum(fb,line);
  WN_CopyMap(fb, WN_MAP_FEEDBACK,atomic);

  // Create a call to compare-and-swap

  // first find the address of the variable
  WN *var_addr;
  if (WN_operator(var_kid) == OPR_LDID) {
    OPCODE lda_op = OPCODE_make_op(OPR_LDA, Pointer_type, MTYPE_V);
    var_addr = WN_CreateLda(lda_op, WN_offset(var_kid),
      Make_Pointer_Type(WN_ty(var_kid),FALSE),
      WN_st(var_kid));
  } else {
    var_addr = WN_COPY_Tree(WN_kid0(var_kid));
  }
  WN *kids[3];
  kids[0] = WN_CreateParm(Pointer_type, var_addr,Be_Type_Tbl(Pointer_type),
      WN_PARM_BY_REFERENCE);
  WN *tmp = WN_Ldid(swap_type,0,var_st, Be_Type_Tbl(swap_type));
  kids[1] = WN_CreateParm(swap_type,tmp,Be_Type_Tbl(swap_type),
      WN_PARM_BY_VALUE);
  tmp = WN_Ldid(swap_type,0,result_st, Be_Type_Tbl(swap_type));
  kids[2] = WN_CreateParm(swap_type,tmp,Be_Type_Tbl(swap_type),
      WN_PARM_BY_VALUE);

  WN *c_s;
  if (swap_type == MTYPE_I4) {
    c_s=WN_Create_Intrinsic(OPC_U4INTRINSIC_CALL,
        INTRN_COMPARE_AND_SWAP_I4,3,kids);
  } else {
    c_s=WN_Create_Intrinsic(OPC_U8INTRINSIC_CALL,
        INTRN_COMPARE_AND_SWAP_I8,3,kids);
  }
  WN_Set_Call_Parm_Mod(c_s);
  WN_Set_Call_Parm_Ref(c_s);
  WN_INSERT_BlockBefore(WN_while_body(while_wn),NULL,c_s);
  WN_Set_Linenum(c_s,line);
  WN_CopyMap(c_s, WN_MAP_FEEDBACK,atomic);

  // Assign the return register to done
  PREG_NUM rreg1, rreg2;
  ST* rst = Find_Return_Registers (Pointer_type, &rreg1, &rreg2);
  FmtAssert(rreg1 != 0 && rreg2 == 0, ("Bad pointer type ret regs"));
  stid = WN_StidIntoPreg ( Boolean_type, done_offset,done_st,
    WN_CreateLdid (OPCODE_make_op(OPR_LDID, Pointer_type, Pointer_type),
      rreg1, rst, Be_Type_Tbl(Pointer_type)));
  WN_INSERT_BlockAfter(WN_while_body(while_wn),c_s,stid);
  WN_Set_Linenum(stid,line);
  WN_CopyMap(stid, WN_MAP_FEEDBACK,atomic);

  WN *bb = WN_CreateBarrier(FALSE, 0);
  WN_INSERT_BlockAfter(WN_while_body(while_wn),stid,bb);
  WN_Set_Linenum(bb,line);
  WN_CopyMap(bb, WN_MAP_FEEDBACK,atomic);

  return retblock;
}

// Use a direct fetch-and-op intrinsic
// Changes contents of store if it is not of proper format
WN *Atomic_Direct(WN *atomic, WN *store, WN *operation)
{
  WN *retblock = WN_CreateBlock();

  INT64 line = WN_Get_Linenum(atomic);
  OPCODE store_opc = WN_opcode(store);
  OPERATOR oper = WN_operator(operation);

  // Find which kid is which
  WN *expr_kid;
  WN *var_kid;
#ifdef KEY
  for (INT i=0; i<2; i++)
  {
    if (Same_Location(store,WN_kid0(operation))) {
      var_kid = WN_kid0(operation);
      expr_kid = WN_kid1(operation);
      break;
    } else if (Same_Location(store,WN_kid1(operation))) {
      var_kid = WN_kid1(operation);
      expr_kid = WN_kid0(operation);
      break;
    } else {
      BOOL format_ok = format_rhs_atomic_stmt (store);
      if (!format_ok)
      {
        ErrMsgSrcpos(EC_MPLOWER_Generic_Error, WN_Get_Linenum(atomic),
         "OMP ATOMIC: Right hand side not of appropriate form. \n");
        return NULL;
      }
      // Update with new operation
      operation = WN_kid0 (store);
      oper = WN_operator (operation);
    }
  }
#else
  if (Same_Location(store,WN_kid0(operation))) {
    var_kid = WN_kid0(operation);
    expr_kid = WN_kid1(operation);
  } else if (Same_Location(store,WN_kid1(operation))) {
    var_kid = WN_kid1(operation);
    expr_kid = WN_kid0(operation);
  } else {
    ErrMsgSrcpos(EC_MPLOWER_Generic_Error, WN_Get_Linenum(atomic),
     "OMP ATOMIC: Right hand side not of appropriate form. \n");
    return NULL;
  }
#endif // KEY

  TYPE_ID type = OPCODE_desc(store_opc);
  Is_True(type == MTYPE_I4 || type == MTYPE_I8,("Bad type in Atomic_Direct"));


  // first find the address of the variable
  WN *var_addr;
  if (WN_operator(var_kid) == OPR_LDID) {
    OPCODE lda_op = OPCODE_make_op(OPR_LDA, Pointer_type, MTYPE_V);
    var_addr = WN_CreateLda(lda_op, WN_offset(var_kid),
      Make_Pointer_Type(WN_ty(var_kid),FALSE),
      WN_st(var_kid));
  } else {
    var_addr = WN_COPY_Tree(WN_kid0(var_kid));
  }
  WN *kids[2];
  kids[0] = WN_CreateParm(Pointer_type,var_addr,Be_Type_Tbl(Pointer_type),
            WN_PARM_BY_REFERENCE);
  kids[1] = WN_CreateParm(type,WN_COPY_Tree(expr_kid),Be_Type_Tbl(type),
            WN_PARM_BY_VALUE);

  INTRINSIC intrinsic_type;
  if (type == MTYPE_I4) {
    switch (oper) {
      case OPR_ADD: intrinsic_type = INTRN_FETCH_AND_ADD_I4; break;
      case OPR_SUB: intrinsic_type = INTRN_FETCH_AND_SUB_I4; break;
      case OPR_BAND: intrinsic_type = INTRN_FETCH_AND_AND_I4; break;
      case OPR_BIOR: intrinsic_type = INTRN_FETCH_AND_OR_I4; break;
      case OPR_BXOR: intrinsic_type = INTRN_FETCH_AND_XOR_I4; break;
      default: Is_True(0,("Bad intrinsic type in Atomic_Direct"));
    } 
  } else {
    switch (oper) {
      case OPR_ADD: intrinsic_type = INTRN_FETCH_AND_ADD_I8; break;
      case OPR_SUB: intrinsic_type = INTRN_FETCH_AND_SUB_I8; break;
      case OPR_BAND: intrinsic_type = INTRN_FETCH_AND_AND_I8; break;
      case OPR_BIOR: intrinsic_type = INTRN_FETCH_AND_OR_I8; break;
      case OPR_BXOR: intrinsic_type = INTRN_FETCH_AND_XOR_I8; break;
      default: Is_True(0,("Bad intrinsic type in Atomic_Direct"));
    } 
  }

  WN *fetch_and_op;
  if (type == MTYPE_I4) {
    fetch_and_op=WN_Create_Intrinsic(OPC_I4INTRINSIC_CALL,
        intrinsic_type,2,kids);
  } else {
    fetch_and_op=WN_Create_Intrinsic(OPC_I8INTRINSIC_CALL,
        intrinsic_type,2,kids);
  }
  WN_Set_Call_Parm_Mod(fetch_and_op);
  WN_Set_Call_Parm_Ref(fetch_and_op);
  WN_INSERT_BlockBefore(retblock, NULL, fetch_and_op);
  WN_Set_Linenum(fetch_and_op,line);
  WN_CopyMap(atomic, WN_MAP_FEEDBACK,fetch_and_op);

  WN *fb = WN_CreateBarrier(TRUE, 0);
  WN_INSERT_BlockBefore(retblock, fetch_and_op, fb);
  WN_Set_Linenum(fb,line);
  WN_CopyMap(fb, WN_MAP_FEEDBACK,atomic);

  WN *bb = WN_CreateBarrier(FALSE, 0);
  WN_INSERT_BlockAfter(retblock, fetch_and_op, bb);
  WN_Set_Linenum(bb,line);
  WN_CopyMap(bb, WN_MAP_FEEDBACK,atomic);

  return retblock;
}

  // wn must be an intrinsic call.  If it's the intrinsic call for an 
  // ATOMIC lowered using Atomic_Using_Swap or Atomic_Direct, return the
  // LDA node within the intrinsic call tree that references the variable
  // being atomically updated.  Otherwise, return NULL.
WN *
Get_ATOMIC_Update_LDA(WN *wn)
{
  Is_True(wn, ("NULL wn"));
  Is_True(WN_operator(wn) == OPR_INTRINSIC_CALL, ("not an intrinsic call"));

  switch (WN_intrinsic(wn)) {
      // from Atomic_Direct()
  case INTRN_FETCH_AND_ADD_I4:
  case INTRN_FETCH_AND_SUB_I4:
  case INTRN_FETCH_AND_AND_I4:
  case INTRN_FETCH_AND_OR_I4:
  case INTRN_FETCH_AND_XOR_I4:
  case INTRN_FETCH_AND_ADD_I8:
  case INTRN_FETCH_AND_SUB_I8:
  case INTRN_FETCH_AND_AND_I8:
  case INTRN_FETCH_AND_OR_I8:
  case INTRN_FETCH_AND_XOR_I8:
      // from Atomic_Using_Swap()
  case INTRN_COMPARE_AND_SWAP_I4:
  case INTRN_COMPARE_AND_SWAP_I8:
    break;
  default:
    return NULL;
  }

  WN *parm0 = WN_kid0(wn);
  Is_True(parm0 && WN_operator(parm0) == OPR_PARM, ("bad parameter"));
  parm0 = WN_kid0(parm0);

    // return of NULL after this point means we don't know what was being
    // updated
  if (WN_operator(parm0) == OPR_LDA)
    return parm0; // ATOMIC update of scalar
  else if (WN_operator(parm0) != OPR_ARRAY)
    return NULL;

  WN *array_base = WN_kid0(parm0);
  if (WN_operator(array_base) == OPR_LDA)
    return array_base;  // ATOMIC update of array element

  return NULL;
}


  // replace atomic and following STORE in parent block by atomic_block,
  // only for SWAP and DIRECT classes of ATOMIC
static void
Insert_Lowered_Atomic(WN *parent, WN *atomic, WN *atomic_block,
                      ATOMIC_Lowering_Class alclass)
{
  if (!atomic_block) {  // recover from an error condition
    WN_DELETE_FromBlock(parent, WN_next(atomic));
    WN_DELETE_FromBlock(parent, atomic);
    return;
  }
  Is_True(WN_opcode(atomic_block) == OPC_BLOCK,
          ("bad atomic_block"));
  for (WN *wn = WN_first(atomic_block); wn; ) {
    WN *wn2 = WN_next(wn);
    WN_EXTRACT_FromBlock(atomic_block, wn);
    Parentize(wn);
    Set_Parent(wn, parent);
    WN_INSERT_BlockBefore(parent, atomic, wn);
    wn = wn2;
  }
  if (Prompf_Info != NULL && Prompf_Info->Is_Enabled()) {
    INT old_id = WN_MAP32_Get(Prompf_Id_Map, atomic);
    if (alclass == ALCLASS_SWAP)
      Prompf_Info->OMPL_Atomic_To_Swap(old_id);
    else if (alclass == ALCLASS_DIRECT)
      Prompf_Info->OMPL_Atomic_To_FetchAndOp(old_id);
    else
      Fail_FmtAssertion("bad alclass == %d", (INT) alclass);
  }

  WN_Delete(atomic_block);
  WN_DELETE_FromBlock(parent, WN_next(atomic));
  WN_DELETE_FromBlock(parent, atomic);
}

  // General ATOMIC lowerer that can generate all implementations of ATOMIC
static void Lower_Atomic(WN *atomic)
{
  WN *store = WN_next(atomic);

  if (OPCODE_is_store(WN_opcode(store)) && 
  (!WN_kid_count(WN_kid0(store))) || 
  (OPCODE_is_load(WN_opcode(WN_kid0(store))))) {
    TYPE_ID store_type = OPCODE_desc(WN_opcode(store));
    ErrMsgSrcpos(EC_MPLOWER_Generic_Warning, WN_Get_Linenum(atomic),
     "OMP ATOMIC directive simplifies into a store. \n");
    switch (store_type) {
      case MTYPE_I4: case MTYPE_I8: case MTYPE_I1: case MTYPE_I2:
      case MTYPE_U4: case MTYPE_U8: case MTYPE_U1: case MTYPE_U2:
      case MTYPE_F4: case MTYPE_F8:
  {
          WN *parent = Get_Parent(atomic);
          WN_DELETE_FromBlock(parent,atomic);
        }
  break;
      default:
        Atomic_Using_Critical(atomic, store);
  break;
    }
    return;
  }

#ifdef TARG_X8664 /*Bug 4874, 4893, 4936 */
  if (Is_Target_32bit()){
    TYPE_ID store_type = OPCODE_desc(WN_opcode(store));
    if (store_type == MTYPE_I8 ||
        store_type == MTYPE_U8 ||
         store_type == MTYPE_F8) {
      Atomic_Using_Critical(atomic, store);
      return;
    }
  }
#endif
  ATOMIC_Lowering_Class alclass = WN_ATOMIC_Lowering_Class(atomic);

  switch (alclass) {
  case ALCLASS_CRITICAL:
    Atomic_Using_Critical(atomic, store);
    break;
  case ALCLASS_SWAP:
  case ALCLASS_DIRECT:
    {
      WN *parent = Get_Parent(atomic);
      WN *operation = WN_kid0(WN_next(atomic));
      WN *atomic_block =
            (alclass == ALCLASS_SWAP) ?
              Atomic_Using_Swap(atomic, store, operation,
                          Get_Parent(atomic), Update_Private) :
              Atomic_Direct(atomic, store, operation);

      Insert_Lowered_Atomic(parent, atomic, atomic_block, alclass);
    }
    break;
  case ALCLASS_ERROR: // either a hard error or a warning 
          // delete the atomic and continue
    {
      WN *parent = Get_Parent(atomic);
      WN_DELETE_FromBlock(parent,atomic);
    }
    break;
  default:
    Fail_FmtAssertion("invalid ATOMIC_Lowering_Class");
  }
}

  // Determine lowering class of an ATOMIC, also validates that atomic is
  // an ATOMIC and the node following atomic is a valid kind of STORE.
ATOMIC_Lowering_Class WN_ATOMIC_Lowering_Class(WN *atomic)
{
  Is_True(atomic && WN_opcode(atomic) == OPC_PRAGMA &&
          WN_pragma(atomic) == WN_PRAGMA_ATOMIC, ("not an ATOMIC"));
  WN *store = WN_next(atomic);
  Is_True(store, ("nothing after ATOMIC"));

  return WN_ATOMIC_STORE_Lowering_Class(store);
}


  // Given the STORE node following an ATOMIC, determine the lowering class
  // of the ATOMIC.  Also validates the store and its kids.
ATOMIC_Lowering_Class WN_ATOMIC_STORE_Lowering_Class(WN *store)
{
  Is_True(store, ("NULL store"));
  OPCODE store_opc = WN_opcode(store);
  if (!OPCODE_is_store(store_opc)) {
    ErrMsgSrcpos(EC_MPLOWER_Generic_Error, WN_Get_Linenum(store),
     "OMP ATOMIC directive not followed by a store. \n");
    return ALCLASS_ERROR;
  }


  // Is the operation ok
  WN *operation = WN_kid0(store);
  OPERATOR oper = WN_operator(operation);
  switch (oper) {
    case OPR_ADD: case OPR_LAND: case OPR_MPY: case OPR_SUB: case OPR_DIV:
    case OPR_BAND: case OPR_BIOR: case OPR_LIOR: case OPR_BXOR: case OPR_EQ:
    case OPR_NE: case OPR_MAX: case OPR_MIN:
    case OPR_ASHR: case OPR_LSHR: case OPR_SHL:
    case OPR_CVT: case OPR_TAS: case OPR_CVTL: case OPR_TRUNC:
    case OPR_REALPART: case OPR_IMAGPART:
#ifdef KEY // bug 8862
    case OPR_CAND: case OPR_CIOR:
#endif // KEY
      break;
    case OPR_BNOT:
      if (WN_operator(WN_kid0(operation)) != OPR_BXOR) {
        ErrMsgSrcpos(EC_MPLOWER_Generic_Error, WN_Get_Linenum(store),
     "Unsupported operator for OMP ATOMIC. \n");
        return ALCLASS_ERROR;
      }
      break;
    default:
      ErrMsgSrcpos(EC_MPLOWER_Generic_Error, WN_Get_Linenum(store),
     "Unsupported operator for OMP ATOMIC. \n");
      return ALCLASS_ERROR;
  }

  // determine lowering class
  TYPE_ID store_type = OPCODE_desc(store_opc);
  ATOMIC_Lowering_Class alclass;

  switch (store_type) {
    case MTYPE_U4: case MTYPE_U8: case MTYPE_F4: case MTYPE_F8:
#ifdef TARG_IA32
      alclass = ALCLASS_CRITICAL;
#else 
      alclass = ALCLASS_SWAP;
#endif
      break;

#ifdef TARG_IA64
    case MTYPE_F10:
  alclass = ALCLASS_CRITICAL; /* XXX - ALCLASS_SWAP? */
  break;

    case MTYPE_C10:
#endif
    case MTYPE_U1: case MTYPE_U2: case MTYPE_I1: case MTYPE_I2:
    case MTYPE_C4: case MTYPE_C8: case MTYPE_CQ: case MTYPE_FQ:
      alclass = ALCLASS_CRITICAL;
      break;

    case MTYPE_I4: 
    case MTYPE_I8:
      switch (oper) {
  case OPR_ADD: 
        case OPR_SUB:
        case OPR_BAND: 
        case OPR_BIOR: 
        case OPR_BXOR:
#if defined(TARG_IA32)
          alclass = ALCLASS_CRITICAL;
#elif defined(TARG_IA64)
          alclass = ALCLASS_SWAP;
#else
          alclass = ALCLASS_DIRECT;
#endif 
          break;

        default:
#if defined(TARG_IA32) 
          alclass = ALCLASS_CRITICAL;
#else 
          alclass = ALCLASS_SWAP;
#endif 
          break;
      }
      break;

    default:
      ErrMsgSrcpos(EC_MPLOWER_Generic_Error, WN_Get_Linenum(store),
     "Unsupported type for OMP ATOMIC. \n");
      return ALCLASS_ERROR;
  }

  return alclass;
}


// Lower a MASTER directive into if (OMP_GET_THREAD_NUM() == 0)
// If this is not a MASTER, return region
// If it is, return the WN node for the if
static WN *Lower_Master(WN *region)
{
  if (WN_opcode(region) != OPC_REGION) {
    return region;
  }
  WN *pragmas = WN_region_pragmas(region);
  if (pragmas) {
    WN *pragma = WN_first(pragmas);
    BOOL found_it = FALSE;
    while (pragma && !found_it) {
      if (WN_opcode(pragma) == OPC_PRAGMA) {
        if ((WN_PRAGMA_ID)WN_pragma(pragma)==WN_PRAGMA_MASTER_BEGIN) {
    found_it = TRUE;
        }
      }
      pragma = WN_next(pragma);
    }
    INT pragma_count = 0; 
    if (!found_it) return region;
    for (WN* wn = WN_first(pragmas); wn != NULL; wn = WN_next(wn)) 
      if (WN_opcode(wn) != OPC_PRAGMA 
          || WN_pragma(wn) != WN_PRAGMA_END_MARKER)
        pragma_count++;
    if (pragma_count != 1) {
       ErrMsgSrcpos(EC_MPLOWER_Generic_Error, WN_Get_Linenum(region),
     "OMP MASTER directive can not have subclauses. \n");
    }
  }

  // It's a well behaved MASTER directive

  // Create a call to get the thread number
  WN *call = WN_Create(OPC_I4CALL,0);
  ST *func_st = Create_Omp_Get_Thread_Num();
  WN_st_idx(call) = ST_st_idx(func_st);
  WN_Set_Linenum(call,WN_Get_Linenum(region));
  WN_CopyMap(call, WN_MAP_FEEDBACK,region);
  WN *parent = Get_Parent(region);
  WN_INSERT_BlockBefore(parent,region,call);
  Set_Parent(call,parent);

  // Assign the result of the call to a new preg
  ST *tmp_st = MTYPE_To_PREG(MTYPE_I4);
  WN_OFFSET tmp_offset = Create_Preg(MTYPE_I4,THREAD_NUM_PREG_NAME);
  WN *tmp_ldid = WN_LdidPreg(MTYPE_I4,First_Int_Preg_Return_Offset);
  WN *tmp_stid = WN_StidIntoPreg ( MTYPE_I4, tmp_offset,tmp_st,tmp_ldid);
  Set_Parent(tmp_ldid,tmp_stid);
  WN_INSERT_BlockBefore(parent,region,tmp_stid);
  Set_Parent(tmp_stid,parent);
  WN_Set_Linenum(tmp_stid,WN_Get_Linenum(region));
  WN_CopyMap(tmp_stid, WN_MAP_FEEDBACK,region);

  // Create an IF
  WN *test = WN_EQ(MTYPE_I4,WN_LdidPreg(MTYPE_I4,tmp_offset),
    WN_CreateIntconst ( OPC_I4INTCONST,(INT64)0 ));
  WN *if_wn = WN_CreateIf(test,WN_CreateBlock(),WN_CreateBlock());
  Parentize(if_wn);
  WN_INSERT_BlockBefore(parent,region,if_wn);
  Set_Parent(if_wn,parent);
  WN_Set_Linenum(if_wn,WN_Get_Linenum(region));
  WN_CopyMap(if_wn, WN_MAP_FEEDBACK,region);

  // Move all the code from the region to the if
  WN *region_body = WN_region_body(region);
  while (WN_last(region_body)) {
    WN *wn = WN_EXTRACT_FromBlock(region_body,WN_last(region_body));
    WN_INSERT_BlockAfter(WN_then(if_wn),NULL,wn);
    Set_Parent(wn,WN_then(if_wn));
  }
  RID_Delete(Current_Map_Tab, region);
  if (Prompf_Info != NULL && Prompf_Info->Is_Enabled()) { 
    INT old_id = WN_MAP32_Get(Prompf_Id_Map, region);
    Prompf_Info->OMPL_Master_To_If(old_id); 
  } 
  WN_DELETE_FromBlock(Get_Parent(region),region);

  // Add barriers
  WN *fb1 = WN_CreateBarrier(TRUE, 0);
  WN_Set_Linenum(fb1,WN_Get_Linenum(if_wn));
  WN *fb2 = WN_CreateBarrier(TRUE, 0);
  WN_Set_Linenum(fb2,WN_Get_Linenum(if_wn));
  WN *bb1 = WN_CreateBarrier(FALSE, 0);
  WN_Set_Linenum(bb1,WN_Get_Linenum(if_wn));
  WN *bb2 = WN_CreateBarrier(FALSE, 0);
  WN_Set_Linenum(bb2,WN_Get_Linenum(if_wn));
  WN_CopyMap(fb1, WN_MAP_FEEDBACK,if_wn);
  WN_CopyMap(bb2, WN_MAP_FEEDBACK,if_wn);
  if (WN_first(WN_then(if_wn))) {
    WN_CopyMap(fb2, WN_MAP_FEEDBACK,WN_first(WN_then(if_wn)));
    WN_CopyMap(bb1, WN_MAP_FEEDBACK,WN_first(WN_then(if_wn)));
  } else {  // degenerate case of nothing inside of master
    WN_CopyMap(fb2, WN_MAP_FEEDBACK,if_wn);
    WN_CopyMap(bb1, WN_MAP_FEEDBACK,if_wn);
  }

  WN_INSERT_BlockBefore(parent,if_wn,fb1);
  Set_Parent(fb1,parent);
  WN_INSERT_BlockAfter(WN_then(if_wn),NULL,bb1);
  Set_Parent(bb1,WN_then(if_wn));
  WN_INSERT_BlockBefore(WN_then(if_wn),NULL,fb2);
  Set_Parent(fb2,WN_then(if_wn));
  WN_INSERT_BlockAfter(parent,if_wn,bb2);
  Set_Parent(bb2,parent);

  return if_wn;
}

/***********************************************************************
 *
 * Return TRUE if the given wn is an ORDERED MP region, 
 * FALSE otherwise.
 *
 ***********************************************************************/
static BOOL Is_Ordered_Do (WN* wn) {

  if (WN_opcode(wn) != OPC_REGION || !RID_TYPE_mp(REGION_get_rid(wn))) {
    return FALSE;
  }

  WN *pragma = WN_first(WN_region_pragmas(wn));
  while (pragma) {
    if (WN_opcode(pragma) == OPC_PRAGMA &&
        WN_pragma_omp(pragma) &&
        WN_pragma(pragma) == WN_PRAGMA_ORDERED) {
      return TRUE;
    }
    pragma = WN_next(pragma);
  }
  return FALSE;
}

/***********************************************************************
 *
 * Return a function TY for a function with zero arguments
 * and a void return value.
 *
 ***********************************************************************/
static TY_IDX Get_Func_Zero_Arg_TY () {
  static TY_IDX func_ty = (TY_IDX) NULL;

  if (func_ty == (TY_IDX) NULL) {

    TY& ty = New_TY (func_ty);

    TYLIST_IDX parm_idx;
    New_TYLIST (parm_idx);

    Set_TY_tylist (ty, parm_idx);

    Tylist_Table [parm_idx] = Be_Type_Tbl(MTYPE_V); // return type
    
    // no parameters, so setup the terminating TYLIST entry
    New_TYLIST (parm_idx);
    Tylist_Table [parm_idx] = 0;

    TY_Init (ty,0,KIND_FUNCTION,MTYPE_UNKNOWN,Save_Str (".mpruntime"));
  }
  return func_ty;
}

/***********************************************************************
 *
 * Return a function TY for a function with one I8 argument
 * and a void return value.
 *
 ***********************************************************************/
static TY_IDX Get_Func_One_Arg_TY () {
  static TY_IDX func_ty = (TY_IDX) NULL;

  if (func_ty == (TY_IDX) NULL) {

    TY& ty = New_TY(func_ty);
    TY_Init (ty,0,KIND_FUNCTION,MTYPE_UNKNOWN,Save_Str (".mpruntime"));
    Set_TY_align (func_ty, 1);

    TYLIST_IDX parm_idx;
    TYLIST& parm_list = New_TYLIST (parm_idx);
    Set_TY_tylist (ty, parm_idx);

    Set_TYLIST_type(parm_list, Be_Type_Tbl(MTYPE_V)); // return type

      // One MTYPE_I8 parameter
    Set_TYLIST_type(New_TYLIST(parm_idx), Be_Type_Tbl(MTYPE_I8));

    Set_TYLIST_type(New_TYLIST(parm_idx), TY_IDX_ZERO); // end of parm list
  }
  return func_ty;
}

/***********************************************************************
 *
 * Given an MP region for either an ORDERED OMP PARALLEL-DO or an
 *                                  ORDERED OMP PDO
 *
 * modify the region and the body of the DO-LOOP as follows:
 *
 *      PARALLEL DO (or PDO)
 *        PRAGMA BLOCK
 *            <lower-bound of do-loop>
 *          XPRAGMA ORDERED_LOWER_BOUND
 *            <stride of do-loop>
 *          XPRAGMA ORDERED_STRIDE
 *        END BLOCK
 * 
 *      PARALLEL DO (or PDO)
 *      DO i = ...
 *          __omp_pdo_ordered_begin_iter (i)
 *              ...
 *          __omp_pdo_ordered_end_iter (i)
 *      END
 *
 * These XPRAGMAS allow the MP-lowerer to easily locate the
 *  - lower-bound of original do-loop
 *  - stride of original do-loop
 *  - value of index variable of original do-loop
 * these values are needed by the runtime calls that implement ordered.
 *
 * Return the original region.
 *
 ***********************************************************************/
static WN *Add_Ordered_XPragmas (WN* wn) {

  static ST *begin_iter_st = NULL;
  static ST *end_iter_st = NULL;

  if (begin_iter_st == NULL) {
    /* Make a ST: add function to global symbol table */

    begin_iter_st = New_ST (GLOBAL_SYMTAB);
    PU_IDX pu_idx;
    PU& pu = New_PU (pu_idx);
    PU_Init (pu, Get_Func_One_Arg_TY(), CURRENT_SYMTAB);

    ST_Init (begin_iter_st,
             Save_Str("__omp_pdo_ordered_begin_iter"),
             CLASS_FUNC,
             SCLASS_EXTERN,
             EXPORT_PREEMPTIBLE,
             pu_idx);
  }
  if (end_iter_st == NULL) {
    /* Make a ST: add function to global symbol table */

    end_iter_st = New_ST (GLOBAL_SYMTAB);
    PU_IDX pu_idx;
    PU& pu = New_PU (pu_idx);
    PU_Init (pu, Get_Func_One_Arg_TY(), CURRENT_SYMTAB);

    ST_Init (end_iter_st,
             Save_Str("__omp_pdo_ordered_end_iter"),
             CLASS_FUNC,
             SCLASS_EXTERN,
             EXPORT_PREEMPTIBLE,
             pu_idx);
  }

  WN* do_wn = WN_first(WN_region_body(wn));
  while (do_wn) {
    if (WN_opcode(do_wn) == OPC_DO_LOOP) break;
    do_wn = WN_next(do_wn);
  }
  FmtAssert (do_wn,("Add_Ordered_XPragmas: Unable to locate parallel loop\n"));
  
  WN *body = WN_do_body(do_wn);

  // get the type of index variable, and upgrade it to I8/U8
  TYPE_ID desc = WN_desc(WN_kid1(do_wn));
  TYPE_ID rtype = desc;
  rtype = ((rtype == MTYPE_I1 || rtype == MTYPE_I2 || rtype == MTYPE_I4) ?
           MTYPE_I8 :
           ((rtype == MTYPE_U1 || rtype == MTYPE_U2 || rtype == MTYPE_U4) ?
            MTYPE_U8 : rtype));
  FmtAssert (rtype == MTYPE_I8 || rtype == MTYPE_U8,
             ("Expected integer index variable for parallel ordered do-loop"));
  WN *index_wn = WN_RLdid (rtype, desc,
                           WN_offset(WN_kid1(do_wn)), WN_st(WN_kid1(do_wn)),
                           ST_type(WN_st(WN_kid1(do_wn))));

  // insert the first call, to begin_iter
  // No need to insert the two shell-call for GUIDE RTL.
  // csc.
  /*
  WN* call_wn = WN_Create (OPC_VCALL, 1);
  WN_st_idx(call_wn) = ST_st_idx(begin_iter_st);
  WN_Set_Call_Non_Data_Mod(call_wn);
  WN_Set_Call_Non_Data_Ref(call_wn);
  WN_Set_Linenum(call_wn,WN_Get_Linenum(WN_first(body)));
  index_wn = WN_CreateParm (MTYPE_I8, index_wn, Be_Type_Tbl(MTYPE_I8),
                            WN_PARM_BY_VALUE);
  WN_kid0(call_wn) = index_wn;
  Parentize(call_wn);
  WN_INSERT_BlockAfter(body, NULL, call_wn);

  // insert the second call, to end_iter
  index_wn = WN_COPY_Tree (index_wn);
  call_wn = WN_Create (OPC_VCALL, 1);
  WN_st_idx(call_wn) = ST_st_idx(end_iter_st);
  WN_Set_Call_Non_Data_Mod(call_wn);
  WN_Set_Call_Non_Data_Ref(call_wn);
  WN_Set_Linenum(call_wn,WN_Get_Linenum(WN_last(body)));
  WN_kid0(call_wn) = index_wn;
  Parentize(call_wn);
  WN_INSERT_BlockBefore(body, NULL, call_wn);
  */
  // Now generate an Xpragma for the lower bound and the stride,
  // in the pragma block of the region.
  WN *lb = WN_COPY_Tree (WN_kid0(WN_start(do_wn)));
  WN *xpragma_wn = WN_CreateXpragma (WN_PRAGMA_ORDERED_LOWER_BOUND,
                                     (ST*) NULL, 1);
  WN_kid0(xpragma_wn) = lb; 
  Parentize(xpragma_wn);
  WN_INSERT_BlockBefore(WN_region_pragmas(wn), NULL, xpragma_wn);

  WN *stride;
  if (WN_operator(WN_kid0(WN_kid0(WN_step(do_wn)))) == OPR_LDID &&
      WN_st(WN_kid0(WN_kid0(WN_step(do_wn)))) == WN_st(WN_index(do_wn)) &&
      WN_offset(WN_kid0(WN_kid0(WN_step(do_wn)))) ==
      WN_offset(WN_index(do_wn))) {
    stride = WN_COPY_Tree(WN_kid1(WN_kid0(WN_step(do_wn))));
  }
  else {
    stride = WN_COPY_Tree(WN_kid0(WN_kid0(WN_step(do_wn))));
  }
  xpragma_wn = WN_CreateXpragma (WN_PRAGMA_ORDERED_STRIDE,
                                 (ST*) NULL, 1);
  WN_kid0(xpragma_wn) = stride;
  Parentize(xpragma_wn);
  WN_INSERT_BlockBefore(WN_region_pragmas(wn), NULL, xpragma_wn);

  return wn;
}

/***********************************************************************
 * Given a WN for a parallel region or program unit, apply DEFAULT scoping
 * as specified in the OMP document.
 *
 * The helper function Apply_Par_Region_Default_Scopes() does the real work
 * of recursive tree-traversal to apply the default scope.  This function
 * determines the default scope, manages memory for the hash of what
 * variables have been processed, and deletes the DEFAULT clause when done.
 *
 * Arguments:
 *  pu : input : the Whirl tree for the PU or parallel region.
 *  construct_pragma_block_list : input : list of pragma blocks for all
 *    parallel constructs enclosing pu that can affect variable scopes.
 ***********************************************************************/

static void Apply_Default_Scopes(WN *pu, WN_LIST *construct_pragma_block_list)
{
  Is_True(pu, ("Apply_Default_Scopes(): NULL pu argument"));

    // process each variable once per parallel region enclosing it
  ST_TO_BOOL_HASH *processed = CXX_NEW(ST_TO_BOOL_HASH(NUM_HASH_ELEMENTS,
                                        &omp_pool), &omp_pool);
  BOOL dummy;
  WN *pragma_block = Par_Region_Pragma_Block(pu, &dummy);

  if (pragma_block) { // pu is a parallel region
    WN_PRAGMA_DEFAULT_KIND defsc = WN_PRAGMA_DEFAULT_UNKNOWN;
    WN *prag; // the DEFAULT clause, if any

      // search for default scope clause
    for (prag = WN_first(pragma_block); prag; prag = WN_next(prag))
      if (WN_opcode(prag) == OPC_PRAGMA &&
          WN_pragma(prag) == WN_PRAGMA_DEFAULT) {
        defsc = (WN_PRAGMA_DEFAULT_KIND) WN_pragma_arg1(prag);
        break;
      }

      // push pragmas for parallel region
    construct_pragma_block_list->AddElement(pragma_block);
      // helper function applies defsc recursively in pu
    Apply_Par_Region_Default_Scopes(pu, processed, pragma_block, 
                                    construct_pragma_block_list, defsc);
    construct_pragma_block_list->Decidx();

    if (prag) {
      if (Get_Trace(TP_LNOPT2, TT_LNO_OMP_TRANSFORMS))
        printf("OMP_Prelower: applied DEFAULT(%s) clause at line %d\n",
          (defsc == WN_PRAGMA_DEFAULT_NONE) ? "NONE" :
            (defsc == WN_PRAGMA_DEFAULT_PRIVATE) ? "PRIVATE" :
            (defsc == WN_PRAGMA_DEFAULT_SHARED) ? "SHARED" : "?????",
          WN_Find_Linenum(prag));
      Set_Parent(prag, NULL);
      WN_DELETE_FromBlock(pragma_block, prag);  // remove DEFAULT clause
    }

  } else
      // let helper function find the parallel regions
    Apply_Par_Region_Default_Scopes(pu, processed, NULL,
                                    construct_pragma_block_list,
                                    WN_PRAGMA_DEFAULT_UNKNOWN);

  CXX_DELETE(processed, &omp_pool);
}


/***********************************************************************
 * This function does the real work of applying DEFAULT scopes. It also
 * sets the ST_is_shared_auto bit on appropriate variables.
 *
 * Arguments:
 *  wn : input : the Whirl tree to process
 *  processed : input/output : the set of ST's that have been processed
 *  pragma_block : input : the block of pragmas that applies to the
 *    parallel region (if it's NULL, we're not in a parallel region so
 *    we don't do any processing, we just search for such a par. region in
 *    the tree)
 *  construct_pragma_block_list : input : list of pragma blocks for all
 *    parallel constructs enclosing pu that can affect variable scopes.
 *  defsc : input : the kind of DEFAULT scope clause in par_pragma (we pass
 *    this around to avoid the need to recompute it); if
 *    WN_PRAGMA_DEFAULT_UNKNOWN, no default was specified so no scope
 *    pragmas are added for accessed variables
 ***********************************************************************/

static void
Apply_Par_Region_Default_Scopes(WN *wn, ST_TO_BOOL_HASH *processed,
                                WN *pragma_block,
                                WN_LIST *construct_pragma_block_list,
                                WN_PRAGMA_DEFAULT_KIND defsc)
{
  Is_True(wn, ("Apply_Par_Region_Default_Scopes(): NULL wn argument"));

  OPCODE opc = WN_opcode(wn);

  if (pragma_block) { // don't process vars outside a parallel region
    ST *var_st = Mem_Ref_To_Var(wn);

      // see if wn makes a mem ref to a symbol we haven't processed
    if (var_st && !processed->Find(ST_st_idx(var_st))) {
      SCOPE_RULE_KIND how;
      WN_PRAGMA_DEFAULT_KIND var_scope =
        Var_Scope(var_st, construct_pragma_block_list, &how);
      BOOL do_enter = TRUE;

        // shouldn't happen since pragma_block is a parallel region
      Is_True(var_scope != WN_PRAGMA_DEFAULT_UNKNOWN,
              ("impossible var_scope for parallel region"));

      if (ST_sclass(var_st) == SCLASS_AUTO &&
          (var_scope == WN_PRAGMA_DEFAULT_SHARED ||
           (var_scope == WN_PRAGMA_DEFAULT_PRIVATE &&
            how == BY_REDUCTION) ) ) {
          // Every auto ST with shared scope that's accessed in a parallel
          // region must have this bit set in the BE symbol table. Note that
          // the final result of a reduction is stored in a shared variable.
        Set_ST_is_shared_auto(*var_st);
      }

      if (!ST_is_temp_var(var_st)) {

          // apply default scoping rules to var_st, unless var_st is a
          // compiler-generated temp--in which case we assume scope is correct
        if (how == BY_DEFAULT_SHARED && defsc == WN_PRAGMA_DEFAULT_NONE) {
          if (ST_is_Index_Var_For_Enclosing_PDO(var_st, wn)) {
              // this use of var_st is OK, but an illegal use might follow
            do_enter = FALSE;
  
          } else if (!ST_Is_Const(var_st)) {
              // unscoped use in DEFAULT(NONE) parallel region
            ErrMsgLine(EC_MPLOWER_used_noscope, WN_Find_Linenum(pragma_block),
                 var_st);
    }
  
          // Apply DEFAULT clause to anything else.
        } else if (how == BY_DEFAULT_CLAUSE) {
          switch (var_scope) {
          case WN_PRAGMA_DEFAULT_SHARED:  // acknowledge SHARED pragma
            if (Get_Trace(TP_LNOPT2, TT_LNO_OMP_TRANSFORMS))
              printf("OMP_Prelower: found DEFAULT(SHARED) at line %d that "
                     "applies to %s due to use at line %d\n",
                     WN_Find_Linenum(pragma_block),
                   ST_name(var_st),
                   WN_Find_Linenum(wn));
            break;
          case WN_PRAGMA_DEFAULT_PRIVATE:
              // check if OMP rules prohibit privatization of this variable
            if (Can_Apply_Default_Private(var_st, pragma_block)) {
                // insert PRIVATE pragma for var_st
              WN *scope_prag = WN_CreatePragma(WN_PRAGMA_LOCAL, var_st, 0, 0);
              WN_set_pragma_compiler_generated(scope_prag);
  
              Set_Parent(scope_prag, pragma_block);
              WN_INSERT_BlockLast(pragma_block, scope_prag);
              if (Get_Trace(TP_LNOPT2, TT_LNO_OMP_TRANSFORMS))
                printf("OMP_Prelower: inserting PRIVATE(%s) clause for region "
                       "starting at line %d due to use at line %d\n",
                       ST_name(var_st),
                       WN_Find_Linenum(pragma_block),
                       WN_Find_Linenum(wn));
            }
            break;
          default:
            Is_True(0, ("invalid default scope"));
          } // switch (var_scope)
        } // else if (how == BY_DEFAULT_CLAUSE)

      } // if (!ST_is_temp_var(var_st))

      if (do_enter)
        processed->Enter(ST_st_idx(var_st), TRUE);
    }
  }

  BOOL is_worksharing;
  WN *pragma_block2 = Par_Region_Pragma_Block(wn, &is_worksharing);
  WN *worksharing_pragmas = (!pragma_block2 && is_worksharing) ?
    WN_region_pragmas(wn) : NULL;

    // push pragmas for non-combined worksharing construct
  if (worksharing_pragmas)
    construct_pragma_block_list->AddElement(worksharing_pragmas);

    // recursively process all children
  if (!OPCODE_is_leaf(opc)) { 
    if (opc == OPC_BLOCK) {
      for (WN *kid = WN_first(wn); kid; kid = WN_next(kid))
        Apply_Par_Region_Default_Scopes(kid, processed, pragma_block,
          construct_pragma_block_list, defsc);
    } else {
      for (INT kidno = 0; kidno < WN_kid_count(wn); kidno++) {
        WN *kid = WN_kid(wn, kidno);
        if (kid)
          Apply_Par_Region_Default_Scopes(kid, processed, pragma_block,
      construct_pragma_block_list, defsc);
      }
    }
  }

  if (worksharing_pragmas)
    construct_pragma_block_list->Decidx();

    // if wn is a parallel region different from the region to which
    // pragma_block applies, recurse indirectly to process wn's region
  if (pragma_block2 && pragma_block2 != pragma_block)
    Apply_Default_Scopes(wn, construct_pragma_block_list);
}


/***********************************************************************
 * Perform implicit privatization of Do loop index variables as specified
 * in the OMP document, and check that the final scopes computed for
 * all variables are reasonable.  This function must be called after
 * Apply_Default_Scopes().
 *
 * Perform these checks on final scopes: (1) THREADPRIVATE common blocks
 * and variables in them can't appear in any scope clauses; (2) FIRSTPRIVATE,
 * LASTPRIVATE and REDUCTION variables in a worksharing construct lexically 
 * enclosed by a parallel region must have shared scope in the parallel 
 * region.
 *
 * For a PRIVATE variable in a worksharing construct lexically enclosed by
 * a parall region, if it's not shared in that parallel region, just ignore
 * the inner PRIVATE clause. (Reprivatization is legal)
 *
 * As exceptions to the rule against reprivatization, we allow:
 *   (a) An implicit PRIVATE(i) on a parallel region that contains a PDO
 *       with a PRIVATE(i), if "i" is the PDO index variable (this can
 *       result from implicit privatization of PDO index variables).
 *   (b) If both the outer and inner pragmas are PRIVATE and compiler-
 *       generated. In this case we delete the inner PRIVATE. This can
 *       result from inlining.
 *       KEY: I don't see why the inner pragma also needs to be compiler-
 *            generated. bug 6428 shows why !compiler-generated is valid.
 *
 * Parameters:
 *  wn : in/out : Whirl tree in which to perform privatization
 *  pragma_block_list : in : list of blocks of pragmas of enclosing
 *    parallel regions; if empty, we're not inside a parallel region
 *  enclosing_pdo : in : pointer to pragma block for a PDO which encloses
 *    wn and is enclosed by the last element of pragma_block_list
 *  processed : in/out : set of symbols processed so far in the same scope
 *    as wn
 *  nested_par_regions : in/out : list of parallel regions reached so far
 *    that are at same nesting depth as wn
 *  top_of_construct : in : flag for whether wn is the root node of a PU
 *    or the statements block (top) for a parallel region.  If this is
 *    FALSE and wn is a parallel region, we just add wn to
 *    nested_par_regions and return; the nearest ancestor of wn that's a
 *    parallel region will later recurse into the body of wn.
 ***********************************************************************/

static void
Privatize_Index_Vars_And_Check_Final_Scopes(
    WN *wn, WN_LIST *pragma_block_list, WN *enclosing_pdo,
    ST_TO_BOOL_HASH *processed, WN_LIST *nested_par_regions,
    BOOL top_of_construct)
{
  Is_True(wn, ("Privatize_Index_Vars_And_Check_Final_Scopes(): "
               "NULL wn argument"));

  BOOL is_worksharing;
  WN *pragma_block = Par_Region_Pragma_Block(wn, &is_worksharing);
  BOOL is_par_region = (pragma_block != NULL);
  BOOL is_orphaned_pdo =
    (pragma_block_list->Elements() == 0 && enclosing_pdo);

    // check final scopes within parallel construct when we first reach
    // the construct
  if (is_worksharing || is_par_region) {
      // exception case (a) and (b) reprivatizing pragmas to be removed
    WN_LIST reprivatizing_pragmas(&omp_pool);

    for (WN *prag = WN_first(WN_region_pragmas(wn)); prag;
         prag = WN_next(prag)) {
      if (WN_opcode(prag) != OPC_PRAGMA)
        continue;

      SCOPE_RULE_KIND how;
      WN_PRAGMA_ID prag_id = (WN_PRAGMA_ID) WN_pragma(prag);
      ST *st = WN_st(prag);
      WN *scope_prag;

#ifndef KEY
        // PV 596988: check that no THREADPRIVATE variables appear in a
  // scope clause
      switch (prag_id) {
      case WN_PRAGMA_LOCAL:
      case WN_PRAGMA_LASTLOCAL:
      case WN_PRAGMA_FIRSTPRIVATE:
      case WN_PRAGMA_SHARED:
      case WN_PRAGMA_REDUCTION:
        {
    ST *split_blk;
          ST *common_blk = ST_Source_COMMON_Block(st, &split_blk);
          if (ST_is_thread_private(st) ||
        (split_blk && ST_is_thread_private(split_blk)) ||
              (common_blk && ST_is_thread_private(common_blk)))
            ErrMsgLine(EC_MPLOWER_thrpriv_scope, WN_Find_Linenum(wn), st);
  }
  break;
      default:
        break;
      }
#endif

      if (prag_id == WN_PRAGMA_REDUCTION &&
          pragma_block_list->Elements() == 0 && !is_par_region &&
          ST_sclass(st) == SCLASS_AUTO) {
          // PV 646575: reduction variables of an orphaned construct can't
          // be auto variables in the containing PU
        ErrMsgLine(EC_MPLOWER_red_of_private, WN_Find_Linenum(wn), st);
      }

      if (top_of_construct || !is_worksharing || is_par_region ||
          pragma_block_list->Elements() == 0)
          // not in an enclosed worksharing construct that isn't its own
          // parallel region (note that reprivatization within a nested
          // parallel region is OK: PV 626400)
        continue; // skip reprivatization checks

        // Check that REDUCTION and PRIVATE variables in an enclosed
  // worksharing construct are shared in enclosing parallel region.
  // Allow exception cases (a) and (b), described above.
      switch (prag_id) {
      case WN_PRAGMA_LOCAL:
      case WN_PRAGMA_LASTLOCAL:
      case WN_PRAGMA_FIRSTPRIVATE:
      case WN_PRAGMA_REDUCTION:
        if (Var_Scope(st, pragma_block_list, &how, &scope_prag) !=
            WN_PRAGMA_DEFAULT_PRIVATE)
          break;  // no reprivatization

        if (prag_id == WN_PRAGMA_LOCAL &&
            Index_Priv_From_OMPL->Find(scope_prag)) {
          reprivatizing_pragmas.AddElement(prag);
    break;  // exception case (a)
        }

  if (WN_pragma(scope_prag) == WN_PRAGMA_LOCAL &&
      prag_id == WN_PRAGMA_LOCAL &&
      WN_pragma_compiler_generated(scope_prag)
#ifndef KEY
      // bug 6428
      && WN_pragma_compiler_generated(prag)
#endif // !KEY
      )
        {
          reprivatizing_pragmas.AddElement(prag);
    break;  // exception case (b)
        }

        ErrMsgLine(prag_id == WN_PRAGMA_REDUCTION ?
                   EC_MPLOWER_red_of_private : EC_MPLOWER_reprivatization,
                   WN_Find_Linenum(wn), st);
        break;

      default:
        break;
      }
    } // for (WN *prag = ...)

      // remove reprivatizing pragmas
    for (INT i = 0; i < reprivatizing_pragmas.Elements(); i++) {
      Set_Parent(reprivatizing_pragmas[i], NULL);
      WN_DELETE_FromBlock(WN_region_pragmas(wn), reprivatizing_pragmas[i]);
    }
  }

  if (is_par_region && !top_of_construct) {
    if (WN_pragma_omp(WN_first(pragma_block)))
        // skip PCF regions, otherwise recurse later on into OMP regions
      nested_par_regions->AddElement(wn);
    return;
  }

/*
Privatize an index variable, if necessary.  Here are the rules:

1.  If a PARALLEL DO or PDO loop index is SHARED based on default rules, it
is made private on the PARALLEL DO or PDO (whether or not the PDO is
lexically within a PARALLEL region).  This privatization is not explicitly
required by the OMP spec., but it is how we cause the index to be a
"block-level entity within the DO loop"--which is required by the spec.

2.  If a sequential DO loop index within the lexical extent of a PARALLEL
region is SHARED based on default rules, the spec. requires that it be
privatized within the PARALLEL region.

Note that if a PARALLEL region has a PDO followed by a DO with the same
index variable, the index may be privatized on both the PARALLEL and PDO.
This reprivatization is safe.
*/

  if (WN_opcode(wn) == OPC_DO_LOOP &&
      (pragma_block_list->Elements() != 0 ||  // inside a parallel region
       is_orphaned_pdo)) {  // inside an orphaned PDO
    ST *index_st = WN_st(WN_index(wn));

      // only examine each index once per parallel region
    if (!processed->Find(ST_st_idx(index_st))) {
      SCOPE_RULE_KIND how;
      WN_PRAGMA_DEFAULT_KIND scope = WN_PRAGMA_DEFAULT_UNKNOWN;
      BOOL is_index_for_pdo = FALSE;

        // compute scope of index_st
      if (enclosing_pdo)
        scope = Var_Scope_In_Region(index_st, enclosing_pdo, &how);
      if (!is_orphaned_pdo) {
        if (scope == WN_PRAGMA_DEFAULT_UNKNOWN)
          scope = Var_Scope(index_st, pragma_block_list, &how);
      } else if (scope == WN_PRAGMA_DEFAULT_UNKNOWN) {
          // assume default of SHARED within orphaned PDO
        how = BY_DEFAULT_SHARED;
        scope = WN_PRAGMA_DEFAULT_SHARED;
      }
      Is_True(scope == WN_PRAGMA_DEFAULT_PRIVATE ||
              scope == WN_PRAGMA_DEFAULT_SHARED,
              ("impossible value %d for scope", (INT) scope));

      if (scope == WN_PRAGMA_DEFAULT_PRIVATE && how == BY_REDUCTION)
        ErrMsgLine(EC_MPLOWER_red_badop, WN_Find_Linenum(wn),
                   index_st);

      else if (scope == WN_PRAGMA_DEFAULT_SHARED &&
               how != BY_EXPLICIT_CLAUSE) {
          // index_st is shared by default rules

        if (enclosing_pdo) {
            // test if index_st is index for enclosing_pdo
          WN *grandparent = Get_Parent(Get_Parent(wn));
          Is_True(grandparent, ("no grandparent for wn"));

          if (WN_opcode(grandparent) == OPC_REGION &&
        WN_region_pragmas(grandparent) == enclosing_pdo)
            is_index_for_pdo = TRUE;

#ifdef Is_True_On
          if (is_index_for_pdo)
              // verify that wn is first DO loop in its block
            for (WN *prev = WN_prev(wn); prev; prev = WN_prev(prev))
              if (WN_opcode(prev) == OPC_DO_LOOP)
                Fail_FmtAssertion("multiple DO loops in block for PDO");
#endif
  }

  if (is_index_for_pdo || !is_orphaned_pdo) {
      // privatize index_st on appropriate construct
          WN *scope_prag = WN_CreatePragma(WN_PRAGMA_LOCAL, index_st, 0, 0);
          WN_set_pragma_compiler_generated(scope_prag);

          WN *privatization_region;
          if (!is_index_for_pdo || pragma_block_list->Elements() > 1)
              // privatize on outermost parallel region, otherwise
              // PRIVATE clause gets stripped by MP lowerer
            privatization_region = (*pragma_block_list)[0];
          else
            privatization_region = enclosing_pdo;

          if (Get_Trace(TP_LNOPT2, TT_LNO_OMP_TRANSFORMS)) {
            if (is_index_for_pdo) {
              char buff[128];

              if (privatization_region == enclosing_pdo)
                sprintf(buff, "parallel DO");
              else
                sprintf(buff, "PARALLEL region starting at line %d",
                        WN_Find_Linenum(privatization_region));

              printf("OMP_Prelower: index variable %s of parallel DO "
                     "at line %d privatized within %s\n",
                     ST_name(index_st),
                     WN_Find_Linenum(enclosing_pdo), buff);
            } else {
              WN *region_prag = WN_first((*pragma_block_list)
                                  [pragma_block_list->Lastidx()]);
              printf("OMP_Prelower: index variable %s of %s DO at "
                     "line %d privatized within PARALLEL region starting "
                     "at line %d\n",
                     ST_name(index_st),
                     (WN_pragma(region_prag) == WN_PRAGMA_PARALLEL_DO ?
                      "PARALLEL" : "sequential"),
                     WN_Find_Linenum(wn),
                     WN_Find_Linenum(privatization_region));
            }
          }
          Set_Parent(scope_prag, privatization_region);
          WN_INSERT_BlockLast(privatization_region, scope_prag);
          Index_Priv_From_OMPL->Enter(scope_prag, TRUE);
        }
      }

      if (!is_index_for_pdo)  // PDO index might be used later for a DO
        processed->Enter(ST_st_idx(index_st), TRUE); 
    }
  } else if (WN_opcode(wn) == OPC_REGION) {
    WN *first = WN_first(WN_region_pragmas(wn));

    if (first && WN_opcode(first) == OPC_PRAGMA &&
        WN_pragma(first) == WN_PRAGMA_PDO_BEGIN &&
  WN_pragma_arg1(first) == 0) {
      if (enclosing_pdo)
        Fail_FmtAssertion("Privatize_Index_Vars_And_Check_Final_Scopes(): "
                    "nested orphaned PDOs!");
      enclosing_pdo = WN_region_pragmas(wn);
    }
  }

    // Parent of children into which we recurse.  Normally we recurse into
    // the children of wn, but if wn's a PARALLEL region, we recurse
    // only into its pragmas (since they're evaluated in the current par.
    // region's scope).
  WN *recurse_parent = is_par_region ? WN_region_pragmas(wn) : wn;
  OPCODE rpar_opc = WN_opcode(recurse_parent);

    // recursively process all children of recurse_parent
  if (!OPCODE_is_leaf(rpar_opc)) { 
    if (rpar_opc == OPC_BLOCK) {
      for (WN *kid = WN_first(recurse_parent); kid; kid = WN_next(kid))
        Privatize_Index_Vars_And_Check_Final_Scopes(kid, pragma_block_list,
            is_par_region ? NULL : enclosing_pdo, processed,
      nested_par_regions, FALSE);
    } else {
      for (INT kidno = 0; kidno < WN_kid_count(recurse_parent); kidno++) {
        WN *kid = WN_kid(recurse_parent, kidno);
        if (kid)
          Privatize_Index_Vars_And_Check_Final_Scopes(kid, pragma_block_list,
              is_par_region ? NULL : enclosing_pdo, processed,
        nested_par_regions, FALSE);
      }
    }
  }

    // If wn is atop a par. region or PU, recurse into the bodies of all of
    // the par. regions nested within it.
  if (top_of_construct) {
    for (INT i = 0; i < nested_par_regions->Elements(); i++) {
      WN *np = (*nested_par_regions)[i];  // the nested par. region
        // initially-empty processed vars
      ST_TO_BOOL_HASH processed_set(NUM_HASH_ELEMENTS, &omp_pool);
      WN_LIST nested_set(&omp_pool);  // initially-empty nested par. regions

        // add to list of pragmas that apply within np's scope
      pragma_block_list->AddElement(WN_region_pragmas(np));

        // only recurse into the body of np, we've already done its pragmas
      Privatize_Index_Vars_And_Check_Final_Scopes(WN_region_body(np),
          pragma_block_list, NULL, &processed_set, &nested_set, TRUE);

      pragma_block_list->Decidx();  // back to same scope as wn
    }

  }
} // Privatize_Index_Vars_And_Check_Final_Scopes


/***********************************************************************
 * Search for a valid line number to which wn corresponds.
 ***********************************************************************/

static mINT32 WN_Find_Linenum(WN *wn)
{
  Is_True(wn, ("WN_Find_Linenum(): NULL wn argument"));

  mINT32 wn_ln = WN_Get_Linenum(wn);

  if (wn_ln != 0)
    return wn_ln; // wn has a valid line number already

  WN *parent = Get_Parent(wn);

  if (wn)
    return WN_Find_Linenum(parent); // search up WHIRL tree for valid number
  else
    return 0; // we're atop the tree, there's no number, so give up
}


/***********************************************************************
 * Perform one-time initializations of omp-lowering.
 ***********************************************************************/

static void OMP_File_Init()
{
  MEM_POOL_Initialize(&omp_pool, "OMP Lowering Pool", FALSE);
  MEM_POOL_Initialize(&Omp_Local_Pool, "OMP Local Lowering Pool", FALSE);
}


/***********************************************************************
 * Given a PU, set up the corresponding map of parent pointers.
 ***********************************************************************/

static void Parentize (WN* wn)
{
  if (!OPCODE_is_leaf(WN_opcode(wn))) { 
    if (WN_opcode(wn) == OPC_BLOCK) {
      WN *kid = WN_first(wn);
      while (kid) {
        Set_Parent(kid, wn);
        Parentize(kid);
        kid = WN_next(kid);
      }
    } else {
      INT kidno;
      for (kidno = 0; kidno < WN_kid_count(wn); kidno++) {
        WN *kid = WN_kid(wn, kidno);
        if (kid) { 
          Set_Parent(kid, wn);
          Parentize(kid);
        }
      }
    }
  }
}

// Look for an ldid of the return reg in one of the statements
// following wn
static WN *Find_Return_Use(ST *st, PREG_NUM preg, WN *wn)
{
  OPCODE opc = WN_opcode(wn);
  if (OPCODE_operator(opc) == OPR_LDID &&
      WN_st(wn) == st &&
      WN_offset(wn) == preg) {
    return wn;
  }
  Is_True(!OPCODE_is_scf(opc),("Return register not next to call "));
  for (INT kidno=0; kidno<WN_kid_count(wn); kidno++) {
    WN *tmp=Find_Return_Use(st,preg,WN_kid(wn,kidno));
    if (tmp) return tmp;
  }
  if (OPCODE_has_next_prev(opc) && WN_next(wn)) {
    return Find_Return_Use(st,preg,WN_next(wn));
  }
  return NULL;
}





// convert unsupported fetch and op intrinsics into
// atomic and then lower the atomic
static void Lower_Fetch_And_Op(WN *intrinsic)
{
  WN *parent = Get_Parent(intrinsic);
  BOOL return_new_val;
  OPCODE atomic_op;
  switch (WN_intrinsic(intrinsic)) {
    case INTRN_MPY_AND_FETCH_I4: 
      return_new_val = TRUE;
      atomic_op = OPC_I4MPY;
      break;
    case INTRN_MIN_AND_FETCH_I4:
      return_new_val = TRUE;
      atomic_op = OPC_I4MIN;
      break;
    case INTRN_MAX_AND_FETCH_I4:
      return_new_val = TRUE;
      atomic_op = OPC_I4MAX;
      break;
    case INTRN_MPY_AND_FETCH_I8: 
      return_new_val = TRUE;
      atomic_op = OPC_I8MPY;
      break;
    case INTRN_MIN_AND_FETCH_I8:
      return_new_val = TRUE;
      atomic_op = OPC_I8MIN;
      break;
    case INTRN_MAX_AND_FETCH_I8:
      return_new_val = TRUE;
      atomic_op = OPC_I8MAX;
      break;
    case INTRN_ADD_AND_FETCH_F4: 
      return_new_val = TRUE;
      atomic_op = OPC_F4ADD;
      break;
    case INTRN_SUB_AND_FETCH_F4:
      return_new_val = TRUE;
      atomic_op = OPC_F4SUB;
      break;
    case INTRN_MPY_AND_FETCH_F4: 
      return_new_val = TRUE;
      atomic_op = OPC_F4MPY;
      break;
    case INTRN_MIN_AND_FETCH_F4:
      return_new_val = TRUE;
      atomic_op = OPC_F4MIN;
      break;
    case INTRN_MAX_AND_FETCH_F4:
      return_new_val = TRUE;
      atomic_op = OPC_F4MAX;
      break;
    case INTRN_ADD_AND_FETCH_F8: 
      return_new_val = TRUE;
      atomic_op = OPC_F8ADD;
      break;
    case INTRN_SUB_AND_FETCH_F8:
      return_new_val = TRUE;
      atomic_op = OPC_F8SUB;
      break;
    case INTRN_MPY_AND_FETCH_F8: 
      return_new_val = TRUE;
      atomic_op = OPC_F8MPY;
      break;
    case INTRN_MIN_AND_FETCH_F8:
      return_new_val = TRUE;
      atomic_op = OPC_F8MIN;
      break;
    case INTRN_MAX_AND_FETCH_F8:
      return_new_val = TRUE;
      atomic_op = OPC_F8MAX;
      break;

    case INTRN_FETCH_AND_MPY_I4: 
      return_new_val = FALSE;
      atomic_op = OPC_I4MPY;
      break;
    case INTRN_FETCH_AND_MIN_I4:
      return_new_val = FALSE;
      atomic_op = OPC_I4MIN;
      break;
    case INTRN_FETCH_AND_MAX_I4:
      return_new_val = FALSE;
      atomic_op = OPC_I4MAX;
      break;
    case INTRN_FETCH_AND_MPY_I8: 
      return_new_val = FALSE;
      atomic_op = OPC_I8MPY;
      break;
    case INTRN_FETCH_AND_MIN_I8:
      return_new_val = FALSE;
      atomic_op = OPC_I8MIN;
      break;
    case INTRN_FETCH_AND_MAX_I8:
      return_new_val = FALSE;
      atomic_op = OPC_I8MAX;
      break;
    case INTRN_FETCH_AND_ADD_F4: 
      return_new_val = FALSE;
      atomic_op = OPC_F4ADD;
      break;
    case INTRN_FETCH_AND_SUB_F4:
      return_new_val = FALSE;
      atomic_op = OPC_F4SUB;
      break;
    case INTRN_FETCH_AND_MPY_F4: 
      return_new_val = FALSE;
      atomic_op = OPC_F4MPY;
      break;
    case INTRN_FETCH_AND_MIN_F4:
      return_new_val = FALSE;
      atomic_op = OPC_F4MIN;
      break;
    case INTRN_FETCH_AND_MAX_F4:
      return_new_val = FALSE;
      atomic_op = OPC_F4MAX;
      break;
    case INTRN_FETCH_AND_ADD_F8: 
      return_new_val = FALSE;
      atomic_op = OPC_F8ADD;
      break;
    case INTRN_FETCH_AND_SUB_F8:
      return_new_val = FALSE;
      atomic_op = OPC_F8SUB;
      break;
    case INTRN_FETCH_AND_MPY_F8: 
      return_new_val = FALSE;
      atomic_op = OPC_F8MPY;
      break;
    case INTRN_FETCH_AND_MIN_F8:
      return_new_val = FALSE;
      atomic_op = OPC_F8MIN;
      break;
    case INTRN_FETCH_AND_MAX_F8:
      return_new_val = FALSE;
      atomic_op = OPC_F8MAX;
      break;
    default:
      return ;
  }

  // Now we know that we need to do an atomic
  WN *var = WN_kid0(WN_kid0(intrinsic));
  TYPE_ID type = OPCODE_rtype(atomic_op);

  ST *return_st = Create_Local_Symbol("return_val",type);

  WN *atomic_pragma = WN_CreatePragma(WN_PRAGMA_ATOMIC, (ST*) 0, 0, 0);
#ifndef BUILD_SKIP_PROMPF
  if (Prompf_Info != NULL && Prompf_Info->Is_Enabled()) {
    INT new_id = New_Construct_Id();
    WN_MAP32_Set(Prompf_Id_Map, atomic_pragma, new_id);
    PROMPF_LINES* pl = CXX_NEW(PROMPF_LINES(&PROMPF_pool), &PROMPF_pool);
    pl->Add_Lines(intrinsic);
    Prompf_Info->OMPL_Fetchop_Atomic(new_id, pl);
  }
#endif
  WN_set_pragma_omp(atomic_pragma);
  WN_INSERT_BlockBefore(parent,intrinsic,atomic_pragma);
  Set_Parent(atomic_pragma,parent);
  WN_Set_Linenum(atomic_pragma,WN_Get_Linenum(intrinsic));

  // Assuming fetch_...(x,y)
  // Generate x = x op y
  WN *expr = WN_COPY_Tree(WN_kid0(WN_kid1(intrinsic)));
  WN *load_var;
  WN *store_var;
  if (WN_operator(var) == OPR_LDA) {
    load_var = WN_CreateLdid (OPCODE_make_op(OPR_LDID, type, type),
      WN_offset(var),WN_st(var), Be_Type_Tbl(type));
    store_var = WN_CreateStid(OPCODE_make_op(OPR_STID,MTYPE_V,type),
      WN_offset(var),WN_st(var),Be_Type_Tbl(type),
      WN_CreateExp2(atomic_op,load_var,expr));
  } else {
    OPCODE load_opc = OPCODE_make_op(OPR_ILOAD,type,type);
    load_var = WN_CreateIload(load_opc, WN_offset(var),
      Be_Type_Tbl(type),
      Make_Pointer_Type(Be_Type_Tbl(type),FALSE),
      WN_COPY_Tree(var));
    store_var = WN_CreateIstore(OPCODE_make_op(OPR_ISTORE,MTYPE_V,type),
      WN_offset(var),
      Make_Pointer_Type(Be_Type_Tbl(type),FALSE),
      WN_CreateExp2(atomic_op,load_var,expr),
      WN_COPY_Tree(var));

  }
  Parentize(store_var);
  WN_INSERT_BlockBefore(parent,intrinsic,store_var);
  Set_Parent(store_var,parent);
  WN_Set_Linenum(store_var,WN_Get_Linenum(intrinsic));

  // Replace the use of the return register with the
  // return value

  PREG_NUM rreg1, rreg2;
  ST* rst = Find_Return_Registers (type, &rreg1, &rreg2);
  FmtAssert(rreg1 != 0 && rreg2 == 0, ("Bad pointer type ret regs"));
  WN *return_use = Find_Return_Use(rst,rreg1,WN_next(intrinsic));
  Is_True(return_use,("Couldn't find return register "));
  WN *return_parent = Get_Parent(return_use);
  INT return_kidno=0;
  while (WN_kid(return_parent,return_kidno) != return_use) return_kidno++;
  WN_Delete(return_use);

  WN_kid(return_parent,return_kidno) = 
    WN_CreateLdid (OPCODE_make_op(OPR_LDID, type, type),
      0, return_st, Be_Type_Tbl(type));

  Update_Private(return_st,return_parent);

  // Delete the intrinsic
  WN_Delete(WN_EXTRACT_FromBlock(Get_Parent(intrinsic),intrinsic));

  // Lower the atomic
  WN *store = WN_next(atomic_pragma);
  WN *atomic_block = return_new_val ?
    Atomic_Using_Swap(atomic_pragma, store, WN_kid0(store), parent,
                      Update_Private, NULL, return_st) :
    Atomic_Using_Swap(atomic_pragma, store, WN_kid0(store), parent,
                      Update_Private, return_st, NULL);
  Insert_Lowered_Atomic(parent, atomic_pragma, atomic_block, ALCLASS_SWAP);
}

---