/*
 * Copyright (C) 2008 PathScale, LLC.  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

*/


//                     Memory Simulation
//                     -----------------
//
// Description:
//
//	Instrument the code with calls to the memory simulator run-time.
//	Register every local and global array used by the subroutine.
//	Instrument every indirect memory reference
//
//
/* ====================================================================
 * ====================================================================
 *
 * Module: mem_sim.cxx
 * $Revision$
 * $Date$
 * $Author$
 * $Source$
 *
 * Revision history:
 *  02-07-96 - Original Version
 *
 * Description: Instrument code for memory simulator
 *
 * ====================================================================
 * ====================================================================
 */

#ifdef USE_PCH
#include "lno_pch.h"
#endif // USE_PCH
#pragma hdrstop

static const char *source_file = __FILE__;
static const char *rcs_id = "$Source$ $Revision$";

#ifndef _NEW_SYMTAB

#include <sys/types.h>
#include "lnopt_main.h"
#include "config_targ.h"
#include "stab.h"
#include "strtab.h"
#include "stblock.h"
#include "lwn_util.h"
#include "dep.h"
#include "lnoutils.h"
#include "targ_const.h"
#include "const.h"
#include "glob.h"

typedef HASH_TABLE<ST*, BOOL> STBOOL_HASH_TABLE;
typedef STACK<WN*> STACK_OF_WN;

static void  Instrument_Array_Ref(WN *, BOOL,INT, STACK_OF_WN *, STBOOL_HASH_TABLE *);
static void Instrument_Address(WN *address, BOOL is_load, INT num_bytes);
static ST *Create_MemTools_Store();
static ST *Create_MemTools_Load();
static WN *Find_Statement(WN *wn);
static INT Size(OPCODE opcode);
static void Instrument_Rec(WN *, STACK_OF_WN *, STACK_OF_WN *, STBOOL_HASH_TABLE *);
static void Remove_Locals(STACK_OF_WN *, STACK_OF_WN *);
static ST *Create_Local_Array_ST (TY* ty, INT num);
static void  Process_Base(WN *, INT , STACK_OF_WN *);
static ST *dim_sizes;

#define MAX_ARRAY_DIMS 8

void Instrument_Mem_Sim(WN *func_nd)
{
  dim_sizes = NULL;
  MEM_POOL_Push(&LNO_local_pool);
  // the STs of all the local arrays in the routine
  STACK_OF_WN *local_arrays = CXX_NEW(STACK_OF_WN(&LNO_local_pool),
					&LNO_local_pool);

  // the WNs of all the return points in the function
  STACK_OF_WN *return_points = CXX_NEW(STACK_OF_WN(&LNO_local_pool),
					&LNO_local_pool);
  // a hash table to map whether or not we have seen an array before
  STBOOL_HASH_TABLE *array_hash = 
    CXX_NEW(STBOOL_HASH_TABLE(200,&LNO_local_pool),&LNO_local_pool);

  Instrument_Rec(func_nd,local_arrays,return_points,array_hash);

  WN *last_statement = WN_last(WN_func_body(func_nd));
  if (WN_opcode(last_statement) != OPC_RETURN) return_points->Push(last_statement);
  Remove_Locals(local_arrays,return_points);
  CXX_DELETE(local_arrays,&LNO_local_pool);
  CXX_DELETE(return_points,&LNO_local_pool);
  CXX_DELETE(array_hash,&LNO_local_pool); 
  MEM_POOL_Pop(&LNO_local_pool);
}

static void Instrument_Rec(WN *wn, STACK_OF_WN *local_arrays, 
		STACK_OF_WN *return_points, STBOOL_HASH_TABLE *array_hash)
{
  OPCODE opcode = WN_opcode(wn);
  if (opcode == OPC_BLOCK) {
    WN *kid = WN_first (wn);
    while (kid) {
      Instrument_Rec(kid,local_arrays,return_points,array_hash);
      kid = WN_next(kid);
    }
  } else {
    for (INT kidno=0; kidno<WN_kid_count(wn); kidno++) {
      Instrument_Rec(WN_kid(wn,kidno),local_arrays,return_points,array_hash);
    }
    if (opcode == OPC_RETURN) {
      return_points->Push(wn);
    } else if (OPCODE_is_load(opcode) && (OPCODE_operator(opcode) != OPR_LDID)) {
      if (WN_operator(WN_kid0(wn)) == OPR_ARRAY) {
	Instrument_Array_Ref(WN_kid0(wn),TRUE,Size(opcode),
						local_arrays,array_hash);
      } else {
	Instrument_Address(WN_kid0(wn),TRUE,Size(opcode));
      }
    } else if (OPCODE_is_store(opcode) && (OPCODE_operator(opcode) != OPR_STID)) {
      if (WN_operator(WN_kid1(wn)) == OPR_ARRAY) {
	Instrument_Array_Ref(WN_kid1(wn),FALSE,Size(opcode),
						local_arrays,array_hash);
      } else {
	Instrument_Address(WN_kid1(wn),FALSE,Size(opcode));
      }
    }
  }
}

