void Fortran::append_module_to_scope(TL::Symbol module,
TL::Scope scope)
{
ERROR_CONDITION(!module.is_valid() || !module.is_fortran_module(), "Symbol must be a Fortran module", 0);
scope_entry_t* used_modules_info
= ::get_or_create_used_modules_symbol_info(scope.get_decl_context());
P_LIST_ADD_ONCE(used_modules_info->entity_specs.related_symbols,
used_modules_info->entity_specs.num_related_symbols,
module.get_internal_symbol());
if (!module.get_internal_symbol()->entity_specs.is_builtin)
fortran_load_module(module.get_internal_symbol()->symbol_name, /* intrinsic */ 0, make_locus("", 0, 0));
}
TL::Symbol LoweringVisitor::create_basic_reduction_function_fortran(OpenMP::Reduction* red, Nodecl::NodeclBase construct)
{
reduction_map_t::iterator it = _basic_reduction_map_openmp.find(red);
if (it != _basic_reduction_map_openmp.end())
{
return it->second;
}
std::string fun_name;
{
std::stringstream ss;
ss << "nanos_red_" << red << "_" << simple_hash_str(construct.get_filename().c_str());
fun_name = ss.str();
}
Nodecl::NodeclBase function_body;
Source src;
src << "SUBROUTINE " << fun_name << "(omp_out, omp_in, num_scalars)\n"
<< "IMPLICIT NONE\n"
<< as_type(red->get_type()) << " :: omp_out(num_scalars)\n"
<< as_type(red->get_type()) << " :: omp_in(num_scalars)\n"
<< "INTEGER, VALUE :: num_scalars\n"
<< "INTEGER :: I\n"
<< statement_placeholder(function_body) << "\n"
<< "END SUBROUTINE " << fun_name << "\n";
;
Nodecl::NodeclBase function_code = src.parse_global(construct);
TL::Scope inside_function = ReferenceScope(function_body).get_scope();
TL::Symbol param_omp_in = inside_function.get_symbol_from_name("omp_in");
ERROR_CONDITION(!param_omp_in.is_valid(), "Symbol omp_in not found", 0);
TL::Symbol param_omp_out = inside_function.get_symbol_from_name("omp_out");
ERROR_CONDITION(!param_omp_out.is_valid(), "Symbol omp_out not found", 0);
TL::Symbol function_sym = inside_function.get_symbol_from_name(fun_name);
ERROR_CONDITION(!function_sym.is_valid(), "Symbol %s not found", fun_name.c_str());
TL::Symbol index = inside_function.get_symbol_from_name("i");
ERROR_CONDITION(!index.is_valid(), "Symbol %s not found", "i");
TL::Symbol num_scalars = inside_function.get_symbol_from_name("num_scalars");
ERROR_CONDITION(!num_scalars.is_valid(), "Symbol %s not found", "num_scalars");
Nodecl::NodeclBase num_scalars_ref = Nodecl::Symbol::make(num_scalars);
num_scalars_ref.set_type(num_scalars.get_type().no_ref().get_lvalue_reference_to());
Nodecl::Symbol nodecl_index = Nodecl::Symbol::make(index);
nodecl_index.set_type(index.get_type().get_lvalue_reference_to());
Nodecl::NodeclBase loop_header = Nodecl::RangeLoopControl::make(
nodecl_index,
const_value_to_nodecl(const_value_get_signed_int(1)),
num_scalars_ref,
Nodecl::NodeclBase::null());
Nodecl::NodeclBase expanded_combiner =
red->get_combiner().shallow_copy();
BasicReductionExpandVisitor expander_visitor(
red->get_omp_in(),
param_omp_in,
red->get_omp_out(),
param_omp_out,
index);
expander_visitor.walk(expanded_combiner);
function_body.replace(
Nodecl::ForStatement::make(loop_header,
Nodecl::List::make(
Nodecl::ExpressionStatement::make(
expanded_combiner)),
Nodecl::NodeclBase::null()));
_basic_reduction_map_openmp[red] = function_sym;
if (IS_FORTRAN_LANGUAGE)
{
Nodecl::Utils::Fortran::append_used_modules(construct.retrieve_context(),
function_sym.get_related_scope());
}
Nodecl::Utils::append_to_enclosing_top_level_location(construct, function_code);
return function_sym;
}