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

/*

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

   Path64 is free software; you can redistribute it and/or modify it
   under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   Path64 is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
   License for more details.

   You should have received a copy of the GNU General Public License
   along with Path64; see the file COPYING.  If not, write to the Free
   Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
   02110-1301, USA.

   Special thanks goes to SGI for their continued support to open source

*/


// ====================================================================
// ====================================================================
//
// Module: dra_clone.cxx
//
// Revision history:
//  16-Jul-96: Original Version
//
// Description:
//  Routines used in cloning of subroutines based on
//  the distribution of reshaped array arguments.
//
// ====================================================================
// ====================================================================

#define ONST(x, y) (y)

#define __STDC_LIMIT_MACROS
#if HAVE_ALLOCA_H
#include <alloca.h>             // alloca
#endif
#include <unistd.h>             // write
#include <stdint.h>

#include "pu_info.h"            // PU_Info

#include "defs.h"               // Standard definitions
#include "wn.h"                 // WN
#include "wn_map.h"             // Current_Map_Tab
#include "wn_util.h"            // WN_INSERT_BlockAfter
#include "symtab.h"
#include "strtab.h"             // Save_Str
#include "mempool.h"             // MEM_POOL
#include "cxx_memory.h"         // CXX_NEW
#include "erbe.h"               // EC_*
#include "be_errors.h"          // ErrMsg, ErrMsgSrcpos
#include "dwarf_DST_mem.h"      // DST_IDX
#include "clone.h"              // IPO_CLONE
#include "clone_DST_utils.h"    // DST_enter_cloned_subroutine
#include "dra_demangle.h"       // DRA_Demangle

#include "dra_internal.h"       // Internal DRA interface



// =====================================================================
// 
//                      Local function prototypes
//
// =====================================================================

static BOOL DRA_Clone_Initialize(void);

static BOOL DRA_Process_Requests(char *tir_names);

static BOOL DRA_Parse_Clone_Name(char *clone_name);

static void DRA_Clone_Instantiate(PU_Info *orig_pu,
                                  BOOL pu_has_feedback,
                                  STRING_LIST *tir_list,
                                  DRA_HASH_TABLE *dra_table);

static char* DRA_New_Clone_Sig(WN *pu_wn,
                               char *clone_name,
                               DRA_HASH_TABLE *dra_table);

static void DRA_Add_Clone (PU_Info *orig_pu, 
                           MEM_POOL *mem_pool,
                           STR_IDX clone_name,
                           char *arg_sig,
                           BOOL pu_has_feedback);

static void DRA_Insert_Pragmas(WN *pu_wn,
                               char *arg_sig);

static void DRA_Process_Commons(DRA_HASH_TABLE *dra_table,
                                DRA_COMMON_HASH_TABLE*);

static void DRA_Collect_Commons(WN *pu,
                                DRA_COMMON_HASH_TABLE *dra_common_ht);

static void DRA_Process_Globals(DRA_HASH_TABLE *dra_table);

static BOOL DRA_Info_Matches_Encoding(DRA_INFO *dra, 
                                      char *arg_sig);

// ===================================================================== 
// 
//                          Exported variables
//
// =====================================================================

BOOL Run_Dsm_Cloner = FALSE;

BOOL Run_Dsm_Common_Check = FALSE;

BOOL Run_Dsm_Check = FALSE;

NAME_ST_TABLE *DRA_func_table = NULL;

MEM_POOL DRA_name_pool, *DRA_name_pool_ptr = NULL;

DRA_GLOBAL_HASH_TABLE* dra_global = NULL;

// ===================================================================== 
// 
//                      File static variables
//
// =====================================================================

static STRING_LIST_TABLE *DRA_clone_table;

static MEM_POOL DRA_clone_pool, *DRA_clone_pool_ptr = NULL;

static MEM_POOL DRA_check_pool, *DRA_check_pool_ptr = NULL;


// =====================================================================
// 
//                      Exported function definitions
//
// =====================================================================


// =====================================================================
//
// Function Name: Get_Orig_Type
//
// Description: Given an ST return the ST_type it originally had.
//      Same as ST_type, except when called on reshaped globals 
//      whose type has been mangled.
//
// =====================================================================

extern TY_IDX DRA_Get_Original_Type (ST* st) {

  TY_IDX ty;

  if (ST_class(st) != CLASS_VAR) return ST_type(st);

  if (ONST(ST_is_global(st),ST_level(st) == GLOBAL_SYMTAB) &&
      ST_is_reshaped(st)) {

    DRA_GLOBAL_INFO* dgi = dra_global->Find(st);

    if (dgi) {
      // has been seen before
      ty = dgi->Get_TY();
    }
    else {
      // seeing it for the first time
      ty = ST_type(st);
      DRA_GLOBAL_INFO* dgi = CXX_NEW (DRA_GLOBAL_INFO(ty), Malloc_Mem_Pool);
      dra_global->Enter (st, dgi);
    }
  }
  else {
    ty = ST_type(st);
  }
  return ty;
}

// =====================================================================
//
// Function Name: DRA_Get_Array_Type
//
// Description: Given the ST for a distributed array, return the array TY.
//
// =====================================================================

extern TY_IDX DRA_Get_Array_Type (ST* st) {

  TY_IDX ty;

  ty = DRA_Get_Original_Type (st);

  if (TY_kind(ty) == KIND_POINTER &&
      (ST_sclass(st) == SCLASS_FORMAL ||
       ST_sclass(st) == SCLASS_AUTO ||
       (ONST(ST_sclass(st)==SCLASS_BASED, ST_base_idx(st)==ST_st_idx(st)) &&
        ST_sclass(ST_base(st)) == SCLASS_AUTO))) {
    ty = TY_pointed(ty);
  }

  return ty;
}


extern "C" void
DRA_Initialize(void)
{
  DRA_Open_And_Map_File();

  if (Run_Dsm_Cloner && DRA_Clone_Initialize()) {
    Set_FILE_INFO_needs_lno (File_info);
  }

  if (Run_Dsm_Common_Check) {
    MEM_POOL_Initialize (&DRA_check_pool, "DRA Common Check", TRUE);
    DRA_check_pool_ptr = &DRA_check_pool;
    DRA_Set_Write_Location();
  }

  if (Run_Dsm_Check) {
    DRA_EC_Declare_Types();
  }

  // information about globals must survive PUs
  dra_global = CXX_NEW (DRA_GLOBAL_HASH_TABLE(20, Malloc_Mem_Pool),
                        Malloc_Mem_Pool);
}




// =====================================================================
//
// Function Name: DRA_Finalize
//
// Description: Pop and Delete DRA_clone_pool if necessary
//
// =====================================================================