// How many bytes are we loading or storing
static INT Size(OPCODE opcode)
{
  switch(OPCODE_desc(opcode)) {
    case MTYPE_I1: case MTYPE_U1: return 1;
    case MTYPE_I2: case MTYPE_U2: return 2;
    case MTYPE_I4: case MTYPE_U4: case MTYPE_F4: return 4;
    case MTYPE_I8: case MTYPE_U8: case MTYPE_F8: case MTYPE_C4: return 8;
    case MTYPE_C8: case MTYPE_FQ: case MTYPE_F16: return 16;
    case MTYPE_CQ: case MTYPE_C16: return 32;
  }
  return 0;
}



// Find the statement surrounding wn
static WN *Find_Statement(WN *wn)
{
  while (OPCODE_is_expression(WN_opcode(wn))) wn = LWN_Get_Parent(wn);
  return wn;
}

// Create an st for MemoryTools_Load
static ST *Create_MemTools_Load()
{
  static st *result=NULL;
  if (result) return result;

  TY *func_ty = New_TY(TRUE);
  TY_kind(func_ty) = KIND_FUNCTION;
  TY_btype(func_ty) = MTYPE_UNKNOWN;
  Set_TY_has_prototype(func_ty);
  TY_ftinfo(func_ty) = New_FTI (2, TRUE /* global/local */ );
  TYLIST *parms = TY_parms(func_ty);
  TYLIST_item(&parms[0]) = Be_Type_Tbl(Pointer_type);
  TYLIST_item(&parms[1]) = Be_Type_Tbl(Pointer_type);
  TY_name(func_ty) = Save_Str(".MemoryTools_Load");
  TY *voidpty = Make_Pointer_Type (Be_Type_Tbl(MTYPE_V));
  TY_size(func_ty) = TY_size(voidpty);
  TY_align(func_ty) = TY_align(voidpty);
  TY_ret_type(func_ty) = Be_Type_Tbl(MTYPE_V);
  Enter_TY (func_ty);

  /* Make a ST: add function to global symbol table */
  result = New_ST ( TRUE );
  ST_name(result) = Save_Str("MemoryTools_Load");
  ST_class(result) = CLASS_FUNC;
  Set_ST_sclass(result,SCLASS_EXTERN);
  Set_ST_export(result, EXPORT_PREEMPTIBLE);
  ST_type(result) = func_ty;
  Enter_ST ( result);
  return result;
}

// Create an st for MemoryTools_Store
static ST *Create_MemTools_Store()
{
  static st *result=NULL;
  if (result) return result;

  TY *func_ty = New_TY(TRUE);
  TY_kind(func_ty) = KIND_FUNCTION;
  TY_btype(func_ty) = MTYPE_UNKNOWN;
  Set_TY_has_prototype(func_ty);
  TY_ftinfo(func_ty) = New_FTI (2, TRUE /* global/local */ );
  TYLIST *parms = TY_parms(func_ty);
  TYLIST_item(&parms[0]) = Be_Type_Tbl(Pointer_type);
  TYLIST_item(&parms[1]) = Be_Type_Tbl(Pointer_type);
  TY_name(func_ty) = Save_Str(".MemoryTools_Store");
  TY *voidpty = Make_Pointer_Type (Be_Type_Tbl(MTYPE_V));
  TY_size(func_ty) = TY_size(voidpty);
  TY_align(func_ty) = TY_align(voidpty);
  TY_ret_type(func_ty) = Be_Type_Tbl(MTYPE_V);
  Enter_TY (func_ty);

  /* Make a ST: add function to global symbol table */
  result = New_ST ( TRUE );
  ST_name(result) = Save_Str("MemoryTools_Store");
  ST_class(result) = CLASS_FUNC;
  Set_ST_sclass(result,SCLASS_EXTERN);
  Set_ST_export(result, EXPORT_PREEMPTIBLE);
  ST_type(result) = func_ty;
  Enter_ST ( result);
  return result;
}

