示例#1
0
static bool file_source_is_tarball_backed(Value* file_source)
{
    return is_list(file_source)
        && (list_length(file_source) >= 1)
        && (is_symbol(list_get(file_source, 0)))
        && (as_symbol(list_get(file_source, 0)) == s_Tarball);
}
示例#2
0
文件: print.cpp 项目: shaurz/amp
void print(Value x)
{
	if (is_nil(x))
		prints("nil");
	else if (is_eof(x))
		printf("#eof");
	else if (is_fixnum(x))
		printf("%d", as_fixnum(x));
	else if (is_bool(x))
		printf("%s", as_bool(x) ? "true" : "false");
	else if (is_char(x))
		printf("'%c'", as_char(x));
	else if (is_pair(x))
		print_list(x);
	else if (is_symbol(x))
		prints(as_symbol(x)->value);
	else if (is_string(x))
		print_string(as_string(x));
	else if (is_procedure(x))
		printf("#<procedure %s>", as_procedure(x)->name->value);
	else if (is_module(x))
		printf("#<module>");
	else if (is_type(x))
		printf("#<type %s>", as_type(x)->name->value);
	else if (is_ptr(x))
		printf("#<object %p>", as_ptr(x));
	else if (is_undefined(x))
		printf("#undefined");
	else
		printf("#ufo");
}
示例#3
0
static bool file_source_is_filesystem_backed(Value* file_source)
{
    return is_list(file_source)
        && (list_length(file_source) >= 1)
        && (is_symbol(list_get(file_source, 0)))
        && (as_symbol(list_get(file_source, 0)) == s_Filesystem);
}
示例#4
0
Symbol block_get_symbol_prop(Block* block, Symbol name, Symbol defaultValue)
{
    Value* propVal = block_get_property(block, name);
    if (propVal == NULL)
        return defaultValue;
    return as_symbol(propVal);
}
示例#5
0
Symbol first_symbol(caValue* value)
{
    if (is_symbol(value))
        return as_symbol(value);
    if (is_list(value))
        return first_symbol(list_get(value, 0));
    return sym_None;
}
示例#6
0
void Term__has_property(VM* vm)
{
    Term* t = as_term_ref(vm->input(0));
    if (t == NULL)
        return vm->throw_str("NULL reference");
    Symbol key = as_symbol(vm->input(1));
    Value* value = term_get_property(t, key);
    set_bool(vm->output(), value != NULL);
}
示例#7
0
void Term__has_input_property(VM* vm)
{
    Term* t = as_term_ref(vm->input(0));
    if (t == NULL)
        return vm->throw_str("NULL reference");

    int index = as_int(vm->input(1));
    Symbol key = as_symbol(vm->input(2));

    set_bool(vm->output(), term_get_input_property(t, index, key) == NULL);
}
示例#8
0
void change_event_commit(caWorld* world, Value* event, bool dryRun, Value* result)
{
    Symbol type = as_symbol(change_event_type(event));

    switch (type) {
    case s_ChangeAppend:
        commit_append(world, event, dryRun, result);
        break;
    default:
        internal_error("Unknown change event type in change_event_commit");
    }
}
示例#9
0
void Block__property(VM* vm)
{
    Block* block = as_block(vm->input(0));

    if (block == NULL)
        return vm->throw_str("NULL block");

    Value* value = block_get_property(block, as_symbol(vm->input(1)));

    if (value == NULL)
        set_null(vm->output());
    else
        copy(value, vm->output());
}
示例#10
0
void Term__property(VM* vm)
{
    Term* t = as_term_ref(vm->input(0));
    if (t == NULL)
        return vm->throw_str("NULL reference");

    Symbol key = as_symbol(vm->input(1));
    Value* value = term_get_property(t, key);

    if (value == NULL)
        set_null(vm->output());
    else
        circa::copy(value, vm->output());
}
示例#11
0
void Term__property_opt(VM* vm)
{
    Term* t = as_term_ref(vm->input(0));
    if (t == NULL)
        return vm->throw_str("NULL reference");

    Symbol key = as_symbol(vm->input(1));
    Value* value = term_get_property(t, key);
    Value* defaultValue = vm->input(2);

    if (value == NULL)
        copy(defaultValue, vm->output());
    else
        copy(value, vm->output());
}
示例#12
0
    void LoweringVisitor::loop_spawn_worksharing(OutlineInfo& outline_info,
            Nodecl::NodeclBase construct,
            Nodecl::List distribute_environment,
            Nodecl::RangeLoopControl& range,
            const std::string& outline_name,
            TL::Symbol structure_symbol,
            TL::Symbol slicer_descriptor,
            Nodecl::NodeclBase task_label)
    {
        Symbol enclosing_function = Nodecl::Utils::get_enclosing_function(construct);

        Nodecl::OpenMP::Schedule schedule = distribute_environment.find_first<Nodecl::OpenMP::Schedule>();
        ERROR_CONDITION(schedule.is_null(), "Schedule tree is missing", 0);

        Nodecl::NodeclBase lower = range.get_lower();
        Nodecl::NodeclBase upper = range.get_upper();
        Nodecl::NodeclBase step = range.get_step();

        Source struct_size, dynamic_size, struct_arg_type_name;

        struct_arg_type_name
            << ((structure_symbol.get_type().is_template_specialized_type()
                        &&  structure_symbol.get_type().is_dependent()) ? "typename " : "")
            << structure_symbol.get_qualified_name(enclosing_function.get_scope())
            ;

        struct_size << "sizeof( " << struct_arg_type_name << " )" << dynamic_size;

        Source immediate_decl;
        allocate_immediate_structure(
                structure_symbol.get_user_defined_type(),
                outline_info,
                struct_arg_type_name,
                struct_size,
                // out
                immediate_decl,
                dynamic_size);


        Source call_outline_function;

        Source schedule_setup;
        schedule_setup
            <<     "int nanos_chunk;"
            ;
        if (schedule.get_text() == "runtime")
        {
            schedule_setup
                <<     "nanos_omp_sched_t nanos_runtime_sched;"
                <<     "nanos_err = nanos_omp_get_schedule(&nanos_runtime_sched, &nanos_chunk);"
                <<     "if (nanos_err != NANOS_OK)"
                <<         "nanos_handle_error(nanos_err);"
                <<     "nanos_ws_t current_ws_policy = nanos_omp_find_worksharing(nanos_runtime_sched);"
                ;
        }
        else
        {
            Source schedule_name;

            if (Nanos::Version::interface_is_at_least("openmp", 8))
            {
                schedule_name << "nanos_omp_sched_" << schedule.get_text();
            }
            else
            {
                // We used nanos_omp_sched in versions prior to 8
                schedule_name << "omp_sched_" << schedule.get_text();
            }

            schedule_setup
                <<     "nanos_ws_t current_ws_policy = nanos_omp_find_worksharing(" << schedule_name << ");"
                <<     "if (current_ws_policy == 0)"
                <<         "nanos_handle_error(NANOS_UNIMPLEMENTED);"
                <<     "nanos_chunk = " << as_expression(schedule.get_chunk()) << ";"
            ;
        }


        Source worksharing_creation;
        if (IS_CXX_LANGUAGE)
        {
            worksharing_creation
                << as_statement(Nodecl::CxxDef::make(Nodecl::NodeclBase::null(), slicer_descriptor));
        }
        worksharing_creation
            <<     "nanos_err = nanos_worksharing_create("
            <<                      "&" << as_symbol(slicer_descriptor) << ","
            <<                      "current_ws_policy,"
            <<                      "(void**)&nanos_setup_info_loop,"
            <<                      "&single_guard);"
            <<     "if (nanos_err != NANOS_OK)"
            <<         "nanos_handle_error(nanos_err);"
            ;

        Nodecl::NodeclBase fill_outline_arguments_tree, fill_immediate_arguments_tree;

        TL::Source pm_specific_code;
        if (!_lowering->in_ompss_mode())
        {
            // OpenMP
            pm_specific_code
                << immediate_decl
                << statement_placeholder(fill_immediate_arguments_tree)
                << "smp_" << outline_name << "(imm_args);"
                ;
        }
        else
        {
            // OmpSs
            std::string wd_description =
                (!task_label.is_null()) ? task_label.get_text() : enclosing_function.get_name();

            Source const_wd_info;
            const_wd_info
                << fill_const_wd_info(struct_arg_type_name,
                        /* is_untied */ false,
                        /* mandatory_creation */ true,
                        /* is_function_task */ false,
                        wd_description,
                        outline_info,
                        construct);

            std::string dyn_props_var = "nanos_wd_dyn_props";

            Source dynamic_wd_info;
            dynamic_wd_info << "nanos_wd_dyn_props_t " << dyn_props_var << ";";

            fill_dynamic_properties(dyn_props_var,
                    /* priority_expr */ nodecl_null(), /* final_expr */ nodecl_null(), /* is_implicit */ 0, dynamic_wd_info);

            pm_specific_code
                <<  struct_arg_type_name << " *ol_args = (" << struct_arg_type_name <<"*) 0;"
                <<  const_wd_info
                <<  "nanos_wd_t nanos_wd_ = (nanos_wd_t) 0;"
                <<  dynamic_wd_info
                <<  "static nanos_slicer_t replicate = (nanos_slicer_t)0;"
                <<  "if (replicate == (nanos_slicer_t)0)"
                <<      "replicate = nanos_find_slicer(\"replicate\");"
                <<  "if (replicate == (nanos_slicer_t)0)"
                <<      "nanos_handle_error(NANOS_UNIMPLEMENTED);"
                <<  "nanos_err = nanos_create_sliced_wd(&nanos_wd_, "
                <<                                "nanos_wd_const_data.base.num_devices, nanos_wd_const_data.devices, "
                <<                                "(size_t)" << struct_size << ",  nanos_wd_const_data.base.data_alignment, "
                <<                                "(void**)&ol_args, nanos_current_wd(), replicate,"
                <<                                "&nanos_wd_const_data.base.props, &" << dyn_props_var << ", 0, (nanos_copy_data_t**)0,"
                <<                                "0, (nanos_region_dimension_internal_t**)0"
                <<                                ");"
                <<  "if (nanos_err != NANOS_OK)"
                <<      "nanos_handle_error(nanos_err);"
                <<  statement_placeholder(fill_outline_arguments_tree)
                <<  "nanos_err = nanos_submit(nanos_wd_, 0, (nanos_data_access_t *) 0, (nanos_team_t) 0);"
                <<  "if (nanos_err != NANOS_OK)"
                <<      "nanos_handle_error(nanos_err);"
                ;

        }

        TL::Source implicit_barrier_or_tw;
        if (!distribute_environment.find_first<Nodecl::OpenMP::BarrierAtEnd>().is_null())
        {
            implicit_barrier_or_tw << get_implicit_sync_end_construct_source();
        }

        Source spawn_code;
        spawn_code
            << "{"
            <<      as_type(get_bool_type()) << " single_guard;"
            <<      "nanos_err_t nanos_err;"
            <<      schedule_setup
            <<      "nanos_ws_info_loop_t nanos_setup_info_loop;"
            <<      "nanos_setup_info_loop.lower_bound = " << as_expression(lower) << ";"
            <<      "nanos_setup_info_loop.upper_bound = " << as_expression(upper) << ";"
            <<      "nanos_setup_info_loop.loop_step = "   << as_expression(step)  << ";"
            <<      "nanos_setup_info_loop.chunk_size = nanos_chunk;"
            <<      worksharing_creation
            <<      pm_specific_code
            <<      implicit_barrier_or_tw
            << "}"
            ;

        Source fill_outline_arguments, fill_immediate_arguments;
        fill_arguments(construct, outline_info, fill_outline_arguments, fill_immediate_arguments);

        if (IS_FORTRAN_LANGUAGE)
            Source::source_language = SourceLanguage::C;

        Nodecl::NodeclBase spawn_code_tree = spawn_code.parse_statement(construct);

        if (IS_FORTRAN_LANGUAGE)
            Source::source_language = SourceLanguage::Current;

        Nodecl::NodeclBase arguments_tree;
        TL::Source *fill_arguments;
        if (!_lowering->in_ompss_mode())
        {
            // OpenMP
            arguments_tree = fill_immediate_arguments_tree;
            fill_arguments = &fill_immediate_arguments;
        }
        else
        {
            // OmpSs
            arguments_tree = fill_outline_arguments_tree;
            fill_arguments = &fill_outline_arguments;
        }

        // Now attach the slicer symbol to its final scope (see tl-lower-for-worksharing.cpp)
        const decl_context_t* spawn_inner_context = arguments_tree.retrieve_context().get_decl_context();
        slicer_descriptor.get_internal_symbol()->decl_context = spawn_inner_context;
        ::insert_entry(spawn_inner_context->current_scope, slicer_descriptor.get_internal_symbol());

        // Parse the arguments
        Nodecl::NodeclBase new_tree = fill_arguments->parse_statement(arguments_tree);
        arguments_tree.replace(new_tree);

        // Finally, replace the construct by the tree that represents the spawn code
        construct.replace(spawn_code_tree);
    }