extern "C" void
DRA_Finalize (void)
{
  ST *st;

  // delete info about distributed globals
  //
  {
    HASH_TABLE_ITER<ST*, DRA_GLOBAL_INFO*> iter (dra_global);
    ST* st;
    DRA_GLOBAL_INFO* dgi;
    while (iter.Step (&st, &dgi)) {
      CXX_DELETE (dgi, Malloc_Mem_Pool);
    }
    CXX_DELETE (dra_global, Malloc_Mem_Pool);
    dra_global = NULL;
  }

  // Make the symbols that are not used invisible
  //
  INT i;
  FOREACH_SYMBOL (GLOBAL_SYMTAB, st, i) {
    if (ST_is_not_used(st) &&
        ST_class(st) == CLASS_FUNC &&
        ST_sclass(st) == SCLASS_EXTERN &&
        !PU_has_non_mangled_call(Pu_Table[ST_pu(*st)])) {
      Set_ST_export(st, EXPORT_LOCAL);
      Set_ST_sclass(st, SCLASS_TEXT);
    }
  }

  // Emit type 'N' symbols for all cloned functions 
  // that are referenced in the same file
  //
  if (DRA_func_table != NULL) {

    NAME_ST_TABLE_ITER iter(DRA_func_table);
    STR_IDX func_name;
    MANGLED_FUNC *func_desc;

    while (iter.Step(&func_name, &func_desc)) {

      if (func_desc->is_clone && func_desc->is_called) {
        ST* aux_st = New_ST (GLOBAL_SYMTAB);
        ST_Init (aux_st,
                 func_name,
                 CLASS_NAME,
                 SCLASS_UNKNOWN,
                 EXPORT_LOCAL,
                 (TY_IDX) NULL);
        Set_ST_is_not_used(aux_st);
        Set_ST_emit_symbol(aux_st);
      }
    }
  }

  if (DRA_clone_pool_ptr != NULL) {
    MEM_POOL_Pop (DRA_clone_pool_ptr);
    MEM_POOL_Delete (DRA_clone_pool_ptr);
    DRA_clone_pool_ptr = NULL;
  }

  if (DRA_check_pool_ptr != NULL) {
    MEM_POOL_Delete (DRA_check_pool_ptr);
    DRA_check_pool_ptr = NULL;
  }
  
  DRA_Close_File();
}




// =====================================================================
//
// Function Name: DRA_Processing
//
// Description: Main driver for DRA related tasks - reading pragmas,
//              cloning, name mangling, and common block processing
//
// =====================================================================

extern "C" void
DRA_Processing(PU_Info *pu_info,
               WN* pu,
               BOOL pu_has_feedback)
{
  STRING_LIST *clone_requests = NULL;
  DRA_HASH_TABLE *dra_table = NULL;

  Set_Error_Phase("DRA Processing");

  if (Run_Dsm_Cloner) {
    clone_requests = DRA_clone_table->Find(ST_name_idx(WN_st(pu)));
  }

  if (clone_requests != NULL ||                 // we need to clone
      Run_Dsm_Common_Check   ||                 // we need to process commons
      ONST(SYMTAB_mp_needs_lno(Current_Symtab), // we need to mangle names
           PU_mp_needs_lno (Get_Current_PU()))) {

    // Initialize and push DRA_name_pool to be used for DRA_HASH_TABLE
    //
    DRA_name_pool_ptr = &DRA_name_pool;
    MEM_POOL_Initialize (DRA_name_pool_ptr, "DRA Names", FALSE);
    MEM_POOL_Push (DRA_name_pool_ptr);

    // Create dra_table that stores the info about all DRA's
    //
    dra_table = CXX_NEW(DRA_HASH_TABLE(31, DRA_name_pool_ptr), 
                        DRA_name_pool_ptr);

    DRA_Read_Pragmas(pu, dra_table);
  }
  
  if (clone_requests != NULL) {
    DRA_Clone_Instantiate(pu_info, pu_has_feedback, clone_requests, dra_table);
  }
      
  if (Run_Dsm_Common_Check) {
    MEM_POOL_Push (DRA_check_pool_ptr);
    DRA_COMMON_HASH_TABLE
      *dra_common_ht = CXX_NEW (DRA_COMMON_HASH_TABLE(20, DRA_check_pool_ptr),
                                DRA_check_pool_ptr);

    DRA_Collect_Commons(pu, dra_common_ht);
    DRA_Process_Commons(dra_table, dra_common_ht);

    CXX_DELETE (dra_common_ht, DRA_check_pool_ptr);
    MEM_POOL_Pop (DRA_check_pool_ptr);

    // Also write out information about globals (C, C++) into rii_file
    //
    DRA_Process_Globals(dra_table);
  }

  if (dra_table->Num_Entries() > 0) {
    DRA_Mangle_All(pu, dra_table, pu_info);   
    Set_PU_no_inline(Pu_Table[ST_pu(WN_st(pu))]);
  }
  else {
    Set_PU_has_non_mangled_call(Pu_Table[ST_pu(WN_st(pu))]);
    Clear_ST_is_not_used(WN_st(pu));
  }

  if (Run_Dsm_Check) {
    DRA_EC_Array_Portion_Parms(pu, pu);
    
    if (ONST(SYMTAB_has_altentry(Current_Symtab),
             PU_has_altentry (Get_Current_PU()))) {
      // Walk the tree and process alternate entry points
      //
      WN_ITER *wni;
      for (wni = WN_WALK_TreeIter(pu); wni; wni = WN_WALK_TreeNext(wni)) {
        if (WN_opcode(WN_ITER_wn(wni)) == OPC_ALTENTRY) {
          DRA_EC_Array_Portion_Parms(pu, WN_ITER_wn(wni));
        }
      } 
    }
  }
  
  // Pop and Delete DRA_name_pool
  //
  if (DRA_name_pool_ptr != NULL) {
    MEM_POOL_Pop (DRA_name_pool_ptr);
    MEM_POOL_Delete (DRA_name_pool_ptr);
    DRA_name_pool_ptr = NULL;
  }
}



  
// =====================================================================
// 
//                      Local function definitions
//
// =====================================================================


// =====================================================================
//
// Function Name: DRA_Clone_Initialize
//
// Description: Process .rii file and return TRUE if Template
//              Instatiation Requests (TIR's) have been found.
//
// =====================================================================

static BOOL 
DRA_Clone_Initialize(void)
{
  // Initialize DRA_clone_pool to be used for cloning
  // This MEM_POOL lives throughout the compilation of the file
  //
  MEM_POOL_Initialize (&DRA_clone_pool, "DRA Cloning", TRUE);
  DRA_clone_pool_ptr = &DRA_clone_pool;
  MEM_POOL_Push (DRA_clone_pool_ptr);
  
  // From now on use DRA_file_mmap as a normal memory pointer
  //
  char *tir_names = strstr(DRA_file_mmap, DRA_FILE_SEPARATOR)
                  + strlen(DRA_FILE_SEPARATOR);

  // Allocate the TIR name table
  // Use DRA_clone_pool because the table must live across all PU's
  //
  DRA_clone_table = CXX_NEW(STRING_LIST_TABLE(31, DRA_clone_pool_ptr), 
                            DRA_clone_pool_ptr);

  // and store all TIR names in it
  //
  BOOL needs_cloning = DRA_Process_Requests(tir_names);

  // Allocate the global name/ST hash table used for resolving names
  //
  if (DRA_func_table == NULL) {
    DRA_func_table = CXX_NEW(NAME_ST_TABLE(31, &MEM_src_pool), 
                             &MEM_src_pool);
  }

  DRA_Mem_Unmap_File();

  return needs_cloning;
}


  