// Create an st for MemoryTools_MakeGlobal
static ST *Create_MemTools_MakeGlobal()
{
  static st *result=NULL;
  if (result) return result;

  TY *func_ty = New_TY(TRUE);
  TY_kind(func_ty) = KIND_FUNCTION;
  TY_btype(func_ty) = MTYPE_UNKNOWN;
  Set_TY_has_prototype(func_ty);
  TY_ftinfo(func_ty) = New_FTI (6, TRUE /* global/local */ );
  TYLIST *parms = TY_parms(func_ty);
  TYLIST_item(&parms[0]) = Make_Pointer_Type(Be_Type_Tbl(MTYPE_U1));
  TYLIST_item(&parms[1]) = Be_Type_Tbl(Pointer_type);
  TYLIST_item(&parms[2]) = Be_Type_Tbl(Pointer_type);
  TYLIST_item(&parms[3]) = Be_Type_Tbl(Pointer_type);
  TYLIST_item(&parms[4]) = Make_Pointer_Type(Be_Type_Tbl(Pointer_type));
  TYLIST_item(&parms[5]) = Be_Type_Tbl(MTYPE_I4);
  TY_name(func_ty) = Save_Str(".MemoryTools_MakeGlobal");
  TY *voidpty = Make_Pointer_Type (Be_Type_Tbl(MTYPE_V));
  TY_size(func_ty) = TY_size(voidpty);
  TY_align(func_ty) = TY_align(voidpty);
  TY_ret_type(func_ty) = Be_Type_Tbl(MTYPE_V);
  Enter_TY (func_ty);

  /* Make a ST: add function to global symbol table */
  result = New_ST ( TRUE );
  ST_name(result) = Save_Str("MemoryTools_MakeGlobal");
  ST_class(result) = CLASS_FUNC;
  Set_ST_sclass(result,SCLASS_EXTERN);
  Set_ST_export(result, EXPORT_PREEMPTIBLE);
  ST_type(result) = func_ty;
  Enter_ST ( result);
  return result;
}

// Create an st for MemoryTools_MakeLocal
static ST *Create_MemTools_MakeLocal()
{
  static st *result=NULL;
  if (result) return result;

  TY *func_ty = New_TY(TRUE);
  TY_kind(func_ty) = KIND_FUNCTION;
  TY_btype(func_ty) = MTYPE_UNKNOWN;
  Set_TY_has_prototype(func_ty);
  TY_ftinfo(func_ty) = New_FTI (7, TRUE /* global/local */ );
  TYLIST *parms = TY_parms(func_ty);
  TYLIST_item(&parms[0]) = Make_Pointer_Type(Be_Type_Tbl(MTYPE_U1));
  TYLIST_item(&parms[1]) = Make_Pointer_Type(Be_Type_Tbl(MTYPE_U1));
  TYLIST_item(&parms[2]) = Be_Type_Tbl(Pointer_type);
  TYLIST_item(&parms[3]) = Be_Type_Tbl(Pointer_type);
  TYLIST_item(&parms[4]) = Be_Type_Tbl(Pointer_type);
  TYLIST_item(&parms[5]) = Make_Pointer_Type(Be_Type_Tbl(Pointer_type));
  TYLIST_item(&parms[6]) = Be_Type_Tbl(MTYPE_I4);
  TY_name(func_ty) = Save_Str(".MemoryTools_MakeLocal");
  TY *voidpty = Make_Pointer_Type (Be_Type_Tbl(MTYPE_V));
  TY_size(func_ty) = TY_size(voidpty);
  TY_align(func_ty) = TY_align(voidpty);
  TY_ret_type(func_ty) = Be_Type_Tbl(MTYPE_V);
  Enter_TY (func_ty);

  /* Make a ST: add function to global symbol table */
  result = New_ST ( TRUE );
  ST_name(result) = Save_Str("MemoryTools_MakeLocal");
  ST_class(result) = CLASS_FUNC;
  Set_ST_sclass(result,SCLASS_EXTERN);
  Set_ST_export(result, EXPORT_PREEMPTIBLE);
  ST_type(result) = func_ty;
  Enter_ST ( result);
  return result;
}

