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