// =====================================================================
//
// Function Name: DRA_Process_Requests
//
// Description: Read the TIR names from .rii file and store them
//              into a hash table. Keys are the original names of
//              functions, while the entries represent linked lists
//              of the names that need to be instantiated.
//
// =====================================================================

static BOOL
DRA_Process_Requests(char *tir_name)
{
  BOOL needs_cloning = FALSE;
  
  // Replace "----" with the string terminator '\0'
  //
  char *end_tir_names = strstr(tir_name, DRA_FILE_SEPARATOR);
  if (end_tir_names != NULL) {
    *end_tir_names = '\0';
  }


  char *end_of_line;
  for ( ; *tir_name; *end_of_line = '\n', tir_name = end_of_line+1) {
    
    // find the of the line
    //
    if ((end_of_line = strchr(tir_name, '\n')) == NULL) {
      break;
    }

    // replace eol with the string terminator
    //
    *end_of_line = '\0';

    // Parse tir_name for correctness
    //
    if (!DRA_Parse_Clone_Name(tir_name)) {
      (void) unlink(DRA_file_name);
      ErrMsg(EC_DRA_rii_file_format, DRA_file_name);
      return FALSE;
    }

    char *orig_name = tir_name + DRA_MANGLE_SIG_LEN;
    char *postfix_sig = strstr(orig_name, DRA_MANGLE_SIG);

    STR_IDX save_tir_name = Save_Str(tir_name);

    *postfix_sig = '\0';

    STR_IDX save_orig_name = Save_Str(orig_name);

    // restore original contents of overwritten location
    //
    *postfix_sig = DRA_MANGLE_SIG[0];


    // Get the list of TIR's corresponding to the original function
    //
    STRING_LIST *tir_list = DRA_clone_table->Find(save_orig_name);

    // If it has been created, do it now
    //
    if (tir_list == NULL) { 
      tir_list = CXX_NEW(STRING_LIST(), DRA_clone_pool_ptr);
      DRA_clone_table->Enter(save_orig_name, tir_list);
    }

    // Add the tir name to the list
    //
    STRING_NODE *tir_node = 
      CXX_NEW(STRING_NODE(save_tir_name), DRA_clone_pool_ptr);
    tir_list->Append(tir_node);

    needs_cloning = TRUE;
  }


  // restore original contents of overwritten locations
  //
  if (end_tir_names != NULL) {
    *end_tir_names = DRA_FILE_SEPARATOR[0];
  }
  
  return needs_cloning;
}




// =====================================================================
//
// Function Name: DRA_Parse_Clone_Name
//
// Description: Parse the name read from .rii file to make sure
//              it can be used to generate meaningful pragmas,
//
// =====================================================================

static BOOL
DRA_Parse_Clone_Name(char *clone_name)
{
  // Check for DRA mangling prefix
  //
  if (strncmp(clone_name, DRA_MANGLE_SIG, DRA_MANGLE_SIG_LEN) != 0)
    return FALSE;
    
  char *arg_sig = strstr(clone_name + DRA_MANGLE_SIG_LEN, DRA_MANGLE_SIG);
  
  // Check for DRA mangling suffix
  //
  if (arg_sig == NULL || *(arg_sig += DRA_MANGLE_SIG_LEN) == 0)
    return FALSE;


  // Check the parameter list
  //
  for ( ; *arg_sig; ) {
    
    char *current;

    // Check number of dimensions:
    // INT16; non-negative; if 0, it must be followed by _
    //
    INT64 num_dims = (INT64) strtol(arg_sig, &current, 10);

    if (current == arg_sig) 
      return FALSE;

    if (num_dims == 0) {
      if (*current++ != DRA_ARG_SEPARATOR)
        return FALSE;
      else {
        arg_sig = current;
        continue;
      }
    }
      
    if (num_dims < 0 || num_dims > INT16_MAX)
      return FALSE;

    // Check array element size:
    // INT64; positive; must be surrounded by D and E
    //
    if (*current++ != DRA_NDIMS_END)
      return FALSE;

    arg_sig = current;
    
    INT64 esize = (INT64) strtol(arg_sig, &current, 10);
    
    if (current == arg_sig || esize <= 0 || *current++ != DRA_ESIZE_END)
      return FALSE;
    
    arg_sig = current;
    
    // Check distributions in all dimensions:
    // B, C, or S; C may be followed by a positive INT64
    //
    for (INT16 dim = 0; dim < num_dims; dim++) {

      if (*arg_sig == DRA_BLOCK_CODE || *arg_sig == DRA_STAR_CODE) {
        arg_sig++;
        continue;
      }
      
      else if (*arg_sig == DRA_CYCLIC_CODE) {
        
        if (arg_sig[1] == DRA_BLOCK_CODE || 
            arg_sig[1] == DRA_STAR_CODE || 
            arg_sig[1] == DRA_CYCLIC_CODE ||
            (arg_sig[1] == DRA_ARG_SEPARATOR && dim == num_dims-1)) {
          arg_sig++;
          continue;
        }
        
        arg_sig++;

        INT64 chunk = (INT64) strtol(arg_sig, &current, 10);
        
        if (current == arg_sig || chunk <= 0)
          return FALSE;
    
        arg_sig = current;
      }
      
      else 
        return FALSE;
    }

    if (*arg_sig++ != DRA_ARG_SEPARATOR)
      return FALSE;
  }

  return TRUE;
}




// =====================================================================
//
// Function Name: DRA_Clone_Instantiate
//
// Description: Instantiate all the clones found in the TIR table
//              that correspond to the passed PU.
//
// =====================================================================

static void 
DRA_Clone_Instantiate(PU_Info *orig_pu,
                      BOOL pu_has_feedback,
                      STRING_LIST *tir_list,
                      DRA_HASH_TABLE *dra_table)
{
  // The cloner cannot handle routines with alternate entry points
  // 
  if (ONST(SYMTAB_has_altentry(Current_Symtab),
           PU_has_altentry(Get_Current_PU()))) {
    ErrMsgSrcpos(EC_DRA_clone_altentry, 
                 WN_Get_Linenum(PU_Info_tree_ptr(orig_pu)));
    return;
  }
  
  // Iterate over the string list
  //
  STRING_ITER tir_iter(tir_list);
  STRING_NODE *n;

  for (n = tir_iter.First(); !tir_iter.Is_Empty(); n = tir_iter.Next()) {

    STR_IDX clone_name = n->String();

    // Get clone argument signature that ignores formal parameters
    // that already have DISTRIBUTE_RESHAPE specification.
    //
    char *arg_sig = DRA_New_Clone_Sig(PU_Info_tree_ptr(orig_pu), 
                                      Index_To_Str(clone_name), 
                                      dra_table);

    // NULL signature is used to flag inconsistent cloning requests
    //
    if (arg_sig != NULL) {
      DRA_Add_Clone(orig_pu, 
                    DRA_clone_pool_ptr, 
                    clone_name, 
                    arg_sig,
                    pu_has_feedback);
    }
  }
}