// Create an st for MemoryTools_RemoveLocal
static ST *Create_MemTools_RemoveLocal()
{
  static st *result=NULL;
  if (result) return result;

  TY *func_ty = New_TY(TRUE);
  TY_kind(func_ty) = KIND_FUNCTION;
  TY_btype(func_ty) = MTYPE_UNKNOWN;
  Set_TY_has_prototype(func_ty);
  TY_ftinfo(func_ty) = New_FTI (1, TRUE /* global/local */ );
  TYLIST *parms = TY_parms(func_ty);
  TYLIST_item(&parms[0]) = Make_Pointer_Type(Be_Type_Tbl(Pointer_type));
  TY_name(func_ty) = Save_Str(".MemoryTools_RemoveLocal");
  TY *voidpty = Make_Pointer_Type (Be_Type_Tbl(MTYPE_V));
  TY_size(func_ty) = TY_size(voidpty);
  TY_align(func_ty) = TY_align(voidpty);
  TY_ret_type(func_ty) = Be_Type_Tbl(MTYPE_V);
  Enter_TY (func_ty);

  /* Make a ST: add function to global symbol table */
  result = New_ST ( TRUE );
  ST_name(result) = Save_Str("MemoryTools_RemoveLocal");
  ST_class(result) = CLASS_FUNC;
  Set_ST_sclass(result,SCLASS_EXTERN);
  Set_ST_export(result, EXPORT_PREEMPTIBLE);
  ST_type(result) = func_ty;
  Enter_ST ( result);
  return result;
}


// Given an arbitrary load or store to address, instrument it
static void Instrument_Address(WN *address, BOOL is_load, INT num_bytes)
{
  WN *insertion_point = Find_Statement(address);
  WN *new_address = LWN_Copy_Tree(address);
  LWN_Copy_Def_Use(address,new_address,Du_Mgr);
  ST *func;
  if (is_load) {
    func = Create_MemTools_Load();
  } else {
    func = Create_MemTools_Store();
  }
  WN *call = WN_Create(OPC_VCALL,2);
  WN_st(call) = func;
  WN_linenum(call) = WN_linenum(insertion_point);
  WN_kid0(call) = LWN_CreateParm(Pointer_type,new_address,Be_Type_Tbl(Pointer_type),
			WN_PARM_BY_VALUE);
  LWN_Set_Parent(WN_kid0(call),call);
  WN_kid1(call) = LWN_CreateParm(Pointer_type,LWN_Make_Icon(Pointer_type,num_bytes),
			Be_Type_Tbl(Pointer_type),WN_PARM_BY_VALUE);
  LWN_Set_Parent(WN_kid1(call),call);
  LWN_Copy_Frequency(call,insertion_point);
  LWN_Insert_Block_Before(LWN_Get_Parent(insertion_point),insertion_point,
	call);
}

