Type Type::fix_references_()
    {
        if ((IS_C_LANGUAGE && this->is_any_reference())
                || (IS_CXX_LANGUAGE && this->is_rebindable_reference()))
        {
            TL::Type ref = this->references_to();
            if (ref.is_array())
            {
                // T (&a)[10] -> T * const
                // T (&a)[10][20] -> T (* const)[20]
                ref = ref.array_element();
            }

            // T &a -> T * const a
            TL::Type ptr = ref.get_pointer_to();
            if (!this->is_rebindable_reference())
            {
                ptr = ptr.get_const_type();
            }
            return ptr;
        }
        else if (IS_FORTRAN_LANGUAGE && this->is_any_reference())
        {
            return this->references_to();
        }
        else if (this->is_array())
        {
            if (this->array_is_region())
            {
                Nodecl::NodeclBase lb, reg_lb, ub, reg_ub;
                this->array_get_bounds(lb, ub);
                this->array_get_region_bounds(reg_lb, reg_ub);
                TL::Scope sc = array_type_get_region_size_expr_context(this->get_internal_type());

                return this->array_element().fix_references_().get_array_to_with_region(lb, ub, reg_lb, reg_ub, sc);
            }
            else
            {
                Nodecl::NodeclBase size = this->array_get_size();
                TL::Scope sc = array_type_get_array_size_expr_context(this->get_internal_type());

                return this->array_element().fix_references_().get_array_to(size, sc);
            }
        }
        else if (this->is_pointer())
        {
            TL::Type fixed = this->points_to().fix_references_().get_pointer_to();

            cv_qualifier_t cv_qualif = CV_NONE;
            ::advance_over_typedefs_with_cv_qualif(this->get_internal_type(), &cv_qualif);

            fixed = ::get_cv_qualified_type(fixed.get_internal_type(), cv_qualif);

            return fixed;
        }
        else if (this->is_function())
        {
            // Do not fix unprototyped functions
            if (this->lacks_prototype())
                return (*this);

            cv_qualifier_t cv_qualif = CV_NONE;
            ::advance_over_typedefs_with_cv_qualif(this->get_internal_type(), &cv_qualif);

            ref_qualifier_t ref_qualifier = function_type_get_ref_qualifier(this->get_internal_type());
            TL::Type fixed_result = this->returns().fix_references_();
            bool has_ellipsis = 0;

            TL::ObjectList<TL::Type> fixed_parameters = this->parameters(has_ellipsis);
            for (TL::ObjectList<TL::Type>::iterator it = fixed_parameters.begin();
                    it != fixed_parameters.end();
                    it++)
            {
                *it = it->fix_references_();
            }

            TL::ObjectList<TL::Type> nonadjusted_fixed_parameters = this->nonadjusted_parameters();
            for (TL::ObjectList<TL::Type>::iterator it = nonadjusted_fixed_parameters.begin();
                    it != nonadjusted_fixed_parameters.end();
                    it++)
            {
                *it = it->fix_references_();
            }

            TL::Type fixed_function = fixed_result.get_function_returning(
                    fixed_parameters,
                    nonadjusted_fixed_parameters,
                    has_ellipsis,
                    ref_qualifier);

            fixed_function = TL::Type(get_cv_qualified_type(fixed_function.get_internal_type(), cv_qualif));

            return fixed_function;
        }
        // Note: we are not fixing classes
        else
        {
            // Anything else must be left untouched
            return (*this);
        }
    }
    static TL::Symbol create_initializer_function_fortran(
            OpenMP::Reduction* red,
            TL::Type reduction_type,
            Nodecl::NodeclBase construct)
    {
        std::string fun_name;
        {
            std::stringstream ss;
            ss << "nanos_ini_" << red << "_" << reduction_type.get_internal_type() << "_" << simple_hash_str(construct.get_filename().c_str());
            fun_name = ss.str();
        }

        Nodecl::NodeclBase initializer = red->get_initializer().shallow_copy();


        TL::Type omp_out_type = reduction_type,
                 omp_ori_type = reduction_type;

        // These sources are only used in array reductions
        TL::Source omp_out_extra_attributes,
            extra_stuff_array_red;

        if (reduction_type.is_array())
        {
            Source dims_descr;
            TL::Type t = reduction_type;
            int rank = 0;
            if (t.is_fortran_array())
            {
                rank = t.fortran_rank();
            }

            dims_descr << "(";
            omp_out_extra_attributes << ", POINTER, DIMENSION(";

            int i;
            for (i = 0; i < rank; i++)
            {
                if (i != 0)
                {
                    dims_descr << ",";
                    omp_out_extra_attributes << ",";
                }

                dims_descr << "LBOUND(omp_orig, DIM = " << (rank - i) << ")"
                    << ":"
                    << "UBOUND(omp_orig, DIM = " << (rank - i) << ")"
                    ;

                omp_out_extra_attributes << ":";
                t = t.array_element();
            }

            dims_descr << ")";
            omp_out_extra_attributes << ")";

            omp_out_type = t;

            extra_stuff_array_red << "ALLOCATE(omp_out" << dims_descr <<")\n";
        }

        Source src;
        src << "SUBROUTINE " << fun_name << "(omp_out, omp_orig)\n"
            <<    "IMPLICIT NONE\n"
            <<    as_type(omp_out_type) << omp_out_extra_attributes << " ::  omp_out\n"
            <<    as_type(omp_ori_type) <<  " :: omp_orig\n"
            <<    extra_stuff_array_red
            <<    "omp_out = " << as_expression(initializer) << "\n"
            << "END SUBROUTINE " << fun_name << "\n"
            ;

        TL::Scope global_scope = construct.retrieve_context().get_global_scope();
        Nodecl::NodeclBase function_code = src.parse_global(global_scope);
        TL::Symbol function_sym = global_scope.get_symbol_from_name(fun_name);

        ERROR_CONDITION(!function_sym.is_valid(), "Symbol %s not found", fun_name.c_str());

        // As the initializer function is needed during the instantiation of
        // the task, this function should be inserted before the construct
        Nodecl::Utils::prepend_to_enclosing_top_level_location(construct,
                function_code);

        return function_sym;
    }
Example #3
0
    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;
        }
    }