// =====================================================================
//
// Function Name: DRA_New_Clone_Sig
//
// Description: Given a PU and an instantiation request, return the 
//              clone argument signature that ignores formal parameters 
//              that already have DISTRIBUTE_RESHAPE directive. In case
//              of errors, return NULL.
//
// =====================================================================

static char* 
DRA_New_Clone_Sig(WN *pu_wn,
                  char *clone_name,
                  DRA_HASH_TABLE *dra_table)
{
  Set_Error_Phase("Instantiating DRA Clones");

  FmtAssert(strncmp(clone_name, DRA_MANGLE_SIG, DRA_MANGLE_SIG_LEN) == 0,
            ("The name of a DRA clone does not have DRA_MANGLE_SIG prefix"));
    
  char *arg_sig = strstr(clone_name + DRA_MANGLE_SIG_LEN, DRA_MANGLE_SIG);
  
  FmtAssert(arg_sig != NULL,
            ("The name of a DRA clone does not have DRA_MANGLE_SIG postfix"));

  arg_sig += DRA_MANGLE_SIG_LEN;

  char *buf = CXX_NEW_ARRAY(char, strlen(arg_sig)+1, DRA_name_pool_ptr);
  char *bufptr = buf;

  char *dim_sig;


  INT16 arg_pos;
  for ( arg_pos = 0; *arg_sig; arg_sig++, arg_pos++ ) {

    ST *arg_st = WN_st(WN_kid(pu_wn, arg_pos));

    if (arg_st == NULL) {
      // This warning should be deleted once the testing is finished
      //
      ErrMsgSrcpos(EC_DRA_bad_clone_request,
                   WN_Get_Linenum(pu_wn),
                   DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE),
         "cannot be satisfied -- too many arguments passed or types mismatch");
      // Do not clone in the presence of errors!
      // 
      return NULL;
    }

    // Extract the number of dimensions
    //
    TY_IDX arg_ty = DRA_Get_Array_Type(arg_st);
    DRA_INFO *dra = dra_table->Find(arg_st);
    INT16 num_dims = (INT16) strtol (arg_sig, &dim_sig, 10);

    // Do some consistency checking
    //
    if (num_dims == 0) {
      if (dra != NULL) {
        // This warning should be deleted once the testing is finished
        //
        ErrMsgSrcpos(EC_DRA_bad_clone_request,
                     WN_Get_Linenum(pu_wn),
                     DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE),
                     "cannot be satisfied -- non-reshaped argument passed to reshaped formal parameter");
        // Do not clone in the presence of errors!
        // 
        return NULL;
      } 
      else {
        arg_sig = strchr(arg_sig, DRA_ARG_SEPARATOR);
        *bufptr++ = '0'; 
        *bufptr++ = DRA_ARG_SEPARATOR; 
        continue;
      }
    }
    
    // From now on num_dims must be > 0
    //

    if (TY_kind(arg_ty) != KIND_ARRAY) {
      // This warning should be deleted once the testing is finished
      //
      ErrMsgSrcpos(EC_DRA_bad_clone_request,
                   WN_Get_Linenum(pu_wn),
                   DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE),
                   "cannot be satisfied -- reshaped argument passed to a non-array formal parameter");
      // Do not clone in the presence of errors!
      // 
      return NULL;
    }
    
    if (num_dims != TY_AR_ndims(arg_ty) ||
        (dra != NULL && num_dims != dra->Num_Dims())) {
      // This warning should be deleted once the testing is finished
      //
      ErrMsgSrcpos(EC_DRA_bad_clone_request,
                   WN_Get_Linenum(pu_wn),
                   DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE),
                   "cannot be satisfied -- reshaped argument and matching formal parameter have different ranks");
      // Do not clone in the presence of errors!
      // 
      return NULL;
    }


    INT64 elem_size = (INT64) strtol(dim_sig+1, &dim_sig, 10);
    
    if (elem_size != TY_size(TY_AR_etype(arg_ty)) ||
        (dra != NULL && elem_size != dra->Element_Size())) {
      // This warning should be deleted once the testing is finished
      //
      ErrMsgSrcpos(EC_DRA_bad_clone_request,
                   WN_Get_Linenum(pu_wn),
                   DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE),
                   "cannot be satisfied -- reshaped argument and matching formal parameter have different element sizes");
      // Do not clone in the presence of errors!
      // 
      return NULL;
    }
      
    
    if (dra != NULL) {
      // dim_sig points to 'D'; skip it to process element size first
      //
      if (!DRA_Info_Matches_Encoding(dra, dim_sig+1)) {
        // This warning should be deleted once the testing is finished
        //
        ErrMsgSrcpos(EC_DRA_bad_clone_request,
                     WN_Get_Linenum(pu_wn),
                     DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE),
                     "cannot be satisfied -- reshaping distributions of arguments and formal parameters do not match");
        // Do not clone in the presence of errors!
        // 
        return NULL;
      }
      else {
        // Ignore this DRA because it's already specified
        //
        arg_sig = strchr(arg_sig, DRA_ARG_SEPARATOR);
        *bufptr++ = '0'; 
        *bufptr++ = DRA_ARG_SEPARATOR; 
        continue;
      }
    }
        
    // dra is NULL, and we need to insert pragma for this parameter

    // Copy ndims (digits before 'D')
    //
    while (*arg_sig != DRA_NDIMS_END) {
      *bufptr++ = *arg_sig++;
    }
    
    // Skip D<esize>E 
    //
    arg_sig++;
    while (*arg_sig++ != DRA_ESIZE_END);

    // Copy distribution encodings
    //
    while (*arg_sig != DRA_ARG_SEPARATOR) {
      *bufptr++ = *arg_sig++;
    }
    *bufptr++ = DRA_ARG_SEPARATOR;
  }

  // Do not clone if no new pragmas are needed
  //
  if (bufptr == buf) {
    return NULL;
  }
  
  *bufptr = '\0'; 


  // If the number of actual arguments is less than the number of 
  // formal parameters, we still clone but also warn the user
  //
  if (arg_pos < WN_num_formals(pu_wn)) {
    ErrMsgSrcpos(EC_DRA_bad_clone_request, 
                 WN_Get_Linenum(pu_wn),
                 DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE),
                 "has incomplete argument list");
  }
  
  return buf;
}




// =====================================================================
//
// Function Name: DRA_Add_Clone
//
// Description: Clone the PU whose PU_Info structure is passed in
//              and add it to the PU list.
//
//              The assumption is that WT_SYMTAB, WT_TREE, and
//              WT_PROC_SYM sections of the orig_pu are in state 
//              Subsect_InMem. 
// 
//              Returned PU_Info structure is allocated in the
//              Malloc_Mem_Pool. 
//
//              Local objects that disappear after the cloning
//              is finished are allocated from MEM_local_pool.
//
//              Everything else (tree, map tables, symtabs (?),
//              DSTs) is allocated from the mem_pool that is
//              passed in, and the client has control over its
//              life-time.
//
// =====================================================================