// Instrument array references
// For "clean" stride one references, generate an instrumentation call
// outside of the inner loop, otherwise use Instrument_Address
static void  Instrument_Array_Ref(WN *address, BOOL is_load, INT num_bytes,
		STACK_OF_WN *local_arrays, STBOOL_HASH_TABLE *array_hash)
{
  WN *base = WN_array_base(address);
  if (WN_operator(base) == OPR_LDA) {
    if (!array_hash->Find(WN_st(base))) {
      array_hash->Enter(WN_st(base),TRUE);
      Process_Base(base,num_bytes,local_arrays);
    }
  }
  WN *enclosing_loop = Enclosing_Do_Loop(address);
  INT depth;
  if (!enclosing_loop) {
    depth = -1;
  } else {
    depth = Do_Loop_Depth(enclosing_loop);
  }
  ACCESS_ARRAY *array = (ACCESS_ARRAY *) WN_MAP_Get(LNO_Info_Map,address);
  if (!array) {
    Instrument_Address(address,is_load,num_bytes);
    return;
  }
  BOOL stride1 = TRUE;
  if (array->Too_Messy || (array->Non_Const_Loops() > depth) ) {
    stride1 = FALSE;
  }
  if (array->Num_Vec() > MAX_ARRAY_DIMS) {
    Instrument_Address(address,is_load,num_bytes);
    return;
  }
  for (INT i=0; i<array->Num_Vec()-1; i++) {
    ACCESS_VECTOR *av = array->Dim(i);
    if (av->Loop_Coeff(av->Nest_Depth()-1)) {
      stride1 = FALSE;
    }
  }
  ACCESS_VECTOR *av = array->Dim(i);
  if (av->Loop_Coeff(av->Nest_Depth()-1) != 1) {
    stride1 = FALSE;
  }
  if (!stride1) {
    Instrument_Address(address,is_load,num_bytes);
    return;
  }

  WN *loop = Enclosing_Do_Loop(address);
  if (!loop) {
    Instrument_Address(address,is_load,num_bytes);
    return;
  }
  DO_LOOP_INFO *dli = Get_Do_Loop_Info(loop);
  ACCESS_VECTOR *Step = dli->Step;
  if (!Step->Is_Const() || (Step->Const_Offset != 1)) {
    Instrument_Address(address,is_load,num_bytes);
    return;
  }
  ACCESS_ARRAY *low_array = dli->LB;
  if (low_array->Too_Messy) {
    Instrument_Address(address,is_load,num_bytes);
    return;
  }
  for (i=0; i<low_array->Num_Vec(); i++) {
    ACCESS_VECTOR *av = low_array->Dim(i);
    if (av->Too_Messy) {
      Instrument_Address(address,is_load,num_bytes);
      return;
    }
  }

  WN *trip_count = LWN_Loop_Trip_Count(loop);
  if (!trip_count) {
    Instrument_Address(address,is_load,num_bytes);
    return;
  }


  WN *size = LWN_CreateExp2(
    OPCODE_make_op(OPR_MPY, WN_rtype(trip_count),MTYPE_V),
    trip_count, LWN_Make_Icon(WN_rtype(trip_count),num_bytes));


  // set new_address to point to the first array element
  WN *new_address = LWN_Copy_Tree(address);
  LWN_Copy_Def_Use(address,new_address,Du_Mgr);

  Replace_Ldid_With_Exp_Copy(SYMBOL(WN_start(loop)),new_address,
	WN_kid0(WN_start(loop)),Du_Mgr);

  ST *func;
  if (is_load) {
    func = Create_MemTools_Load();
  } else {
    func = Create_MemTools_Store();
  }
  WN *call = WN_Create(OPC_VCALL,2);
  WN_st(call) = func;
  WN_linenum(call) = WN_linenum(loop);
  WN_kid0(call) = LWN_CreateParm(Pointer_type,new_address,
		Be_Type_Tbl(Pointer_type), WN_PARM_BY_VALUE);
  LWN_Set_Parent(WN_kid0(call),call);
  WN_kid1(call) = LWN_CreateParm(Pointer_type,size,
			Be_Type_Tbl(Pointer_type),WN_PARM_BY_VALUE);
  LWN_Set_Parent(WN_kid1(call),call);
  LWN_Copy_Frequency(call,loop);
  LWN_Insert_Block_Before(LWN_Get_Parent(loop),loop,
	call);


}


// unregister all the local arrays
static void Remove_Locals(STACK_OF_WN *local_arrays,
		STACK_OF_WN *return_points) 
{
  ST *func_st = Create_MemTools_RemoveLocal();
  for (INT i=0; i<return_points->Elements(); i++) {
    WN *return_point = return_points->Bottom_nth(i);
    for (INT j=0; j<local_arrays->Elements(); j++) {
      WN *array = local_arrays->Bottom_nth(j);
      WN *call = WN_Create(OPC_VCALL,1);
      WN_st(call) = func_st;
      WN_kid0(call) = LWN_CreateParm(Pointer_type,LWN_Copy_Tree(array),
	Make_Pointer_Type(Be_Type_Tbl(Pointer_type)),WN_PARM_BY_REFERENCE);
      LWN_Set_Parent(WN_kid0(call),call);
      LWN_Insert_Block_Before(LWN_Get_Parent(return_point),return_point, call);
    }
  }
}

