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);
}
void LoweringVisitor::perform_partial_reduction(OutlineInfo& outline_info, Nodecl::NodeclBase ref_tree)
{
ERROR_CONDITION(ref_tree.is_null(), "Invalid tree", 0);
Source reduction_code;
TL::ObjectList<OutlineDataItem*> reduction_items = outline_info.get_data_items().filter(
predicate(lift_pointer(functor(&OutlineDataItem::is_reduction))));
if (!reduction_items.empty())
{
for (TL::ObjectList<OutlineDataItem*>::iterator it = reduction_items.begin();
it != reduction_items.end();
it++)
{
if (IS_C_LANGUAGE || IS_CXX_LANGUAGE)
{
if ((*it)->get_private_type().is_array())
{
reduction_code
<< "__builtin_memcpy(rdv_" << (*it)->get_field_name() << "[nanos_omp_get_thread_num()],"
<< "rdp_" << (*it)->get_symbol().get_name() << ","
<< " sizeof(" << as_type((*it)->get_private_type()) << "));"
;
}
else
{
reduction_code
<< "rdv_" << (*it)->get_field_name() << "[nanos_omp_get_thread_num()] "
<< "= rdp_" << (*it)->get_symbol().get_name() << ";"
;
}
}
else if (IS_FORTRAN_LANGUAGE)
{
Source extra_dims;
{
TL::Type t = (*it)->get_symbol().get_type().no_ref();
int rank = 0;
if (t.is_fortran_array())
{
rank = t.fortran_rank();
}
int i;
for (i = 0; i < rank; i++)
{
extra_dims << ":,";
}
}
reduction_code
<< "rdv_" << (*it)->get_field_name() << "( " << extra_dims << "nanos_omp_get_thread_num() ) = rdp_" << (*it)->get_symbol().get_name() << "\n"
;
}
else
{
internal_error("Code unreachable", 0);
}
}
}
ref_tree.replace(reduction_code.parse_statement(ref_tree));
}
void LoweringVisitor::reduction_initialization_code(
OutlineInfo& outline_info,
Nodecl::NodeclBase ref_tree,
Nodecl::NodeclBase construct)
{
ERROR_CONDITION(ref_tree.is_null(), "Invalid tree", 0);
if (!Nanos::Version::interface_is_at_least("master", 5023))
{
running_error("%s: error: a newer version of Nanos++ (>=5023) is required for reductions support\n",
construct.get_locus_str().c_str());
}
TL::ObjectList<OutlineDataItem*> reduction_items = outline_info.get_data_items().filter(
predicate(lift_pointer(functor(&OutlineDataItem::is_reduction))));
ERROR_CONDITION (reduction_items.empty(), "No reductions to process", 0);
Source result;
Source reduction_declaration,
thread_initializing_reduction_info,
thread_fetching_reduction_info;
result
<< reduction_declaration
<< "{"
<< as_type(get_bool_type()) << " red_single_guard;"
<< "nanos_err_t err;"
<< "err = nanos_enter_sync_init(&red_single_guard);"
<< "if (err != NANOS_OK)"
<< "nanos_handle_error(err);"
<< "if (red_single_guard)"
<< "{"
<< "int nanos_num_threads = nanos_omp_get_num_threads();"
<< thread_initializing_reduction_info
<< "err = nanos_release_sync_init();"
<< "if (err != NANOS_OK)"
<< "nanos_handle_error(err);"
<< "}"
<< "else"
<< "{"
<< "err = nanos_wait_sync_init();"
<< "if (err != NANOS_OK)"
<< "nanos_handle_error(err);"
<< thread_fetching_reduction_info
<< "}"
<< "}"
;
for (TL::ObjectList<OutlineDataItem*>::iterator it = reduction_items.begin();
it != reduction_items.end();
it++)
{
std::string nanos_red_name = "nanos_red_" + (*it)->get_symbol().get_name();
std::pair<OpenMP::Reduction*, TL::Type> reduction_info = (*it)->get_reduction_info();
OpenMP::Reduction* reduction = reduction_info.first;
TL::Type reduction_type = reduction_info.second;
if (reduction_type.is_any_reference())
reduction_type = reduction_type.references_to();
TL::Type reduction_element_type = reduction_type;
if (IS_FORTRAN_LANGUAGE)
{
while (reduction_element_type.is_fortran_array())
reduction_element_type = reduction_element_type.array_element();
}
else
{
while (reduction_element_type.is_array())
reduction_element_type = reduction_element_type.array_element();
}
Source element_size;
if (IS_FORTRAN_LANGUAGE)
{
if (reduction_type.is_fortran_array())
{
// We need to parse this bit in Fortran
Source number_of_bytes;
number_of_bytes << "SIZE(" << (*it)->get_symbol().get_name() << ") * " << reduction_element_type.get_size();
element_size << as_expression(number_of_bytes.parse_expression(construct));
}
else
{
element_size << "sizeof(" << as_type(reduction_type) << ")";
}
}
else
{
element_size << "sizeof(" << as_type(reduction_type) << ")";
}
reduction_declaration
<< "nanos_reduction_t* " << nanos_red_name << ";"
;
Source allocate_private_buffer, cleanup_code;
Source num_scalars;
TL::Symbol basic_reduction_function, vector_reduction_function;
create_reduction_function(reduction, construct, reduction_type, basic_reduction_function, vector_reduction_function);
(*it)->reduction_set_basic_function(basic_reduction_function);
thread_initializing_reduction_info
<< "err = nanos_malloc((void**)&" << nanos_red_name << ", sizeof(nanos_reduction_t), "
<< "\"" << construct.get_filename() << "\", " << construct.get_line() << ");"
<< "if (err != NANOS_OK)"
<< "nanos_handle_error(err);"
<< nanos_red_name << "->original = (void*)"
<< (reduction_type.is_array() ? "" : "&") << (*it)->get_symbol().get_name() << ";"
<< allocate_private_buffer
<< nanos_red_name << "->vop = "
<< (vector_reduction_function.is_valid() ? as_symbol(vector_reduction_function) : "0") << ";"
<< nanos_red_name << "->bop = (void(*)(void*,void*,int))" << as_symbol(basic_reduction_function) << ";"
<< nanos_red_name << "->element_size = " << element_size << ";"
<< nanos_red_name << "->num_scalars = " << num_scalars << ";"
<< cleanup_code
<< "err = nanos_register_reduction(" << nanos_red_name << ");"
<< "if (err != NANOS_OK)"
<< "nanos_handle_error(err);"
;
if (IS_C_LANGUAGE
|| IS_CXX_LANGUAGE)
{
if (reduction_type.is_array())
{
num_scalars << "sizeof(" << as_type(reduction_type) << ") / sizeof(" << as_type(reduction_element_type) <<")";
}
else
{
num_scalars << "1";
}
allocate_private_buffer
<< "err = nanos_malloc(&" << nanos_red_name << "->privates, sizeof(" << as_type(reduction_type) << ") * nanos_num_threads, "
<< "\"" << construct.get_filename() << "\", " << construct.get_line() << ");"
<< "if (err != NANOS_OK)"
<< "nanos_handle_error(err);"
<< nanos_red_name << "->descriptor = " << nanos_red_name << "->privates;"
<< "rdv_" << (*it)->get_field_name() << " = (" << as_type( (*it)->get_private_type().get_pointer_to() ) << ")" << nanos_red_name << "->privates;"
;
thread_fetching_reduction_info
<< "err = nanos_reduction_get(&" << nanos_red_name << ", "
<< (reduction_type.is_array() ? "" : "&") << (*it)->get_symbol().get_name() << ");"
<< "if (err != NANOS_OK)"
<< "nanos_handle_error(err);"
<< "rdv_" << (*it)->get_field_name() << " = (" << as_type( (*it)->get_private_type().get_pointer_to() ) << ")" << nanos_red_name << "->privates;"
;
cleanup_code
<< nanos_red_name << "->cleanup = nanos_free0;"
;
}
else if (IS_FORTRAN_LANGUAGE)
{
Type private_reduction_vector_type;
Source extra_dims;
{
TL::Type t = (*it)->get_symbol().get_type().no_ref();
int rank = 0;
if (t.is_fortran_array())
{
rank = t.fortran_rank();
}
if (rank != 0)
{
// We need to parse this bit in Fortran
Source size_call;
size_call << "SIZE(" << (*it)->get_symbol().get_name() << ")";
num_scalars << as_expression(size_call.parse_expression(construct));
}
else
{
num_scalars << "1";
}
private_reduction_vector_type = fortran_get_n_ranked_type_with_descriptor(
get_void_type(), rank + 1, construct.retrieve_context().get_decl_context());
int i;
for (i = 0; i < rank; i++)
{
Source lbound_src;
lbound_src << "LBOUND(" << (*it)->get_symbol().get_name() << ", DIM = " << (rank - i) << ")";
Source ubound_src;
ubound_src << "UBOUND(" << (*it)->get_symbol().get_name() << ", DIM = " << (rank - i) << ")";
extra_dims
<< "["
<< as_expression(lbound_src.parse_expression(construct))
<< ":"
<< as_expression(ubound_src.parse_expression(construct))
<< "]";
t = t.array_element();
}
}
allocate_private_buffer
<< "@FORTRAN_ALLOCATE@((*rdv_" << (*it)->get_field_name() << ")[0:(nanos_num_threads-1)]" << extra_dims <<");"
<< nanos_red_name << "->privates = &(*rdv_" << (*it)->get_field_name() << ");"
<< "err = nanos_malloc(&" << nanos_red_name << "->descriptor, sizeof(" << as_type(private_reduction_vector_type) << "), "
<< "\"" << construct.get_filename() << "\", " << construct.get_line() << ");"
<< "if (err != NANOS_OK)"
<< "nanos_handle_error(err);"
<< "err = nanos_memcpy(" << nanos_red_name << "->descriptor, "
"&rdv_" << (*it)->get_field_name() << ", sizeof(" << as_type(private_reduction_vector_type) << "));"
<< "if (err != NANOS_OK)"
<< "nanos_handle_error(err);"
;
thread_fetching_reduction_info
<< "err = nanos_reduction_get(&" << nanos_red_name << ", &" << (*it)->get_symbol().get_name() << ");"
<< "if (err != NANOS_OK)"
<< "nanos_handle_error(err);"
<< "err = nanos_memcpy("
<< "&rdv_" << (*it)->get_field_name() << ","
<< nanos_red_name << "->descriptor, "
<< "sizeof(" << as_type(private_reduction_vector_type) << "));"
<< "if (err != NANOS_OK)"
<< "nanos_handle_error(err);"
;
TL::Symbol reduction_cleanup = create_reduction_cleanup_function(reduction, construct);
cleanup_code
<< nanos_red_name << "->cleanup = " << as_symbol(reduction_cleanup) << ";"
;
}
else
{
internal_error("Code unreachable", 0);
}
}
FORTRAN_LANGUAGE()
{
Source::source_language = SourceLanguage::C;
}
ref_tree.replace(result.parse_statement(ref_tree));
FORTRAN_LANGUAGE()
{
Source::source_language = SourceLanguage::Current;
}
}
bool LoweringVisitor::there_are_reductions(OutlineInfo& outline_info)
{
TL::ObjectList<OutlineDataItem*> reduction_items = outline_info.get_data_items().filter(
predicate(lift_pointer(functor(&OutlineDataItem::is_reduction))));
return !reduction_items.empty();
}
void LoweringVisitor::perform_partial_reduction_slicer(OutlineInfo& outline_info,
Nodecl::NodeclBase ref_tree,
Nodecl::Utils::SimpleSymbolMap*& symbol_map)
{
ERROR_CONDITION(ref_tree.is_null(), "Invalid tree", 0);
TL::ObjectList<OutlineDataItem*> reduction_items = outline_info.get_data_items().filter(
lift_pointer<bool, OutlineDataItem>(&OutlineDataItem::is_reduction));
if (!reduction_items.empty())
{
TL::ObjectList<Nodecl::NodeclBase> reduction_stmts;
Nodecl::Utils::SimpleSymbolMap* simple_symbol_map = new Nodecl::Utils::SimpleSymbolMap(symbol_map);
symbol_map = simple_symbol_map;
for (TL::ObjectList<OutlineDataItem*>::iterator it = reduction_items.begin();
it != reduction_items.end();
it++)
{
scope_entry_t* shared_symbol = (*it)->get_symbol().get_internal_symbol();
// We need this to avoid the original symbol be replaced
// incorrectly
scope_entry_t* shared_symbol_proxy = NEW0(scope_entry_t);
shared_symbol_proxy->symbol_name = UNIQUESTR_LITERAL("<<reduction-variable>>"); // Crude way to ensure it is replaced
shared_symbol_proxy->kind = shared_symbol->kind;
symbol_entity_specs_copy_from(shared_symbol_proxy, shared_symbol);
shared_symbol_proxy->decl_context = shared_symbol->decl_context;
shared_symbol_proxy->type_information = shared_symbol->type_information;
shared_symbol_proxy->locus = shared_symbol->locus;
simple_symbol_map->add_map( shared_symbol_proxy,
(*it)->reduction_get_shared_symbol_in_outline() );
Source reduction_code;
Nodecl::NodeclBase partial_reduction_code;
reduction_code
<< "{"
<< "nanos_lock_t* red_lock;"
<< "nanos_err_t nanos_err;"
<< "nanos_err = nanos_get_lock_address("
<< ((*it)->get_private_type().is_array() ? "" : "&")
<< as_symbol( shared_symbol_proxy ) << ", &red_lock);"
<< "if (nanos_err != NANOS_OK) nanos_handle_error(nanos_err);"
<< "nanos_err = nanos_set_lock(red_lock);"
<< "if (nanos_err != NANOS_OK) nanos_handle_error(nanos_err);"
<< statement_placeholder(partial_reduction_code)
<< "nanos_err = nanos_unset_lock(red_lock);"
<< "if (nanos_err != NANOS_OK) nanos_handle_error(nanos_err);"
<< "}"
;
FORTRAN_LANGUAGE()
{
Source::source_language = SourceLanguage::C;
}
Nodecl::NodeclBase statement = reduction_code.parse_statement(ref_tree);
FORTRAN_LANGUAGE()
{
Source::source_language = SourceLanguage::Current;
}
ERROR_CONDITION(!statement.is<Nodecl::List>(), "Expecting a list", 0);
reduction_stmts.append(statement.as<Nodecl::List>()[0]);
TL::Type elemental_type = (*it)->get_private_type();
while (elemental_type.is_array())
elemental_type = elemental_type.array_element();
Source partial_reduction_code_src;
if (IS_C_LANGUAGE || IS_CXX_LANGUAGE)
{
partial_reduction_code_src
<< as_symbol( (*it)->reduction_get_basic_function() ) << "("
// This will be the reduction shared
<< ((*it)->get_private_type().is_array() ? "" : "&")
<< as_symbol( shared_symbol_proxy ) << ", "
// This will be the reduction private var
<< ((*it)->get_private_type().is_array() ? "" : "&")
<< as_symbol( (*it)->get_symbol() ) << ", "
<< ((*it)->get_private_type().is_array() ?
(
"sizeof(" + as_type( (*it)->get_private_type()) + ")"
"/ sizeof(" + as_type(elemental_type) + ")"
)
: "1")
<< ");"
;
}
else if (IS_FORTRAN_LANGUAGE)
{
// We use an ELEMENTAL call here
partial_reduction_code_src
<< "CALL " << as_symbol ( (*it)->reduction_get_basic_function() ) << "("
// This will be the reduction shared
<< as_symbol( shared_symbol_proxy ) << ", "
// This will be the reduction private var
<< as_symbol( (*it)->get_symbol() )
<< ")"
;
}
else
{
internal_error("Code unreachable", 0);
}
partial_reduction_code.replace(
partial_reduction_code_src.parse_statement(partial_reduction_code));
}
ref_tree.replace(
Nodecl::CompoundStatement::make(
Nodecl::List::make(reduction_stmts),
Nodecl::NodeclBase::null()
)
);
}