static void 
DRA_Add_Clone (PU_Info *orig_pu, 
               MEM_POOL *mem_pool,
               STR_IDX clone_name,
               char *arg_sig,
               BOOL pu_has_feedback)
{
  // Save current pointers to standard memory pools and scope table
  //
  MEM_POOL *save_pu_pool_ptr = MEM_pu_pool_ptr;
  MEM_POOL *save_wn_pool_ptr = WN_mem_pool_ptr;
  
  // Save local symbol table of the original PU, since
  // cloning will overwrite its Scope_tab entry
  //
  Set_PU_Info_symtab_ptr(orig_pu, NULL);
  Save_Local_Symtab(CURRENT_SYMTAB, orig_pu);

  // Use the given mem_pool for WN, ST, etc.
  //
  MEM_pu_pool_ptr = mem_pool;    
  WN_mem_pool_ptr = mem_pool;

  // Define a new IPO_CLONE object
  //
  IPO_CLONE clone(PU_Info_tree_ptr(orig_pu),
                  Scope_tab,
                  CURRENT_SYMTAB,
                  PU_Info_maptab(orig_pu),
                  mem_pool,
                  mem_pool);

  ST* orig_st = ST_ptr(PU_Info_proc_sym(orig_pu));

  // Lookup the clone name in the table of mangled names
  //
  MANGLED_FUNC *clone_desc = DRA_func_table->Find(clone_name);

  // If not found, the new ST entry should be created
  //
  if (clone_desc == NULL) {
    clone_desc = CXX_NEW(MANGLED_FUNC, &MEM_src_pool);

    // Create a PU
    PU_IDX pu_idx;
    PU& pu = New_PU (pu_idx);
    Pu_Table[pu_idx] = Pu_Table[ST_pu(orig_st)];
    
    // Make an ST: add function to global symbol table
    clone_desc->st = New_ST (ST_level(orig_st));
    ST_Init (clone_desc->st, 
             clone_name, 
             CLASS_FUNC, 
             SCLASS_TEXT,
             ST_export(orig_st),
             pu_idx);

    clone_desc->is_called = FALSE;
    DRA_func_table->Enter(clone_name, clone_desc);
  } 
  
  clone_desc->is_clone = TRUE;
  Set_ST_sclass (clone_desc->st, SCLASS_TEXT);
  if (Run_cg) {
    Set_ST_base (clone_desc->st, ST_base(orig_st));
  }

  // This performs actual cloning
  //
  clone.New_Clone(clone_desc->st);

  // Set frequencies to be the same as in the original PU
  //
  if (pu_has_feedback) {
    DevWarn("Need to fix up feedback in DRA_Add_Clone\n");
  }
#if TODO
    FEEDBACK cloned_fb(clone.Get_Cloned_PU(), mem_pool);
    FB_IPA_Clone(Cur_PU_Feedback, clone_node()->Feedback,
                    WN_func_body(Callee_Wn ()), clone.Get_Cloned_PU(),
                    1.0f);
#endif

  // Set the current scope entry to point to the clone
  //
  Scope_tab[CURRENT_SYMTAB] = 
    clone.Get_sym()->Get_cloned_scope_tab()[CURRENT_SYMTAB];
  Scope_tab[CURRENT_SYMTAB].st = clone_desc->st;
  
  // Insert DISTRIBUTE_RESHAPE pragmas based on the argument signature
  //
  DRA_Insert_Pragmas(clone.Get_Cloned_PU(), arg_sig);

  // Generate DST information for the clone
  //
  Set_FILE_INFO_has_inlines (File_info);
  DST_IDX new_pu_dst = 
    DST_enter_cloned_subroutine(DST_get_compile_unit(),
                                PU_Info_pu_dst(orig_pu), 
                                clone.Get_Func_ST(), 
                                Current_DST,
                                clone.Get_sym());
  
  // Alocate and initialize PU_Info structure for the clone
  //
  PU_Info *new_pu = CXX_NEW(PU_Info, Malloc_Mem_Pool);
  PU_Info_init(new_pu);

  // Add new pu right after the original pu
  //
  PU_Info_next(new_pu) = PU_Info_next(orig_pu);
  PU_Info_next(orig_pu) = new_pu;

  // Update the PU pointers and state information
  //
  Set_PU_Info_flags(new_pu, PU_IS_COMPILER_GENERATED);
  Set_PU_Info_flags(new_pu, PU_IS_DRA_CLONE);  
  Set_PU_Info_pu_dst(new_pu, new_pu_dst);

  Set_PU_Info_tree_ptr(new_pu, clone.Get_Cloned_PU());
  PU_Info_proc_sym(new_pu) = ST_st_idx(clone.Get_Func_ST());  
  PU_Info_maptab(new_pu) = clone.Get_Cloned_maptab();

  Set_PU_Info_state(new_pu, WT_TREE,     Subsect_InMem);
  Set_PU_Info_state(new_pu, WT_SYMTAB,   Subsect_InMem);
  Set_PU_Info_state(new_pu, WT_PROC_SYM, Subsect_InMem);
#if 0
  Set_PU_Info_state(new_pu, WT_DEPGRAPH, Subsect_InMem);
  Set_PU_Info_depgraph_ptr(new_pu, NULL);
#endif

  if (pu_has_feedback) {
    Set_PU_Info_state(new_pu, WT_FREQ, Subsect_InMem);
  }

  // Mark that clone requires LNO processing
  //
  Set_PU_mp_needs_lno(PU_Info_pu(new_pu));

  // Restore Curent_Map_Tab and Current_Symtab to those of the original PU
  //
  Current_Map_Tab = PU_Info_maptab(orig_pu);

  // Restore pointers to standard memory pools
  //
  MEM_pu_pool_ptr = save_pu_pool_ptr;
  WN_mem_pool_ptr = save_wn_pool_ptr;

  // Save local symbol table of the clone
  //
  Set_PU_Info_symtab_ptr(new_pu, NULL);  
  Save_Local_Symtab(CURRENT_SYMTAB, new_pu);

  // Restore local symbol table of the original PU
  //
  Restore_Local_Symtab(orig_pu);
}  



// =====================================================================
//
// Function Name: Find_Insertion_Point
//
// Description: Find the place in the PU where we should start
//              inserting distribute_reshape pragmas. Ordinarily
//              it would be after the preamble, but in C/C++ 
//              there are assignments to __vla_bound variables
//              that can occur after the PREAMBLE. In which case the
//              insertion point must be after the STIDs to those variables.
//
// =====================================================================