// register a new array, base is the base of the array statement
static void  Process_Base(WN *base, INT num_bytes, STACK_OF_WN *local_arrays)
{
  BOOL is_fortran;
  switch (SYMTAB_src_lang(Current_Symtab)) {
    case SYMTAB_F90_LANG:
    case SYMTAB_F77_LANG:
      is_fortran=TRUE;
      break;
    default: is_fortran=FALSE;
  }

  WN *array = LWN_Get_Parent(base);
  ST *st = WN_st(base);
  BOOL is_local = FALSE;
  if (ST_symtab_id(st) == SYMTAB_id(Current_Symtab)) {
    if (ST_sclass(st) == SCLASS_AUTO || ST_sclass(st) == SCLASS_TEMP) {
      is_local = TRUE;
      local_arrays->Push(base);
    }
  }

  WN *func_nd = base;
  while (LWN_Get_Parent(func_nd)) func_nd = LWN_Get_Parent(func_nd);
  WN *first_statement = WN_first(WN_func_body(func_nd));

  if (!dim_sizes) { // create a local variable that will hold dim sizes
     dim_sizes = 
	Create_Local_Array_ST(Be_Type_Tbl(Pointer_type),MAX_ARRAY_DIMS); 
  }

  // initialize the local variable
  for (INT i=0; i<WN_num_dim(array); i++) {
    WN *dim = WN_array_dim(array,i);
    Is_True(WN_operator(dim) == OPR_INTCONST,
	("Non const dimension for a local or global array "));
    OPCODE op_array = OPCODE_make_op(OPR_ARRAY,Pointer_type,MTYPE_V);
    OPCODE lda_op = OPCODE_make_op(OPR_LDA,Pointer_type,MTYPE_V);
    WN *dim_array = WN_Create(op_array,3);
    WN_element_size(dim_array) = 4;
    WN_array_base(dim_array) = WN_CreateLda(lda_op,0,
	Make_Pointer_Type(ST_type(dim_sizes)) ,dim_sizes);
    LWN_Set_Parent(WN_array_base(dim_array),dim_array);
    if (is_fortran) {
      WN_array_index(dim_array,0) = 
	LWN_Make_Icon(Pointer_type,WN_num_dim(array)-i-1);
    } else {
      WN_array_index(dim_array,0) = LWN_Make_Icon(Pointer_type,i);
    }
    LWN_Set_Parent(WN_array_index(dim_array,0),dim_array);
    WN_array_dim(dim_array,0) = LWN_Make_Icon(Pointer_type,MAX_ARRAY_DIMS);
    LWN_Set_Parent(WN_array_dim(dim_array,0),dim_array);
    WN *store = LWN_CreateIstore(
	OPCODE_make_op(OPR_ISTORE, MTYPE_V, Pointer_type),
	0,Make_Pointer_Type(Be_Type_Tbl(Pointer_type)),
	LWN_Make_Icon(Pointer_type,WN_const_val(dim)),
	dim_array);
    LWN_Insert_Block_Before(LWN_Get_Parent(first_statement),first_statement,
	store);
  }
  ST *func;
  INT func_name_kid = 0;
  if (is_local) {
    func = Create_MemTools_MakeLocal();
    func_name_kid++;
  } else {
    func = Create_MemTools_MakeGlobal();
  }
  WN *call = WN_Create(OPC_VCALL,6+func_name_kid);
  WN_st(call) = func;

  TCON tc = Host_To_Targ_String ( MTYPE_STRING, ST_name(WN_st(base)), strlen(ST_name(WN_st(base)))+1);
  ST *string = Gen_String_Sym ( &tc, MTYPE_To_TY(MTYPE_STRING), FALSE );
  OPCODE lda_op = OPCODE_make_op(OPR_LDA,Pointer_type,MTYPE_V);
  WN *lda = WN_CreateLda(lda_op,0,Make_Pointer_Type(Be_Type_Tbl(MTYPE_U1)),string);

  WN_kid0(call) = LWN_CreateParm(Pointer_type,lda,
	Make_Pointer_Type(Be_Type_Tbl(MTYPE_U1)),WN_PARM_BY_REFERENCE);
  LWN_Set_Parent(WN_kid0(call),call);

  if (func_name_kid) {
    TCON tc = Host_To_Targ_String ( MTYPE_STRING,Cur_PU_Name,
	strlen(Cur_PU_Name)+1);
    ST *string = Gen_String_Sym ( &tc, MTYPE_To_TY(MTYPE_STRING), FALSE );
    OPCODE lda_op = OPCODE_make_op(OPR_LDA,Pointer_type,MTYPE_V);
    WN *lda = WN_CreateLda(lda_op,0,
		Make_Pointer_Type(Be_Type_Tbl(MTYPE_U1)),string);

    WN_kid1(call) = LWN_CreateParm(Pointer_type,lda,
	Make_Pointer_Type(Be_Type_Tbl(MTYPE_U1)),WN_PARM_BY_REFERENCE);
    LWN_Set_Parent(WN_kid1(call),call);
  }

  WN *address = LWN_Copy_Tree(base);
  WN_kid(call,1+func_name_kid) =
    LWN_CreateParm(Pointer_type,address,Be_Type_Tbl(Pointer_type),
			WN_PARM_BY_VALUE);
  LWN_Set_Parent(WN_kid(call,1+func_name_kid),call);

  WN_kid(call,2+func_name_kid) =LWN_CreateParm(MTYPE_U4,
			LWN_Make_Icon(MTYPE_I4,WN_num_dim(array)),
			Be_Type_Tbl(MTYPE_I4), WN_PARM_BY_VALUE);
  LWN_Set_Parent(WN_kid(call,2+func_name_kid),call);

  WN_kid(call,3+func_name_kid) =LWN_CreateParm(Pointer_type,
			LWN_Make_Icon(Pointer_type,num_bytes),
			Be_Type_Tbl(Pointer_type), WN_PARM_BY_VALUE);
  LWN_Set_Parent(WN_kid(call,3+func_name_kid),call);

  lda_op = OPCODE_make_op(OPR_LDA,Pointer_type,MTYPE_V);
  lda = WN_CreateLda(lda_op,0,Make_Pointer_Type(ST_type(dim_sizes)),dim_sizes);
  WN_kid(call,4+func_name_kid) = LWN_CreateParm(Pointer_type,lda,
    Make_Pointer_Type(Be_Type_Tbl(Pointer_type)),WN_PARM_BY_REFERENCE);
  LWN_Set_Parent(WN_kid(call,4+func_name_kid),call);

  WN_kid(call,5+func_name_kid) = 
	LWN_CreateParm(MTYPE_I4,LWN_Make_Icon(MTYPE_I4,!is_fortran),
	Be_Type_Tbl(MTYPE_I4),WN_PARM_BY_VALUE);
  LWN_Set_Parent(WN_kid(call,5+func_name_kid),call);

  LWN_Insert_Block_Before(LWN_Get_Parent(first_statement),first_statement,
	call);

}


