char fortran_are_conformable_types(type_t* t1, type_t* t2)
{
t1 = no_ref(t1);
t2 = no_ref(t2);
if (fortran_get_rank_of_type(t1) == fortran_get_rank_of_type(t2))
return 1;
else if (fortran_get_rank_of_type(t1) == 1
|| fortran_get_rank_of_type(t2) == 1)
return 1;
else
return 0;
}
char fortran_equivalent_tkr_types(type_t* t1, type_t* t2)
{
if (!fortran_equivalent_tk_types(t1, t2))
return 0;
int rank1 = fortran_get_rank_of_type(t1);
int rank2 = fortran_get_rank_of_type(t2);
if (rank1 != rank2)
return 0;
return 1;
}
int Type::fortran_rank() const
{
if (!is_fortran_array())
return 0;
else
return (fortran_get_rank_of_type(_type_info));
}
void LoweringVisitor::register_reductions(
Nodecl::NodeclBase construct, OutlineInfo& outline_info, TL::Source& src)
{
TL::ObjectList<OutlineDataItem*> data_items = outline_info.get_data_items();
for (TL::ObjectList<OutlineDataItem*>::iterator it = data_items.begin();
it != data_items.end();
it++)
{
if (!(*it)->is_reduction())
continue;
std::pair<TL::OpenMP::Reduction*, TL::Type> red_info_pair = (*it)->get_reduction_info();
TL::OpenMP::Reduction* reduction_info = red_info_pair.first;
TL::Type reduction_type = red_info_pair.second.no_ref();
ERROR_CONDITION(!Nanos::Version::interface_is_at_least("task_reduction", 1001),
"The version of the runtime being used does not support task reductions", 0);
TL::Symbol reduction_item = (*it)->get_symbol();
ERROR_CONDITION(reduction_type.is_array()
&& (IS_C_LANGUAGE || IS_CXX_LANGUAGE)
&& !Nanos::Version::interface_is_at_least("task_reduction", 1002),
"The version of the runtime being used does not support array reductions in C/C++", 0);
// Note that at this point all the reduction must be registered.
// For C/C++ array reductions, the registered_reduction type is the
// element type
TL::Type registered_reduction_type = reduction_type;
while (!IS_FORTRAN_LANGUAGE
&& registered_reduction_type.is_array())
{
registered_reduction_type = registered_reduction_type.array_element();
}
LoweringVisitor::reduction_task_map_t::iterator task_red_info =
_task_reductions_map.find(std::make_pair(reduction_info, registered_reduction_type));
ERROR_CONDITION(task_red_info == _task_reductions_map.end(),
"Unregistered task reduction\n", 0);
TL::Symbol reduction_function = task_red_info->second._reducer;
TL::Symbol reduction_function_original_var = task_red_info->second._reducer_orig_var;
TL::Symbol initializer_function = task_red_info->second._initializer;
// Common case: the runtime will host the private copies of the list item
if (!(IS_FORTRAN_LANGUAGE && reduction_type.is_array()))
{
// Array Reductions in C/C++ are defined over the elements of the array
TL::Source reduction_size_src_opt;
TL::Type element_type = registered_reduction_type;
reduction_size_src_opt << "sizeof(" << as_type(reduction_type) <<"),";
TL::Source item_address =
(reduction_item.get_type().is_pointer() ? "" : "&") + (*it)->get_field_name();
src
<< "nanos_err = nanos_task_reduction_register("
<< "(void *) " << item_address << "," // object address
<< reduction_size_src_opt // whole reduction size
<< "sizeof(" << as_type(element_type) << ")," // element size
<< "(void (*)(void *, void *)) &"
<< initializer_function.get_name() << "," // initializer
<< "(void (*)(void *, void *)) &"
<< reduction_function.get_name() << ");" // reducer
;
}
else
{
// Specific case for Fortran Array Reductions: the runtime will
// host a private array descriptor for each thread. Later, in
// the initializer function, this array descriptors will be
// initialized and their array storage will be allocated
TL::Source target_address;
size_t size_array_descriptor =
fortran_size_of_array_descriptor(
fortran_get_rank0_type(reduction_type.get_internal_type()),
fortran_get_rank_of_type(reduction_type.get_internal_type()));
if (reduction_type.array_requires_descriptor())
{
TL::Symbol ptr_of_sym = get_function_ptr_of(reduction_item, construct.retrieve_context());
target_address << ptr_of_sym.get_name() << "( " << (*it)->get_symbol().get_name() << ")";
}
else
{
target_address << "(void *) &" << (*it)->get_field_name();
}
src
<< "nanos_err = nanos_task_fortran_array_reduction_register("
<< target_address << "," // Address to the array descriptor
<< "(void *) & " << (*it)->get_field_name() << "," // Address to the storage
<< size_array_descriptor << "," // size
<< "(void (*)(void *, void *)) &"
<< initializer_function.get_name() << "," // initializer
<< "(void (*)(void *, void *)) &"
<< reduction_function.get_name() << "," // reducer
<< "(void (*)(void *, void *)) &"
<< reduction_function_original_var.get_name() << ");" // reducer ori
;
}
}
}
bool LoweringVisitor::handle_reductions_on_task(
Nodecl::NodeclBase construct,
OutlineInfo& outline_info,
Nodecl::NodeclBase statements,
bool generate_final_stmts,
Nodecl::NodeclBase& final_statements)
{
int num_reductions = 0;
TL::Source
reductions_stuff,
final_clause_stuff,
// This source represents an expression which is used to check if
// we can do an optimization in the final code. This optimization
// consists on calling the original code (with a serial closure) if
// we are in a final context and the reduction variables that we
// are using have not been registered previously
final_clause_opt_expr,
extra_array_red_memcpy;
std::map<TL::Symbol, std::string> reduction_symbols_map;
TL::ObjectList<OutlineDataItem*> data_items = outline_info.get_data_items();
for (TL::ObjectList<OutlineDataItem*>::iterator it = data_items.begin();
it != data_items.end();
it++)
{
if (!(*it)->is_reduction())
continue;
std::pair<TL::OpenMP::Reduction*, TL::Type> red_info_pair = (*it)->get_reduction_info();
TL::OpenMP::Reduction* reduction_info = red_info_pair.first;
TL::Type reduction_type = red_info_pair.second.no_ref();
TL::Symbol reduction_item = (*it)->get_symbol();
TL::Type reduction_item_type = reduction_item.get_type().no_ref();
std::string storage_var_name = (*it)->get_field_name() + "_storage";
TL::Type storage_var_type = reduction_type.get_pointer_to();
TL::Symbol reduction_function, reduction_function_original_var, initializer_function;
// Checking if the current reduction type has been treated before
// Note that if that happens we can reuse the combiner and
// initializer function.
//
// C/C++: note that if the type of the list item is an array type,
// we regiter the reduction over its element type
TL::Type registered_reduction_type = reduction_type;
while (!IS_FORTRAN_LANGUAGE
&& registered_reduction_type.is_array())
{
registered_reduction_type = registered_reduction_type.array_element();
}
LoweringVisitor::reduction_task_map_t::iterator task_red_info =
_task_reductions_map.find(std::make_pair(reduction_info, registered_reduction_type));
if (task_red_info != _task_reductions_map.end())
{
reduction_function = task_red_info->second._reducer;
reduction_function_original_var = task_red_info->second._reducer_orig_var;
initializer_function = task_red_info->second._initializer;
}
else
{
create_reduction_functions(reduction_info,
construct,
registered_reduction_type,
reduction_item,
reduction_function,
reduction_function_original_var);
create_initializer_function(reduction_info,
construct,
registered_reduction_type,
initializer_function);
_task_reductions_map.insert(
std::make_pair(
std::make_pair(reduction_info, registered_reduction_type),
TaskReductionsInfo(reduction_function, reduction_function_original_var, initializer_function)
));
}
// Mandatory TL::Sources to be filled by any reduction
TL::Source
orig_address, // address of the original reduction variable
storage_var; // variable which holds the address of the storage
// Specific TL::Sources to be filled only by Fortran array reduction
TL::Source extra_array_red_decl;
if (IS_C_LANGUAGE || IS_CXX_LANGUAGE)
{
storage_var << storage_var_name;
orig_address << (reduction_item_type.is_pointer() ? "" : "&") << (*it)->get_field_name();
final_clause_stuff
<< "if (" << storage_var_name << " == 0)"
<< "{"
<< storage_var_name << " = "
<< "(" << as_type(storage_var_type) << ")" << orig_address << ";"
<< "}"
;
}
else
{
orig_address << "&" << (*it)->get_field_name();
if (reduction_item_type.is_array())
{
size_t size_of_array_descriptor =
fortran_size_of_array_descriptor(
fortran_get_rank0_type(reduction_item_type.get_internal_type()),
fortran_get_rank_of_type(reduction_item_type.get_internal_type()));
storage_var << storage_var_name << "_indirect";
extra_array_red_decl << "void *" << storage_var << ";";
extra_array_red_memcpy
<< "nanos_err = nanos_memcpy("
<< "(void **) &" << storage_var_name << ","
<< storage_var << ","
<< size_of_array_descriptor << ");"
;
final_clause_stuff
<< "if (" << storage_var << " == 0)"
<< "{"
<< "nanos_err = nanos_memcpy("
<< "(void **) &" << storage_var_name << ","
<< "(void *) "<< orig_address << ","
<< size_of_array_descriptor << ");"
<< "}"
<< "else"
<< "{"
<< extra_array_red_memcpy
<< "}"
;
}
else
{
// We need to convert a void* type into a pointer to the reduction type.
// As a void* in FORTRAN is represented as an INTEGER(8), we cannot do this
// conversion directly in the FORTRAN source. For this reason we introduce
// a new function that will be defined in a C file.
TL::Symbol func = TL::Nanox::get_function_ptr_conversion(
// Destination
reduction_item_type.get_pointer_to(),
// Origin
TL::Type::get_void_type().get_pointer_to(),
construct.retrieve_context());
storage_var << storage_var_name;
final_clause_stuff
<< "if (" << storage_var << " == 0)"
<< "{"
<< storage_var_name << " = " << func.get_name() << "(" << orig_address << ");"
<< "}"
;
}
}
if (num_reductions > 0)
final_clause_opt_expr << " && ";
final_clause_opt_expr << storage_var << " == 0 ";
num_reductions++;
reductions_stuff
<< extra_array_red_decl
<< as_type(storage_var_type) << " " << storage_var_name << ";"
<< "nanos_err = nanos_task_reduction_get_thread_storage("
<< "(void *)" << orig_address << ","
<< "(void **) &" << storage_var << ");"
;
reduction_symbols_map[reduction_item] = storage_var_name;
}
if (num_reductions != 0)
{
// Generating the final code if needed
if (generate_final_stmts)
{
std::map<Nodecl::NodeclBase, Nodecl::NodeclBase>::iterator it4 = _final_stmts_map.find(construct);
ERROR_CONDITION(it4 == _final_stmts_map.end(), "Unreachable code", 0);
Nodecl::NodeclBase placeholder;
TL::Source new_statements_src;
new_statements_src
<< "{"
<< "nanos_err_t nanos_err;"
<< reductions_stuff
<< "if (" << final_clause_opt_expr << ")"
<< "{"
<< as_statement(it4->second)
<< "}"
<< "else"
<< "{"
<< final_clause_stuff
<< statement_placeholder(placeholder)
<< "}"
<< "}"
;
final_statements = handle_task_statements(
construct, statements, placeholder, new_statements_src, reduction_symbols_map);
}
// Generating the task code
{
TL::Source new_statements_src;
Nodecl::NodeclBase placeholder;
new_statements_src
<< "{"
<< "nanos_err_t nanos_err;"
<< reductions_stuff
<< extra_array_red_memcpy
<< statement_placeholder(placeholder)
<< "}"
;
Nodecl::NodeclBase new_statements = handle_task_statements(
construct, statements, placeholder, new_statements_src, reduction_symbols_map);
statements.replace(new_statements);
}
}
ERROR_CONDITION(num_reductions != 0 &&
!Nanos::Version::interface_is_at_least("task_reduction", 1001),
"The version of the runtime begin used does not support task reductions", 0);
return (num_reductions != 0);
}
static Symbol create_new_function_opencl_allocate(
Nodecl::NodeclBase expr_stmt,
Symbol subscripted_symbol,
Type element_type,
int num_dimensions,
bool is_allocatable)
{
std::string alloca_or_pointer = is_allocatable ? "ALLOCATABLE" : "POINTER";
TL::Source dummy_arguments_bounds, dimension_attr, allocate_dims;
dimension_attr << "DIMENSION(";
for (int i = 1; i <= num_dimensions; ++i)
{
if (i != 1)
{
allocate_dims << ", ";
dummy_arguments_bounds <<", ";
dimension_attr << ", ";
}
dummy_arguments_bounds <<"LB" << i <<", " << "UB" << i;
dimension_attr << ":";
allocate_dims << "LB" << i << ":" << "UB" << i;
}
dimension_attr << ")";
size_t size_of_array_descriptor =
fortran_size_of_array_descriptor(
fortran_get_rank0_type(subscripted_symbol.get_type().get_internal_type()),
fortran_get_rank_of_type(subscripted_symbol.get_type().get_internal_type()));
TL::Source new_function_name;
new_function_name
<< "NANOX_OPENCL_ALLOCATE_INTERNAL_"
<< (ptrdiff_t) subscripted_symbol.get_internal_symbol()
;
Nodecl::NodeclBase nodecl_body;
TL::Source new_function;
new_function
<< "SUBROUTINE " << new_function_name << "(ARR, " << dummy_arguments_bounds << ")\n"
<< as_type(element_type) << ", " << dimension_attr << ", " << alloca_or_pointer << " :: ARR\n"
<< as_type(element_type) << ", " << dimension_attr << ", ALLOCATABLE :: TMP\n"
<< "INTEGER :: " << dummy_arguments_bounds << "\n"
<< "INTEGER :: ERR \n"
<< "ALLOCATE(TMP(" << allocate_dims << "))\n"
<< statement_placeholder(nodecl_body)
<< "DEALLOCATE(TMP)\n"
<< "END SUBROUTINE " << new_function_name << "\n"
;
Nodecl::NodeclBase function_code = new_function.parse_global(expr_stmt.retrieve_context().get_global_scope());
TL::Scope inside_function = ReferenceScope(nodecl_body).get_scope();
TL::Symbol new_function_sym = inside_function.get_symbol_from_name(strtolower(new_function_name.get_source().c_str()));
TL::Symbol arr_sym = inside_function.get_symbol_from_name("arr");
TL::Symbol tmp_sym = inside_function.get_symbol_from_name("tmp");
TL::Symbol ptr_of_arr_sym = get_function_ptr_of(arr_sym, inside_function);
TL::Symbol ptr_of_tmp_sym = get_function_ptr_of(tmp_sym, inside_function);
TL::Source aux;
aux
<< "ERR = NANOS_MEMCPY("
<< ptr_of_arr_sym.get_name() << "(ARR),"
<< ptr_of_tmp_sym.get_name() << "(TMP),"
<< "INT(" << size_of_array_descriptor << "," << type_get_size(get_ptrdiff_t_type()) << "))\n"
<< "CALL NANOS_OPENCL_ALLOCATE_FORTRAN("
<< "SIZEOF(TMP),"
<< ptr_of_arr_sym.get_name() << "(ARR))\n"
;
nodecl_body.replace(aux.parse_statement(inside_function));
Nodecl::Utils::prepend_to_enclosing_top_level_location(expr_stmt, function_code);
return new_function_sym;
}