static WN* 
Find_Insertion_Point (WN *pu_wn, 
                      char *arg_sig) 
{
  WN *preamble_wn = Get_Preamble_End(pu_wn); 

  if (ONST (SYMTAB_src_lang(Current_Symtab) != SYMTAB_C_LANG &&
            SYMTAB_src_lang(Current_Symtab) != SYMTAB_CXX_LANG,
            PU_src_lang(Get_Current_PU()) != PU_C_LANG &&
            PU_src_lang(Get_Current_PU()) != PU_CXX_LANG)) {
    return preamble_wn;
  }

  WN *current_wn = preamble_wn;

  for (INT16 arg_pos = 0; *arg_sig; arg_sig++, arg_pos++ ) {

    // Extract the number of dimensions
    //
    INT16 num_dims = (INT16) strtol (arg_sig, &arg_sig, 10);
    ST *arg_st = WN_st(WN_kid(pu_wn, arg_pos));
    TY_IDX arg_ty = DRA_Get_Array_Type(arg_st);

    for (INT16 dim = 0; dim < num_dims; dim++) {

      if (*arg_sig++ == DRA_CYCLIC_CODE) {
        INT64 chunk = (INT64) strtol (arg_sig, &arg_sig, 10);
      }
      // For each dimension see if the bound is __vla_bound
      //
      if (!TY_AR_const_ubnd(arg_ty, num_dims-1-dim) &&
          TY_AR_ubnd_val(arg_ty, num_dims-1-dim) &&
          strcmp(ST_name(TY_AR_ubnd_var(arg_ty, num_dims-1-dim)),
                 "__vla_bound") == 0) {

        ST* vlabound_st = ONST(WN_st(TY_AR_ubnd_tree(arg_ty, dim)),
                               &(St_Table[TY_AR_ubnd_var(arg_ty, num_dims-1-dim)]));
        
        // simple LDID for upper bound of __vla_bound
        // Find the STID in the tree
        BOOL saw_preamble = FALSE;
        BOOL saw_current = FALSE;
        WN *wn = WN_first(WN_func_body(pu_wn));

        while (wn) {

          if (WN_operator(wn) == OPR_PRAGMA &&
              WN_pragma(wn) == WN_PRAGMA_PREAMBLE_END) {
            saw_preamble = TRUE;
          }
          if (wn == current_wn) saw_current = TRUE;

          if (WN_operator(wn) == OPR_STID &&
              WN_st(wn) == vlabound_st) {

            if (saw_preamble && saw_current) {
              // we must move current_wn
              //
              current_wn = wn;

              // see if we're followed by an XPRAGMA-COPYIN
              if (WN_next(wn) &&
                  WN_operator(WN_next(wn)) == OPR_XPRAGMA &&
                  WN_operator(WN_kid0(WN_next(wn)))==OPR_LDID &&
                  WN_st(WN_kid0(WN_next(wn))) == vlabound_st) {

                current_wn = WN_next(wn);
              }
            }
            else {
              // don't need to do anything
            }
            break;
          }
          wn = WN_next(wn);
        }

        FmtAssert (wn,
                   ("Find_Insertion_Point: No STID vla_bound for %s\n",
                    ST_name(arg_st)));
      }
    } 
  }
  return current_wn;
}


// =====================================================================
//
// Function Name: DRA_Insert_Pragmas
//
// Description: Insert DISTRIBUTE_RESHAPE pragmas into the passed tree
//              based on the argument signature given by arg_sig.
//
// =====================================================================

static void 
DRA_Insert_Pragmas(WN *pu_wn,
                   char *arg_sig)
{
  // strtol (char *str, char *ptr, INT base) returns as a long integer 
  // the value represented by the character string pointed to by str. 
  // The string is scanned up to  the first character inconsistent with 
  // the base. If the value of ptr is not (char **)NULL, a pointer to 
  // the character terminating the scan is returned in the location 
  // pointed to by ptr. If no integer can be formed, that location is 
  // set to str, and zero is returned.

  WN *block = WN_func_body(pu_wn);
  // WN *current = Get_Preamble_End(pu_wn); 
  WN *current = Find_Insertion_Point(pu_wn, arg_sig); 

  for (INT16 arg_pos = 0; *arg_sig; arg_sig++, arg_pos++ ) {

    // Extract the number of dimensions
    //
    INT16 num_dims = (INT16) strtol (arg_sig, &arg_sig, 10);
    ST *arg_st = WN_st(WN_kid(pu_wn, arg_pos));
    TY_IDX arg_ty = DRA_Get_Array_Type(arg_st);

    for (INT16 dim = 0; dim < num_dims; dim++) {

      // For each dimension create a pragma node
      //
      WN *pwn = WN_CreatePragma(WN_PRAGMA_DISTRIBUTE_RESHAPE, arg_st, 0, 0);
      WN_pragma_index(pwn) = dim;

      WN_set_pragma_compiler_generated(pwn);
      WN_INSERT_BlockAfter(block, current, pwn); // Need to fix this
      current = pwn;

      switch (*arg_sig++) {

        case DRA_BLOCK_CODE:
          WN_pragma_distr_type(pwn) = DISTRIBUTE_BLOCK;
          break;

        case DRA_STAR_CODE:
          WN_pragma_distr_type(pwn) = DISTRIBUTE_STAR;
          break;

        case DRA_CYCLIC_CODE: 
          {
            INT64 chunk = (INT64) strtol (arg_sig, &arg_sig, 10);
            if (chunk != 0) {
              WN_pragma_distr_type(pwn) = DISTRIBUTE_CYCLIC_CONST;
              WN_pragma_arg2(pwn) = chunk;
            }
            else {
              // For CYCLIC_EXPR create an additional XPRAGMA node
              //
              WN_pragma_distr_type(pwn) = DISTRIBUTE_CYCLIC_EXPR;
              WN *xpwn = WN_CreateXpragma(WN_PRAGMA_DISTRIBUTE_RESHAPE,
                                          arg_st, 1);
              WN_kid(xpwn, 0) = WN_Intconst(MTYPE_I8, 0);

              WN_set_pragma_compiler_generated(xpwn);
              WN_INSERT_BlockAfter(block, current, xpwn);
              current = xpwn;
            }
          }
          break;

        default:
          FmtAssert(FALSE, 
                    ("Unrecognized distribution in the mangled name"));
      }

      // Finally, create an XPRAGMA node for array size
      //
      WN *xpwn = WN_CreateXpragma(WN_PRAGMA_DISTRIBUTE_RESHAPE, arg_st, 1);
      
      INT16 st_dim = dim;

      WN *lb;
      if (TY_AR_const_lbnd(arg_ty, st_dim)) {
        lb = WN_Intconst(MTYPE_I8, TY_AR_lbnd_val(arg_ty, st_dim));
      }
      else {
        ST_IDX lb_st = TY_AR_lbnd_var(arg_ty, st_dim);
        TY_IDX lb_ty = ST_type(lb_st);
        lb = WN_CreateLdid(OPCODE_make_op(OPR_LDID, 
                                          TY_mtype(lb_ty),
                                          TY_mtype(lb_ty)),
                           0, 
                           lb_st, 
                           lb_ty);
      }

      WN *ub;
      if (TY_AR_const_ubnd(arg_ty, st_dim)) {
        ub = WN_Intconst(MTYPE_I8, TY_AR_ubnd_val(arg_ty, st_dim));
      }
      else {
        ST_IDX ub_st = TY_AR_ubnd_var(arg_ty, st_dim);
        TY_IDX ub_ty = ST_type(ub_st);
        ub = WN_CreateLdid(OPCODE_make_op(OPR_LDID,
                                          TY_mtype(ub_ty),
                                          TY_mtype(ub_ty)),
                           0, 
                           ub_st, 
                           ub_ty);
      }

      WN_kid(xpwn, 0) = WN_Add(MTYPE_I8, 
                               WN_Sub(MTYPE_I8, ub, lb), 
                               WN_Intconst(MTYPE_I8, 1));
      
      WN_set_pragma_compiler_generated(xpwn);
      WN_INSERT_BlockAfter(block, current, xpwn);
      current = xpwn;
    } 
  }
}



