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; }