static ST* Create_Local_Array_ST (TY* ty, INT num) {
  char name[64];
  ST *st;
  TY *arr_ty;
  ARI *ari;
  
  ari = New_ARI (1, FALSE);
  ARI_etype(ari) = ty;
  ARB_const_lbnd(ARI_bnd(ari, 0)) = TRUE;
  ARB_const_ubnd(ARI_bnd(ari, 0)) = TRUE;
  ARB_const_stride(ARI_bnd(ari, 0)) = TRUE;
  ARB_lbnd_val(ARI_bnd(ari, 0)) = 0;
  ARB_ubnd_val(ARI_bnd(ari, 0)) = num-1;
  ARB_stride_val(ARI_bnd(ari, 0)) = 1;
  

  arr_ty = New_TY(FALSE);
  TY_kind(arr_ty) = KIND_ARRAY;
  TY_btype(arr_ty) = MTYPE_M;
  TY_arinfo(arr_ty) = ari;
  sprintf (name, "tmp_num_dims");
  TY_name(arr_ty) = Save_Str(name);
  TY_size(arr_ty) = TY_size(ty)*num;
  TY_align(arr_ty) = 8;
  Enter_TY(arr_ty);
  

  st = New_ST(FALSE);
  ST_name(st) = Save_Str(name);
  ST_class(st) = CLASS_VAR;
  Set_ST_sclass(st, SCLASS_AUTO);
  Set_ST_is_temp_var(st);
  ST_type(st) = arr_ty;
  Enter_ST (st);
  Set_ST_pt_to_unique_mem(st);
  return st;
}

#endif