// =====================================================================
// 
// Function Name: DRA_Collect_Commons
// 
// Description: Given a WHIRL tree and a hash-table, (recursively) collect all
//              the base COMMON STs referenced in the tree into the hash-table.
//
// =====================================================================

static void 
DRA_Collect_Commons(WN *wn, DRA_COMMON_HASH_TABLE *dra_common_ht)
{
  if (wn == NULL) return;

  OPCODE opc = WN_opcode(wn);

  ST *st = OPCODE_has_sym(opc) ? WN_st(wn) : NULL;

  if (st &&
      (ST_base(st) != st) &&
      (ST_sclass(st) == SCLASS_COMMON || ST_sclass(st) == SCLASS_DGLOBAL) &&
      (ST_class(ST_base(st)) == CLASS_VAR &&
       TY_kind(ST_type(ST_base(st))) == KIND_STRUCT)) {
    // smells like a common
    dra_common_ht->Enter_If_Unique (ST_st_idx(ST_base(st)), TRUE);
  }

  // recurse
  //
  if (opc == OPC_BLOCK) {
    WN *kid = WN_first(wn);
    while (kid) {
      DRA_Collect_Commons (kid, dra_common_ht);
      kid = WN_next(kid);
    }
  }
  else {
    for (INT i=0; i<WN_kid_count(wn); i++) {
      DRA_Collect_Commons (WN_kid(wn,i), dra_common_ht);
    }
  }
}


// =====================================================================
// 
// Function Name: DRA_Process_Commons
// 
// Description: Write the information related to distribute-reshaped
//              arrays appearing in common blocks into .rii file that
//              will be consumed by the prelinker in order to do 
//              consistency checks.
//
// =====================================================================

static void 
DRA_Process_Commons(DRA_HASH_TABLE *dra_table, 
                    DRA_COMMON_HASH_TABLE *dra_common_ht)
{       
  BOOL seen_common = FALSE;
  BOOL new_common = FALSE;
  UINT bufsize = 1024;
  char *buf = (char *) alloca(bufsize);
  char *bufptr = buf;
  char *common_name = NULL;
  INT64 common_offset;
  INT64 non_dra_start = 0;
  INT64 non_dra_end = 0;
  ST *st;
  INT i;

  /* COMMON blocks are now in global symtab */
  FOREACH_SYMBOL (GLOBAL_SYMTAB, st, i) {

    // Common blocks and their fields are listed consecutively in ST
    //
    ST_SCLASS st_sclass = ST_sclass(st);

    if (st_sclass == SCLASS_COMMON &&
        ST_st_idx(st) == ST_base_idx(st) &&
        dra_common_ht->Find(ST_st_idx(st))) {

      // COMMON and not based, so must be the base of the COMMON block

      char *st_name = ST_name(st);

      // Names of split commons: BaseName.BaseOffset (Try to find '.')
      //
      char *dot = strchr(st_name, '.');

      // Full common name
      //
      if (dot == NULL) {
        if (common_name == NULL || 
            strcmp(st_name, common_name) != 0) {
          common_name = strcpy((char *) alloca(strlen(st_name)+1), 
                               st_name);
          new_common = TRUE;
        }
        common_offset = 0;
      }

      // Split common name
      //
      else {
        if (common_name == NULL || 
            strncmp(st_name, common_name, dot-st_name) != 0) {
          common_name = strncpy((char *) alloca(dot-st_name+1), 
                                st_name, dot-st_name);
          common_name[dot-st_name] = '\0';
          new_common = TRUE;
        }
        common_offset = strtol(dot+1, NULL, 10);
      }

      if (new_common) {

        // Write the last chunk of the previous common (if it existed)
        //
        if (non_dra_end - non_dra_start > 0) {
          bufptr += sprintf(bufptr, " %" SCNd64 "\n", non_dra_end - non_dra_start);
        }
        else if (seen_common) {
          *bufptr++ = '\n';
        }
        
        // Write the name of the new common
        //
        INT name_len = strlen(common_name);

        if (bufptr - buf + name_len + 21 >= bufsize) {
          bufsize *= 2;
          char *newbuf = (char *) alloca(bufsize);
          buf = strcpy(newbuf, buf);
          bufptr = buf + strlen(buf);
        }

        (void) strcpy(bufptr, common_name);
        bufptr += name_len;

        non_dra_end = non_dra_start = 0;
        new_common = FALSE;
      }

      seen_common = TRUE;
    }

    else if (ST_st_idx(st) != ST_base_idx(st) &&
             ST_sclass(ST_base(st)) == SCLASS_COMMON &&
             dra_common_ht->Find(ST_st_idx(ST_base(st)))) {

      TY_IDX ty = ST_type(st);

      DRA_INFO *dra = (dra_table ? dra_table->Find(st) : NULL);

      if (dra != NULL) {              // reshaped array

        INT16 ndims = TY_AR_ndims(ty);

        // Reallocate if necessary (double the buffer size)
        // We need space to write this reshaped array and
        // possibly a non-reshaped chunk size that follows it
        // 31 chars prefix: DRA_ndims(5)_esize(21)
        // 69 chars per dimension: _lb(22):ub(22):distr(1)chunk(21)
        // 21 chars for the next non-reshaped chunk
        //
        if (bufptr - buf + 31 + ndims*69 + 21 >= bufsize) {
          bufsize *= 2;
          char *newbuf = (char *) alloca(bufsize);
          buf = strcpy(newbuf, buf);
          bufptr = buf + strlen(buf);
        }

        if (non_dra_end - non_dra_start > 0) {
          bufptr += sprintf(bufptr, " %" SCNd64 "", non_dra_end - non_dra_start);
        }
        non_dra_start = common_offset + ST_ofst(st) + TY_size(ty);
        non_dra_end = non_dra_start;

        bufptr += 
          sprintf(bufptr, " DRA_%" SCNd64 "_%d", TY_size(TY_AR_etype(ty)), ndims);

        for (INT16 dim = 0; dim < ndims; ++dim) {
          
          bufptr += sprintf(bufptr, 
                            "_%" SCNd64 ":%" SCNd64 ":", 
                            TY_AR_lbnd_val(ty, ndims-1-dim), 
                            TY_AR_ubnd_val(ty, ndims-1-dim));

          switch (dra->Distr_Type(dim)) {
            case DISTRIBUTE_STAR: 
              *bufptr++ = DRA_STAR_CODE; 
              break;	
            case DISTRIBUTE_BLOCK: 
              *bufptr++ = DRA_BLOCK_CODE; 
              break;
            case DISTRIBUTE_CYCLIC_CONST:
              *bufptr++ = DRA_CYCLIC_CODE; 
              bufptr += sprintf(bufptr, "%" SCNd64 "", dra->Chunk_Const_Val(dim));
              break;
            case DISTRIBUTE_CYCLIC_EXPR:
              *bufptr++ = DRA_CYCLIC_CODE; 
              break;
          }	
        }
      }

      else if (common_offset + ST_ofst(st) + TY_size(ty) > non_dra_end) {
        non_dra_end = common_offset + ST_ofst(st) + TY_size(ty);
      }
    }
  }

  if (bufptr != buf) {
    if (non_dra_end - non_dra_start > 0) {
      bufptr += sprintf(bufptr, " %" SCNd64 "\n", non_dra_end - non_dra_start);
    }
    else {
      *bufptr++ = '\n';
    }
    write(DRA_file_desc, (void*)buf, bufptr-buf);
  }
}