示例#13
0
    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()
                        )
                    );
        }
示例#14
0
Term* run_name_search(NameSearch* params)
{
    stat_increment(NameSearch);

    if (is_null(&params->name) || string_equals(&params->name, ""))
        return NULL;

    Block* block = params->block;

    if (block == NULL)
        return NULL;

    int position = 0;
    
    if (is_symbol(&params->position) && as_symbol(&params->position) == s_last)
        position = block->length();
    else
        position = as_int(&params->position);

    if (position > block->length())
        position = block->length();

    // Look for an exact match.
    for (int i = position - 1; i >= 0; i--) {

        stat_increment(NameSearchStep);

        Term* term = block->get(i);
        if (term == NULL)
            continue;

        if (equals(&term->nameValue, &params->name)
                && fits_lookup_type(term, params->lookupType)
                && (params->ordinal == -1 || term->uniqueOrdinal == params->ordinal))
            return term;

        // If this term exposes its names, then search inside the nested block.
        // (Deprecated, I think).
        if (term->nestedContents != NULL && exposes_nested_names(term)) {
            NameSearch nestedSearch;
            nestedSearch.block = term->nestedContents;
            set_value(&nestedSearch.name, &params->name);
            set_symbol(&nestedSearch.position, s_last);
            nestedSearch.ordinal = -1;
            nestedSearch.lookupType = params->lookupType;
            nestedSearch.searchParent = false;
            Term* found = run_name_search(&nestedSearch);
            if (found != NULL)
                return found;
        }

        #if 0
        // Check for an 'import' statement. If found, continue this search in the designated module.
        if (term->function == FUNCS.require && term->boolProp(s_Syntax_Import, false)) {
            Block* module = find_module_for_require_statement(term);
            if (module != NULL) {
                NameSearch moduleSearch;
                moduleSearch.block = module;
                set_value(&moduleSearch.name, &params->name);
                set_symbol(&moduleSearch.position, s_last);
                moduleSearch.ordinal = -1;
                moduleSearch.lookupType = params->lookupType;
                moduleSearch.searchParent = false;
                Term* found = run_name_search(&moduleSearch);
                if (found != NULL)
                    return found;
            }
        }
        #endif
    }

    // Did not find in the local block. Possibly continue this search upwards.
    
    if (!params->searchParent)
        return NULL;

    // Possibly take this search to the builtins block.
    if ((get_parent_block(block) == NULL) || is_module(block)) {
        NameSearch builtinsSearch;
        builtinsSearch.block = find_builtins_block(block);
        set_value(&builtinsSearch.name, &params->name);
        set_symbol(&builtinsSearch.position, s_last);
        builtinsSearch.lookupType = params->lookupType;
        builtinsSearch.ordinal = -1;
        builtinsSearch.searchParent = false;
        return run_name_search(&builtinsSearch);
    }

    // Search parent

    // The choice of position is a little weird. For regular name searches,
    // we start at the parent term's position (ie, search all the terms that
    // came before the parent).
    //
    // For a LookupFunction search, start at the bottom of the branch. It's okay
    // for a term to use a function that occurs after the term.
    
    NameSearch parentSearch;

    Term* parentTerm = block->owningTerm;
    if (parentTerm == NULL)
        return NULL;

    parentSearch.block = parentTerm->owningBlock;
    if (params->lookupType == s_LookupFunction)
        set_symbol(&parentSearch.position, s_last);
    else
        set_int(&parentSearch.position, parentTerm->index + 1);

    set_value(&parentSearch.name, &params->name);
    parentSearch.lookupType = params->lookupType;
    parentSearch.ordinal = -1;
    parentSearch.searchParent = true;
    return run_name_search(&parentSearch);
}
示例#15
0
tree
edit_interface_rep::compute_operation_footer (tree st) {
  tree r= "";
  if (N(st) >= 2) {
    switch (L (st)) {
    case VAR_WIDE:
      r= concat ("under ", get_accent_type (as_string (st[1]))); break;
    default: ;
    }
  }
  if (r == "" && N(st) >= 1) {
    switch (L (st)) {
    case HSPACE:
      r= concat ("space"); break;
    case VAR_VSPACE:
      r= concat ("vertical space before");
      break;
    case VSPACE:
      r= concat ("vertical space"); break;
    case SPACE:
      r= concat ("space"); break;
    case _FLOAT:
      r= (is_atomic (st[0])? st[0]->label: string ("float")); break;
    case MID:
      r= concat ("middle ", as_symbol (st[0])); break;
    case RIGHT:
      r= concat ("close ", as_symbol (st[0])); break;
    case BIG:
      r= concat ("big ", as_symbol (st[0])); break;
    case LPRIME:
      r= concat ("left prime ", as_string (st[0])); break;
    case LONG_ARROW:
      r= concat ("long arrow ", as_string (st[0])); break;
    case RPRIME:
      r= concat ("prime ", as_string (st[0])); break;
    case SQRT:
      r= tree ((char*) ((N(st)==1)? "square root": "n-th root")); break;
    case WIDE:
      r= tree (get_accent_type (as_string (st[1]))); break;
    case ASSIGN:
      r= concat ("assign ", as_string (st[0])); break;
    case WITH:
      r= concat ("with ", get_with_text (st)); break;
    case PROVIDES:
      r= concat ("provides ", as_string (st[0])); break;
    case VALUE:
      r= concat ("value ", as_string (st[0])); break;
    case QUOTE_VALUE:
      r= concat ("quoted value ", as_string (st[0])); break;
    case ARG:
      r= concat ("argument ", as_string (st[0])); break;
    case QUOTE_ARG:
      r= concat ("quoted argument ", as_string (st[0])); break;
    case COMPOUND:
      if (is_atomic (st[0])) r= as_string (st[0]);
      else r= "compound";
      break;
    case VAR_INCLUDE:
    case INCLUDE:
      r= concat ("include ", as_string (st[0])); break;
    case INACTIVE:
      r= concat ("inactive ", drd->get_name (L(st[0]))); break;
    case VAR_INACTIVE:
      r= concat ("inactive ", drd->get_name (L(st[0]))); break;
    case LABEL:
      r= concat ("label: ", as_string (st[0])); break;
    case REFERENCE:
      r= concat ("reference: ", as_string (st[0])); break;
    case PAGEREF:
      r= concat ("page reference: ", as_string (st[0])); break;
    case GET_ATTACHMENT:
      r= concat ("get attachment: ", as_string (st[0])); break;
    case WRITE:
      r= concat ("write to ", as_string (st[0])); break;
    case TOC_NOTIFY:
      r= concat ("toc notify: ", as_string (st[1])); break;
    case SPECIFIC:
      r= concat ("specific ", as_string (st[0])); break;
    case IMAGE:
      r= concat ("image"); break;
    default: ;
    }
  }
  if (r == "") {
    switch (L (st)) {
    case IMAGE: r= "image"; break;
    default: r= drd->get_name (L(st));
    }
  }
  if (last_item (tp) == 0) r= concat ("before ", r);
  return r;
}
    static void handle_ompss_opencl_allocate_intrinsic(
            Nodecl::FunctionCall function_call,
            std::map<std::pair<TL::Type, std::pair<int, bool> > , Symbol> &declared_ocl_allocate_functions,
            Nodecl::NodeclBase expr_stmt)
    {
        Nodecl::List arguments = function_call.get_arguments().as<Nodecl::List>();
        ERROR_CONDITION(arguments.size() != 1, "More than one argument in 'ompss_opencl_allocate' call\n", 0);

        Nodecl::NodeclBase actual_argument = arguments[0];
        ERROR_CONDITION(!actual_argument.is<Nodecl::FortranActualArgument>(), "Unexpected tree\n", 0);

        Nodecl::NodeclBase arg = actual_argument.as<Nodecl::FortranActualArgument>().get_argument();
        ERROR_CONDITION(!arg.is<Nodecl::ArraySubscript>(), "Unreachable code\n", 0);

        Nodecl::NodeclBase subscripted = arg.as<Nodecl::ArraySubscript>().get_subscripted();
        TL::Symbol subscripted_symbol = ::fortran_data_ref_get_symbol(subscripted.get_internal_nodecl());

        ERROR_CONDITION(
                !(subscripted_symbol.get_type().is_fortran_array()
                    && subscripted_symbol.is_allocatable())
                &&
                !(subscripted_symbol.get_type().is_pointer()
                    && subscripted_symbol.get_type().points_to().is_fortran_array()),
                "The argument of 'ompss_opencl_allocate' intrinsic must be "
                "an allocatable array or a pointer to an array with all its bounds specified\n", 0);

        TL::Type array_type;
        int num_dimensions;
        bool is_allocatable;
        if (subscripted_symbol.is_allocatable())
        {
            array_type = subscripted_symbol.get_type();
            num_dimensions = subscripted_symbol.get_type().get_num_dimensions();
            is_allocatable = true;
        }
        else
        {
            array_type = subscripted_symbol.get_type().points_to();
            num_dimensions = array_type.get_num_dimensions();
            is_allocatable = false;
        }

        TL::Type element_type = array_type;
        while (element_type.is_array())
        {
            element_type = element_type.array_element();
        }

        ERROR_CONDITION(!array_type.is_array(), "This type should be an array type", 0);

        std::pair<TL::Type, std::pair<int, bool> > key =
            std::make_pair(element_type, std::make_pair(num_dimensions, is_allocatable));

        std::map<std::pair<TL::Type, std::pair<int, bool> > , Symbol>::iterator it_new_fun =
            declared_ocl_allocate_functions.find(key);

        // Reuse the auxiliar function if it already exists
        Symbol new_function_sym;
        if (it_new_fun != declared_ocl_allocate_functions.end())
        {
            new_function_sym = it_new_fun->second;
        }
        else
        {
            new_function_sym = create_new_function_opencl_allocate(
                    expr_stmt, subscripted_symbol, element_type, num_dimensions, is_allocatable);

            declared_ocl_allocate_functions[key] = new_function_sym;
        }

        // Replace the current intrinsic call by a call to the new function
        TL::Source actual_arg_array;
        Nodecl::NodeclBase subscripted_lvalue = subscripted.shallow_copy();
        subscripted_lvalue.set_type(subscripted_symbol.get_type().no_ref().get_lvalue_reference_to());

        actual_arg_array << as_expression(subscripted_lvalue);

        TL::Source actual_arg_bounds;
        Nodecl::List subscripts = arg.as<Nodecl::ArraySubscript>().get_subscripts().as<Nodecl::List>();
        for (Nodecl::List::reverse_iterator it = subscripts.rbegin();
                it != subscripts.rend();
                it++)
        {
            Nodecl::NodeclBase subscript = *it, lower, upper;

            if (it != subscripts.rbegin())
                actual_arg_bounds << ", ";

            if (subscript.is<Nodecl::Range>())
            {
                lower = subscript.as<Nodecl::Range>().get_lower();
                upper = subscript.as<Nodecl::Range>().get_upper();
            }
            else
            {
                lower = nodecl_make_integer_literal(
                        fortran_get_default_integer_type(),
                        const_value_get_signed_int(1), make_locus("", 0, 0));
                upper = subscript;
            }
            actual_arg_bounds << as_expression(lower) << "," << as_expression(upper);
        }

        TL::Source new_function_call;
        new_function_call
            << "CALL " << as_symbol(new_function_sym) << "("
            <<  actual_arg_array  << ", "
            <<  actual_arg_bounds << ")\n"
            ;

        expr_stmt.replace(new_function_call.parse_statement(expr_stmt));

    }
示例#17
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;
        }
    }