// =====================================================================
// 
// Function Name: DRA_Process_Globals
// 
// Description: Write the information related to distribute-reshaped
//              global arrays into .rii file that
//              will be consumed by the prelinker in order to do 
//              consistency checks.
//
// =====================================================================

static void 
DRA_Process_Globals(DRA_HASH_TABLE *dra_table)
{       
  UINT bufsize = 1024;
  char *buf = (char *) alloca(bufsize);
  char *bufptr = buf;
  ST *st;
  INT i;

  {
    // process globals just once per file, not once per PU
    static BOOL done_globals = FALSE;
    if (done_globals) return;
    done_globals = TRUE;
  }

  FOREACH_SYMBOL (GLOBAL_SYMTAB, st, i) {

    if (ST_class(st) != CLASS_VAR) continue;

    // skip commons.
    //
    if ((ST_sclass(st) == SCLASS_COMMON) ||         // common
        (ST_sclass(st) == SCLASS_DGLOBAL &&         // might be common
                                                    // if this st or
                                                    // the base is kind struct
         (TY_kind(ST_type(st)) == KIND_STRUCT ||
          (ST_class(ST_base(st)) == CLASS_VAR &&
           TY_kind(ST_type(ST_base(st))) == KIND_STRUCT)))) {
      continue;
    }

    bufptr = buf;

    // is it a global array? if so, write it out
    //
    TY_IDX ty = DRA_Get_Original_Type(st);
    if (ty && TY_kind(ty) == KIND_ARRAY) {

      char* st_name = ST_name(st);
      INT name_len = strlen(st_name);

      if (bufptr - buf + name_len + 21 >= bufsize) {
        bufsize *= 2;
        char *newbuf = (char *) alloca(bufsize);
        buf = strcpy(newbuf, buf);
        bufptr = buf + strlen(buf);
      }

      strcpy (bufptr, st_name);
      bufptr += name_len;

      DRA_INFO* dra = (dra_table ? dra_table->Find(st) : NULL);

      if (dra != NULL) {
        // reshaped
        //

        INT16 ndims = TY_AR_ndims(ty);

        // Reallocate if necessary (double the buffer size)
        // We need space to write this reshaped array 
        // 31 chars prefix: DRA_ndims(5)_esize(21)
        // 69 chars per dimension: _lb(22):ub(22):distr(1)chunk(21)
        //
        if (bufptr - buf + 31 + ndims*69 >= bufsize) {
          bufsize *= 2;
          char *newbuf = (char *) alloca(bufsize);
          buf = strcpy(newbuf, buf);
          bufptr = buf + strlen(buf);
        }

        bufptr += 
          sprintf(bufptr, " DRA_%" SCNd64 "_%d", TY_size(TY_AR_etype(ty)), ndims);

        // emit dimensions consistently: i.e. stride-one dimension first
        // 
        for (INT16 dim = 0; dim < ndims; ++dim) {
          
          bufptr += sprintf(bufptr, 
                            "_%" SCNd64 ":%" SCNd64 ":", 
                            TY_AR_lbnd_val(ty, ndims-1-dim), 
                            TY_AR_ubnd_val(ty, ndims-1-dim));

          switch (dra->Distr_Type(dim)) {
            case DISTRIBUTE_STAR: 
              *bufptr++ = DRA_STAR_CODE; 
              break;	
            case DISTRIBUTE_BLOCK: 
              *bufptr++ = DRA_BLOCK_CODE; 
              break;
            case DISTRIBUTE_CYCLIC_CONST:
              *bufptr++ = DRA_CYCLIC_CODE; 
              bufptr += sprintf(bufptr, "%" SCNd64 "", dra->Chunk_Const_Val(dim));
              break;
            case DISTRIBUTE_CYCLIC_EXPR:
              *bufptr++ = DRA_CYCLIC_CODE; 
              break;
          }	
        }
        *bufptr++ = '\n';
      }
      else {
        // not reshaped
        //
        bufptr += sprintf (bufptr, " %" SCNd64 "", TY_size(ty));
        *bufptr++ = '\n';
      }
      write(DRA_file_desc, (void*)buf, bufptr-buf);
    }
  }
}



// =====================================================================
//
// Function Name: DRA_Info_Matches_Encoding
//
// Description: Check if the DISTRIBUTE_RESHAPE information from
//              DRA_INFO matches that of the encoded argument.
//
// =====================================================================

static BOOL
DRA_Info_Matches_Encoding(DRA_INFO *dra, 
                          char *arg_sig)
{
  INT16 num_dims = dra->Num_Dims();
  for (INT16 dim = 0; dim < num_dims; dim++) {

    switch (*arg_sig++) {

      case DRA_BLOCK_CODE:
        if (dra->Distr_Type(dim) != DISTRIBUTE_BLOCK) {
          return FALSE;
        }
        break;

      case DRA_STAR_CODE:
        if (dra->Distr_Type(dim) != DISTRIBUTE_STAR) {
          return FALSE;
        }
        break;

      case DRA_CYCLIC_CODE: 
        {
          INT64 chunk = (INT64) strtol (arg_sig, &arg_sig, 10);
          if (chunk != 0) {
            if (dra->Distr_Type(dim) != DISTRIBUTE_CYCLIC_CONST ||
                dra->Chunk_Const_Val(dim) != chunk) {
              return FALSE;
            }
          }
          else {
            if (dra->Distr_Type(dim) != DISTRIBUTE_CYCLIC_EXPR) {
              return FALSE;
            }
          }
        }
        break;

      default:
        FmtAssert(FALSE, 
                  ("Uncrecognized distribution in the mangled name"));
    }
  }
  return TRUE;
}
