diff options
Diffstat (limited to 'gcc/c/c-parser.cc')
| -rw-r--r-- | gcc/c/c-parser.cc | 2391 |
1 files changed, 2222 insertions, 169 deletions
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc index 22ec0f8..9af7440 100644 --- a/gcc/c/c-parser.cc +++ b/gcc/c/c-parser.cc @@ -1456,6 +1456,55 @@ c_parser_skip_to_pragma_eol (c_parser *parser, bool error_if_not_eol = true) parser->error = false; } +/* Skip tokens up to and including "#pragma omp end declare variant". + Properly handle nested "#pragma omp begin declare variant" pragmas. */ +static void +c_parser_skip_to_pragma_omp_end_declare_variant (c_parser *parser) +{ + for (int depth = 0; depth >= 0; ) + { + c_token *token = c_parser_peek_token (parser); + + switch (token->type) + { + case CPP_PRAGMA_EOL: + if (!parser->in_pragma) + break; + /* FALLTHRU */ + case CPP_EOF: + /* If we've run out of tokens, stop. */ + return; + + case CPP_PRAGMA: + if ((token->pragma_kind == PRAGMA_OMP_BEGIN + || token->pragma_kind == PRAGMA_OMP_END) + && c_parser_peek_nth_token (parser, 2)->type == CPP_NAME + && c_parser_peek_nth_token (parser, 3)->type == CPP_NAME) + { + tree id1 = c_parser_peek_nth_token (parser, 2)->value; + tree id2 = c_parser_peek_nth_token (parser, 3)->value; + if (strcmp (IDENTIFIER_POINTER (id1), "declare") == 0 + && strcmp (IDENTIFIER_POINTER (id2), "variant") == 0) + { + if (token->pragma_kind == PRAGMA_OMP_BEGIN) + depth++; + else + depth--; + } + } + c_parser_consume_pragma (parser); + c_parser_skip_to_pragma_eol (parser, false); + continue; + + default: + break; + } + + /* Consume the token. */ + c_parser_consume_token (parser); + } +} + /* Skip tokens until we have consumed an entire block, or until we have consumed a non-nested ';'. */ @@ -1979,6 +2028,13 @@ c_parser_translation_unit (c_parser *parser) "#pragma omp end declare target"); vec_safe_truncate (current_omp_declare_target_attribute, 0); } + if (vec_safe_length (current_omp_declare_variant_attribute)) + { + if (!errorcount) + error ("%<omp begin declare variant%> without corresponding " + "%<omp end declare variant%>"); + vec_safe_truncate (current_omp_declare_variant_attribute, 0); + } if (vec_safe_length (current_omp_begin_assumes)) { if (!errorcount) @@ -2112,6 +2168,8 @@ static void c_parser_handle_directive_omp_attributes (tree &, vec<c_token> *&, vec<c_token> *); static void c_finish_omp_declare_simd (c_parser *, tree, tree, vec<c_token> *); static void c_finish_oacc_routine (struct oacc_routine_data *, tree, bool); +static tree omp_start_variant_function (c_declarator *, tree); +static void omp_finish_variant_function (tree, tree, tree); /* Build and add a DEBUG_BEGIN_STMT statement with location LOC. */ @@ -3064,6 +3122,21 @@ c_parser_declaration_or_fndef (c_parser *parser, bool fndef_ok, pedwarn (here, OPT_Wpedantic, "ISO C forbids nested functions"); c_push_function_context (); } + + /* If we're in an OpenMP "begin declare variant" block, the + name in the declarator refers to the base function. We need + to save that and modify the declarator to have the mangled + name for the variant function instead. */ + tree dv_base = NULL_TREE; + tree dv_ctx = NULL_TREE; + if (!vec_safe_is_empty (current_omp_declare_variant_attribute)) + { + c_omp_declare_variant_attr a + = current_omp_declare_variant_attribute->last (); + dv_ctx = copy_list (a.selector); + dv_base = omp_start_variant_function (declarator, dv_ctx); + } + if (!start_function (specs, declarator, all_prefix_attrs)) { /* At this point we've consumed: @@ -3141,6 +3214,11 @@ c_parser_declaration_or_fndef (c_parser *parser, bool fndef_ok, DECL_STRUCT_FUNCTION (current_function_decl)->function_start_locus = startloc; location_t endloc = startloc; + /* If this function was in a "begin declare variant" block, + store the pointer back to the base function and fix up + the attributes for the middle end. */ + if (dv_base && current_function_decl != error_mark_node) + omp_finish_variant_function (current_function_decl, dv_base, dv_ctx); /* If the definition was marked with __RTL, use the RTL parser now, consuming the function body. */ @@ -6438,7 +6516,9 @@ c_parser_braced_init (c_parser *parser, tree type, bool nested_p, gcc_obstack_init (&braced_init_obstack); gcc_assert (c_parser_next_token_is (parser, CPP_OPEN_BRACE)); bool save_c_omp_array_section_p = c_omp_array_section_p; + bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p; c_omp_array_section_p = false; + c_omp_array_shaping_op_p = false; bool zero_init_padding_bits = false; matching_braces braces; braces.consume_open (parser); @@ -6500,6 +6580,7 @@ c_parser_braced_init (c_parser *parser, tree type, bool nested_p, } } c_omp_array_section_p = save_c_omp_array_section_p; + c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p; c_token *next_tok = c_parser_peek_token (parser); if (next_tok->type != CPP_CLOSE_BRACE) { @@ -9900,6 +9981,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after, struct c_expr cond, exp1, exp2, ret; location_t start, cond_loc, colon_loc; bool save_c_omp_array_section_p = c_omp_array_section_p; + bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p; gcc_assert (!after || c_dialect_objc ()); @@ -9908,6 +9990,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after, if (c_parser_next_token_is_not (parser, CPP_QUERY)) return cond; c_omp_array_section_p = false; + c_omp_array_shaping_op_p = false; if (cond.value != error_mark_node) start = cond.get_start (); else @@ -9961,6 +10044,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after, ret.original_code = ERROR_MARK; ret.original_type = NULL; c_omp_array_section_p = save_c_omp_array_section_p; + c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p; return ret; } { @@ -10008,6 +10092,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after, set_c_expr_source_range (&ret, start, exp2.get_finish ()); ret.m_decimal = 0; c_omp_array_section_p = save_c_omp_array_section_p; + c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p; return ret; } @@ -10389,6 +10474,8 @@ c_parser_cast_expression (c_parser *parser, struct c_expr *after) if (after) return c_parser_postfix_expression_after_primary (parser, cast_loc, *after); + bool save_c_omp_has_array_shape_p = c_omp_has_array_shape_p; + c_omp_has_array_shape_p = false; /* If the expression begins with a parenthesized type name, it may be either a cast or a compound literal; we need to see whether the next character is '{' to tell the difference. If not, it is @@ -10397,6 +10484,10 @@ c_parser_cast_expression (c_parser *parser, struct c_expr *after) if (c_parser_next_token_is (parser, CPP_OPEN_PAREN) && c_token_starts_compound_literal (c_parser_peek_2nd_token (parser))) { + bool save_c_omp_array_section_p = c_omp_array_section_p; + bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p; + c_omp_array_section_p = false; + c_omp_array_shaping_op_p = false; struct c_declspecs *scspecs; struct c_type_name *type_name; struct c_expr ret; @@ -10408,6 +10499,8 @@ c_parser_cast_expression (c_parser *parser, struct c_expr *after) parens.skip_until_found_close (parser); if (type_name == NULL) { + c_omp_array_section_p = save_c_omp_array_section_p; + c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p; ret.set_error (); ret.original_code = ERROR_MARK; ret.original_type = NULL; @@ -10418,9 +10511,15 @@ c_parser_cast_expression (c_parser *parser, struct c_expr *after) used_types_insert (type_name->specs->type); if (c_parser_next_token_is (parser, CPP_OPEN_BRACE)) - return c_parser_postfix_expression_after_paren_type (parser, scspecs, - type_name, - cast_loc); + { + c_expr r = c_parser_postfix_expression_after_paren_type (parser, + scspecs, + type_name, + cast_loc); + c_omp_array_section_p = save_c_omp_array_section_p; + c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p; + return r; + } if (scspecs) error_at (cast_loc, "storage class specifier in cast"); if (type_name->specs->alignas_p) @@ -10437,10 +10536,61 @@ c_parser_cast_expression (c_parser *parser, struct c_expr *after) ret.original_code = ERROR_MARK; ret.original_type = NULL; ret.m_decimal = 0; + c_omp_array_section_p = save_c_omp_array_section_p; + c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p; + return ret; + } + else if (c_omp_array_shaping_op_p + && c_parser_next_token_is (parser, CPP_OPEN_PAREN) + && c_parser_peek_2nd_token (parser)->type == CPP_OPEN_SQUARE) + { + bool save_c_omp_array_section_p = c_omp_array_section_p; + bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p; + c_omp_array_section_p = false; + c_omp_array_shaping_op_p = false; + auto_vec<tree, 4> omp_shape_dims; + struct c_expr expr, ret; + matching_parens parens; + parens.consume_open (parser); + while (c_parser_next_token_is (parser, CPP_OPEN_SQUARE)) + { + c_parser_consume_token (parser); + c_expr e = c_parser_expression (parser); + if (e.value == error_mark_node) + break; + omp_shape_dims.safe_push (e.value); + if (!c_parser_require (parser, CPP_CLOSE_SQUARE, + "expected %<]%>")) + break; + } + parens.require_close (parser); + c_omp_array_section_p = save_c_omp_array_section_p; + c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p; + { + location_t expr_loc = c_parser_peek_token (parser)->location; + bool save_c_omp_has_array_shape_p = c_omp_has_array_shape_p; + c_omp_has_array_shape_p = true; + expr = c_parser_cast_expression (parser, NULL); + c_omp_has_array_shape_p = save_c_omp_has_array_shape_p; + /* NOTE: We don't want to introduce conversions here. */ + expr = convert_lvalue_to_rvalue (expr_loc, expr, false, true); + } + tree arrtype + = create_omp_arrayshape_type (expr.value, &omp_shape_dims); + ret.value = build1_loc (cast_loc, VIEW_CONVERT_EXPR, arrtype, + expr.value); + if (ret.value && expr.value) + set_c_expr_source_range (&ret, cast_loc, expr.get_finish ()); + ret.original_code = ERROR_MARK; + ret.original_type = NULL; + ret.m_decimal = 0; return ret; } else - return c_parser_unary_expression (parser); + { + c_omp_has_array_shape_p = save_c_omp_has_array_shape_p; + return c_parser_unary_expression (parser); + } } /* Parse an unary expression (C90 6.3.3, C99 6.5.3, C11 6.5.3). @@ -11528,6 +11678,7 @@ c_parser_postfix_expression (c_parser *parser) tree stmt; location_t brace_loc; bool save_c_omp_array_section_p = c_omp_array_section_p; + bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p; c_parser_consume_token (parser); brace_loc = c_parser_peek_token (parser)->location; c_parser_consume_token (parser); @@ -11545,6 +11696,7 @@ c_parser_postfix_expression (c_parser *parser) break; } c_omp_array_section_p = false; + c_omp_array_shaping_op_p = false; stmt = c_begin_stmt_expr (); c_parser_compound_statement_nostart (parser); location_t close_loc = c_parser_peek_token (parser)->location; @@ -11556,6 +11708,7 @@ c_parser_postfix_expression (c_parser *parser) set_c_expr_source_range (&expr, loc, close_loc); mark_exp_read (expr.value); c_omp_array_section_p = save_c_omp_array_section_p; + c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p; } else { @@ -13628,15 +13781,38 @@ c_parser_postfix_expression_after_primary (c_parser *parser, if (c_omp_array_section_p && c_parser_next_token_is (parser, CPP_COLON)) { + tree stride = NULL_TREE; + c_parser_consume_token (parser); if (c_parser_next_token_is_not (parser, CPP_CLOSE_SQUARE)) len = c_parser_expression (parser).value; + if (c_parser_next_token_is (parser, CPP_COLON)) + { + c_parser_consume_token (parser); + if (c_parser_next_token_is_not (parser, CPP_CLOSE_SQUARE)) + stride = c_parser_expression (parser).value; + } + expr.value = build_omp_array_section (op_loc, expr.value, idx, - len); + len, stride); } else - expr.value = build_array_ref (op_loc, expr.value, idx); + { + if (c_omp_has_array_shape_p) + /* If we have an array-shaping operator, we may not be able to + represent a well-formed ARRAY_REF here, because we are + coercing the type of the innermost array base and the + original type may not be compatible. Use the + OMP_ARRAY_SECTION code instead. We also want to explicitly + avoid creating INDIRECT_REFs for pointer bases, because + that can lead to parsing ambiguities (see + c_parser_omp_variable_list). */ + expr.value = build_omp_array_section (op_loc, expr.value, idx, + size_one_node, NULL_TREE); + else + expr.value = build_array_ref (op_loc, expr.value, idx); + } c_parser_skip_until_found (parser, CPP_CLOSE_SQUARE, "expected %<]%>"); @@ -13834,8 +14010,8 @@ c_parser_postfix_expression_after_primary (c_parser *parser, finish = c_parser_peek_token (parser)->get_finish (); c_parser_consume_token (parser); expr = default_function_array_read_conversion (expr_loc, expr); - expr.value = build_unary_op (op_loc, POSTINCREMENT_EXPR, - expr.value, false); + expr.value + = build_unary_op (op_loc, POSTINCREMENT_EXPR, expr.value, false); set_c_expr_source_range (&expr, start, finish); expr.original_code = ERROR_MARK; expr.original_type = NULL; @@ -13987,7 +14163,9 @@ c_parser_expr_list (c_parser *parser, bool convert_p, bool fold_p, struct c_expr expr; unsigned int idx = 0; bool save_c_omp_array_section_p = c_omp_array_section_p; + bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p; c_omp_array_section_p = false; + c_omp_array_shaping_op_p = false; ret = make_tree_vector (); if (p_orig_types == NULL) @@ -14069,6 +14247,7 @@ c_parser_expr_list (c_parser *parser, bool convert_p, bool fold_p, if (orig_types) *p_orig_types = orig_types; c_omp_array_section_p = save_c_omp_array_section_p; + c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p; return ret; } @@ -16244,6 +16423,8 @@ c_parser_omp_clause_name (c_parser *parser) result = PRAGMA_OMP_CLAUSE_USE_DEVICE_ADDR; else if (!strcmp ("use_device_ptr", p)) result = PRAGMA_OMP_CLAUSE_USE_DEVICE_PTR; + else if (!strcmp ("uses_allocators", p)) + result = PRAGMA_OMP_CLAUSE_USES_ALLOCATORS; break; case 'v': if (!strcmp ("vector", p)) @@ -16319,6 +16500,24 @@ c_parser_oacc_wait_list (c_parser *parser, location_t clause_loc, tree list) return list; } +/* Return, as an INTEGER_CST node, the number of elements for TYPE + (which is an ARRAY_TYPE). This one is a recursive count of all + ARRAY_TYPEs that are clumped together. (From cp/tree.cc). */ + +static tree +c_array_type_nelts_total (tree type) +{ + tree sz = array_type_nelts_top (type); + type = TREE_TYPE (type); + while (TREE_CODE (type) == ARRAY_TYPE) + { + tree n = array_type_nelts_top (type); + sz = fold_build2_loc (input_location, MULT_EXPR, sizetype, sz, n); + type = TREE_TYPE (type); + } + return sz; +} + /* OpenACC 2.0, OpenMP 2.5: variable-list: identifier @@ -16332,22 +16531,23 @@ c_parser_oacc_wait_list (c_parser *parser, location_t clause_loc, tree list) in TREE_PURPOSE and the location in TREE_VALUE (accessible using EXPR_LOCATION); return the list created. - The optional ALLOW_DEREF argument is true if list items can use the deref + The optional MAP_LVALUE argument is true if list items can use the deref (->) operator. */ struct omp_dim { - tree low_bound, length; + tree low_bound, length, stride; location_t loc; bool no_colon; - omp_dim (tree lb, tree len, location_t lo, bool nc) - : low_bound (lb), length (len), loc (lo), no_colon (nc) {} + omp_dim (tree lb, tree len, tree str, location_t lo, bool nc) + : low_bound (lb), length (len), stride (str), loc (lo), no_colon (nc) {} }; static tree c_parser_omp_variable_list (c_parser *parser, location_t clause_loc, enum omp_clause_code kind, tree list, + enum c_omp_region_type ort = C_ORT_OMP, bool map_lvalue = false) { auto_vec<omp_dim> dims; @@ -16447,12 +16647,26 @@ c_parser_omp_variable_list (c_parser *parser, { location_t loc = c_parser_peek_token (parser)->location; bool save_c_omp_array_section_p = c_omp_array_section_p; + bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p; c_omp_array_section_p = true; + c_omp_array_shaping_op_p + = (kind == OMP_CLAUSE_TO + || kind == OMP_CLAUSE_FROM + || ort == C_ORT_OMP_DECLARE_MAPPER); c_expr expr = c_parser_expr_no_commas (parser, NULL); if (expr.value != error_mark_node) mark_exp_read (expr.value); c_omp_array_section_p = save_c_omp_array_section_p; + c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p; tree decl = expr.value; + tree reshaped_to = NULL_TREE; + + if (TREE_CODE (decl) == VIEW_CONVERT_EXPR + && TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE) + { + reshaped_to = TREE_TYPE (decl); + decl = TREE_OPERAND (decl, 0); + } /* This code rewrites a parsed expression containing various tree codes used to represent array accesses into a more uniform nest of @@ -16465,41 +16679,143 @@ c_parser_omp_variable_list (c_parser *parser, dims.truncate (0); if (TREE_CODE (decl) == OMP_ARRAY_SECTION) { + size_t sections = 0; + tree orig_decl = decl; + bool update_p = (kind == OMP_CLAUSE_TO + || kind == OMP_CLAUSE_FROM); + bool maybe_ptr_based_noncontig_update = false; + + while (update_p + && !reshaped_to + && (TREE_CODE (decl) == OMP_ARRAY_SECTION + || TREE_CODE (decl) == ARRAY_REF + || TREE_CODE (decl) == COMPOUND_EXPR)) + { + if (TREE_CODE (decl) == COMPOUND_EXPR) + decl = TREE_OPERAND (decl, 1); + else + { + if (TREE_CODE (decl) == OMP_ARRAY_SECTION) + maybe_ptr_based_noncontig_update = true; + decl = TREE_OPERAND (decl, 0); + sections++; + } + } + + decl = orig_decl; + while (TREE_CODE (decl) == OMP_ARRAY_SECTION) { tree low_bound = TREE_OPERAND (decl, 1); tree length = TREE_OPERAND (decl, 2); - dims.safe_push (omp_dim (low_bound, length, loc, false)); + tree stride = TREE_OPERAND (decl, 3); + dims.safe_push (omp_dim (low_bound, length, stride, loc, + false)); decl = TREE_OPERAND (decl, 0); + if (sections > 0) + sections--; } + /* The handling of INDIRECT_REF here in the presence of + array-shaping operations is a little tricky. We need to + avoid treating a pointer dereference as a unit-sized array + section when we have an array shaping operation, because we + don't want an indirection to consume one of the user's + requested array dimensions. E.g. if we have a + double-indirect pointer like: + + int **foopp; + #pragma omp target update from(([N][N]) (*foopp)[0:X][0:Y]) + + We don't want to interpret this as: + + foopp[0:1][0:X][0:Y] + + else the array shape [N][N] won't match. Also we can't match + the array sections right-to-left instead, else this: + + #pragma omp target update from(([N][N]) (*foopp)[0:X]) + + would not copy the dimensions: + + (*foopp)[0:X][0:N] + + as required. So, avoid descending through INDIRECT_REFs if + we have an array-shaping op. + + If we *don't* have an array-shaping op, but we have a + multiply-indirected pointer and an array section like this: + + int ***fooppp; + #pragma omp target update from((**fooppp)[0:X:S] + + also avoid descending through more indirections than we have + array sections, since the noncontiguous update processing code + won't understand them (and doesn't need to traverse them + anyway). */ + while (TREE_CODE (decl) == ARRAY_REF - || TREE_CODE (decl) == INDIRECT_REF + || (TREE_CODE (decl) == INDIRECT_REF + && !reshaped_to) || TREE_CODE (decl) == COMPOUND_EXPR) { + if (maybe_ptr_based_noncontig_update && sections == 0) + break; + if (TREE_CODE (decl) == COMPOUND_EXPR) { decl = TREE_OPERAND (decl, 1); STRIP_NOPS (decl); } - else if (TREE_CODE (decl) == INDIRECT_REF) + else if (TREE_CODE (decl) == INDIRECT_REF + && !reshaped_to) { dims.safe_push (omp_dim (integer_zero_node, - integer_one_node, loc, true)); + integer_one_node, NULL_TREE, loc, + true)); decl = TREE_OPERAND (decl, 0); } else /* ARRAY_REF. */ { tree index = TREE_OPERAND (decl, 1); - dims.safe_push (omp_dim (index, integer_one_node, loc, - true)); + dims.safe_push (omp_dim (index, integer_one_node, + NULL_TREE, loc, true)); decl = TREE_OPERAND (decl, 0); + if (sections > 0) + sections--; + } + } + + if (reshaped_to) + { + unsigned reshaped_dims = 0; + + for (tree t = reshaped_to; + TREE_CODE (t) == ARRAY_TYPE; + t = TREE_TYPE (t)) + reshaped_dims++; + + if (dims.length () > reshaped_dims) + { + error_at (loc, "too many array section specifiers " + "for %qT", reshaped_to); + decl = error_mark_node; + } + else + { + /* We have a pointer DECL whose target should be + interpreted as an array with particular dimensions, + not "the pointer itself". So, add an indirection + here. */ + decl = build_indirect_ref (loc, decl, RO_UNARY_STAR); + decl = build1_loc (loc, VIEW_CONVERT_EXPR, reshaped_to, + decl); } } for (int i = dims.length () - 1; i >= 0; i--) decl = build_omp_array_section (loc, decl, dims[i].low_bound, - dims[i].length); + dims[i].length, dims[i].stride); } else if (TREE_CODE (decl) == INDIRECT_REF) { @@ -16508,7 +16824,7 @@ c_parser_omp_variable_list (c_parser *parser, STRIP_NOPS (decl); decl = build_omp_array_section (loc, decl, integer_zero_node, - integer_one_node); + integer_one_node, NULL_TREE); } else if (TREE_CODE (decl) == ARRAY_REF) { @@ -16517,7 +16833,16 @@ c_parser_omp_variable_list (c_parser *parser, decl = TREE_OPERAND (decl, 0); STRIP_NOPS (decl); - decl = build_omp_array_section (loc, decl, idx, integer_one_node); + decl = build_omp_array_section (loc, decl, idx, integer_one_node, + NULL_TREE); + } + else if (reshaped_to) + { + /* We're copying the whole of a reshaped array, originally a + base pointer. Rewrite as an array section. */ + tree elems = c_array_type_nelts_total (reshaped_to); + decl = build_omp_array_section (loc, decl, size_zero_node, elems, + NULL_TREE); } else if (TREE_CODE (decl) == NON_LVALUE_EXPR || CONVERT_EXPR_P (decl)) @@ -16670,7 +16995,8 @@ c_parser_omp_variable_list (c_parser *parser, break; } - dims.safe_push (omp_dim (low_bound, length, loc, no_colon)); + dims.safe_push (omp_dim (low_bound, length, NULL_TREE, loc, + no_colon)); } if (t != error_mark_node) @@ -16694,7 +17020,8 @@ c_parser_omp_variable_list (c_parser *parser, for (unsigned i = 0; i < dims.length (); i++) t = build_omp_array_section (clause_loc, t, dims[i].low_bound, - dims[i].length); + dims[i].length, + dims[i].stride); } if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) @@ -16754,12 +17081,14 @@ c_parser_omp_variable_list (c_parser *parser, } /* Similarly, but expect leading and trailing parenthesis. This is a very - common case for OpenACC and OpenMP clauses. The optional ALLOW_DEREF + common case for OpenACC and OpenMP clauses. The optional MAP_LVALUE argument is true if list items can use the deref (->) operator. */ static tree c_parser_omp_var_list_parens (c_parser *parser, enum omp_clause_code kind, - tree list, bool map_lvalue = false) + tree list, + enum c_omp_region_type ort = C_ORT_OMP, + bool map_lvalue = false) { /* The clauses location. */ location_t loc = c_parser_peek_token (parser)->location; @@ -16780,12 +17109,729 @@ c_parser_omp_var_list_parens (c_parser *parser, enum omp_clause_code kind, matching_parens parens; if (parens.require_open (parser)) { - list = c_parser_omp_variable_list (parser, loc, kind, list, map_lvalue); + list = c_parser_omp_variable_list (parser, loc, kind, list, ort, + map_lvalue); parens.skip_until_found_close (parser); } return list; } +/* Helper for c_parser_omp_parm_list and c_finish_omp_declare_variant. + Compare two OpenMP parameter-list-item numeric ranges with a relative bound. + Returns true if they always overlap for any value of omp_num_args, + returns false otherwise. + + Literal bounds are never compared with each other here, + c_parser_omp_parm_list already handles that case. + + In hindsight, this was never really worth doing. If there is ever a case + found that this function gets wrong the best course of action is probably + to just disable the section that causes a problem. This function only + serves to diagnose overlapping numeric ranges in variadic functions early, + gimplify.cc:modify_call_for_omp_dispatch will always catch these problems + when the numeric range is expanded even if this function misses any cases. + + If I could go back in time, I would stop myself from writing this, but it's + already done now. It technically does serve its purpose of providing better + diagnostics for niche scenarios, so until it breaks, here it is. */ + +static bool +c_omp_numeric_ranges_always_overlap (tree first, tree second) +{ + gcc_assert (first && TREE_CODE (first) == TREE_LIST + && second && TREE_CODE (second) == TREE_LIST); + + auto bound_is_relative = [] (tree bound) -> bool + { + gcc_assert (!TREE_PURPOSE (bound) + || TREE_PURPOSE (bound) + == get_identifier ("omp relative bound")); + /* NULL_TREE means literal, the only other possible value is + get_identifier ("omp relative bound"), I hate this design though. */ + return TREE_PURPOSE (bound); + }; + + tree lb1 = TREE_PURPOSE (first); + tree ub1 = TREE_VALUE (first); + gcc_assert (lb1 && ub1); + const bool lb1_relative = bound_is_relative (lb1); + const bool ub1_relative = bound_is_relative (ub1); + const bool first_mixed = !(lb1_relative && ub1_relative); + + tree lb2 = TREE_PURPOSE (second); + tree ub2 = TREE_VALUE (second); + gcc_assert (lb2 && ub2); + const bool lb2_relative = bound_is_relative (lb2); + const bool ub2_relative = bound_is_relative (ub2); + const bool second_mixed = !(lb2_relative && ub2_relative); + + /* Both ranges must have a relative bound. */ + gcc_assert ((lb1_relative || ub1_relative) + && (lb2_relative || ub2_relative)); + + /* Both fully relative. */ + if (!first_mixed && !second_mixed) + { + /* (relative : relative), (relative : relative) */ + wi::tree_to_widest_ref lb1_v = wi::to_widest (TREE_VALUE (lb1)); + wi::tree_to_widest_ref ub1_v = wi::to_widest (TREE_VALUE (ub1)); + wi::tree_to_widest_ref lb2_v = wi::to_widest (TREE_VALUE (lb2)); + wi::tree_to_widest_ref ub2_v = wi::to_widest (TREE_VALUE (ub2)); + /* We compare lower bound to upper bound including equality because + upper bounds are stored as one past the end of the range. */ + return (lb1_v >= lb2_v && lb1_v < ub2_v) + || (ub1_v > lb2_v && ub1_v <= ub2_v); + } + else if (first_mixed && second_mixed) + { + /* Note that this is a comparison, not logical and/or. */ + if (lb1_relative == lb2_relative) + { + /* FIRST SECOND + LB1 UB1 LB2 UB2 + (literal : relative), (literal : relative) + (relative : literal), (relative : literal) */ + + /* Simply compare the relative bounds, if they match the two ranges + will always overlap. + There is some other static analysis that can be done, but it isn't + worth the time to implement. */ + gcc_assert (ub1_relative == ub2_relative); + if (lb1_relative) + { + /* (relative : literal), (relative : literal) */ + return wi::to_widest (TREE_VALUE (lb1)) + == wi::to_widest (TREE_VALUE (lb2)); + } + else + { + /* (literal : relative), (literal : relative) */ + return wi::to_widest (TREE_VALUE (ub1)) + == wi::to_widest (TREE_VALUE (ub2)); + } + } + else + { + /* FIRST SECOND + LB1 UB1 LB2 UB2 + (literal : relative), (relative : literal) + (relative : literal), (literal : relative) */ + gcc_assert (lb1_relative != lb2_relative + && ub2_relative != ub2_relative + && (lb1_relative == ub2_relative + || lb2_relative == ub1_relative)); + /* There is definitely more interesting static analysis that can + be done here but it would probably be a waste of time. */ + tree relative_lb = lb1_relative ? lb1 : lb2; + tree relative_ub = ub1_relative ? ub1 : ub2; + return wi::to_widest (TREE_VALUE (relative_lb)) + >= wi::to_widest (TREE_VALUE (relative_ub)); + } + } + else + { + /* FIRST SECOND + LB1 UB1 LB2 UB2 + (literal : relative), (relative : relative) + (relative : relative), (literal : relative) + + (relative : relative), (relative : literal) + (relative : literal), (relative : relative) */ + gcc_assert ((first_mixed && !second_mixed) + || (!first_mixed && second_mixed)); + tree lb_mixed = first_mixed ? lb1 : lb2; + tree ub_mixed = first_mixed ? ub1 : ub2; + + tree lb_full_relative = !first_mixed ? lb1 : lb2; + tree ub_full_relative = !first_mixed ? ub1 : ub2; + + if (bound_is_relative (lb_mixed)) + { + return wi::to_widest (TREE_VALUE (lb_mixed)) + >= wi::to_widest (TREE_VALUE (lb_full_relative)) + && wi::to_widest (TREE_VALUE (lb_mixed)) + < wi::to_widest (TREE_VALUE (ub_full_relative)); + } + else + { + gcc_assert (bound_is_relative (ub_mixed)); + return wi::to_widest (TREE_VALUE (ub_mixed)) + > wi::to_widest (TREE_VALUE (lb_full_relative)) + && wi::to_widest (TREE_VALUE (ub_mixed)) + <= wi::to_widest (TREE_VALUE (ub_full_relative)); + } + } + gcc_unreachable (); +} + + +/* Parse an OpenMP parameter-list. + parameter-list: + parameter-list-item[, parameter-list-item [, ...]] + + parameter-list-item: + named parameter list item + parameter index (1 based) + numeric-range + + + numeric-range: + [bound]:[bound] + + bound: + index-expr + omp_num_args[±logical_offset] + + A named parameter list item is the name of a parameter. A parameter index + is a positive integer literal that is the 1 based index of a parameter. + A numeric-range is a pair of bounds of the form lb:ub, the values of each + bound form a closed interval of parameter indices. Bounds can be literal or + relative. An index-expr is a non-negative integer constant-expression that + is the value of a literal bound. The special identifier omp_num_args is + equal to the number of arguments passed to the function at the call site, + including the number of varargs. Optionally, a plus or minus with a + logical_offset may follow omp_num_args, logical_offset is a non-negative + integer constant-expression. A bound formed with omp_num_args is a relative + bound. If a bound is omitted, a default value is used. The default value + of lb is as if 1 were specified, the default value of ub is as if + omp_num_args were specified. + + Each parameter-list-item is stored in a TREE_LIST. The PURPOSE is for + general use and left NULL_TREE here, and the item is stored in the VALUE. + An item is a TREE_LIST, the PURPOSE is an expression with the location of + the list item, and the VALUE is a representation of the item. + Each parameter-list-item is stored in a TREE_LIST node VALUE. The PURPOSE + is unused, and the VALUE is the item-repr. + + Node - PUPOSE: NULL_TREE + - VALUE: item-with-location + item-with-location - PURPOSE: expr-with-location + - VALUE: item-repr + + An item-repr is a INTEGER_CST or a TREE_LIST. An INTEGER_CST is the 0 based + index of a specified parameter, derived from a named parameter list item or + a parameter index. A TREE_LIST is a numeric-range where its PURPOSE is a + TREE_LIST representing the lb, and its VALUE is a TREE_LIST representing the + ub. + + item-repr + INTEGER_CST - parameter index (0 based) + TREE_LIST - PURPOSE: TREE_LIST (lb) + - VALUE: TREE_LIST (ub) + + lb and ub are a TREE_LIST of the following form; + TREE_LIST - PURPOSE: relative bound marker (NULL_TREE if literal) + - VALUE: expr-value + + In non-variadic functions numeric ranges are immediately expanded into + INTEGER_CST nodes corresponding to each index specified by the interval. + + The expr-value is an INTEGER_CST node of type integer_type_node, the value + corresponding to the expr. The value of lb is adjusted to be 0 based, while + the value of ub is adjusted to be 0 based, and one past the end to support + empty ranges. In other words, lb is adjusted by -1, and ub remains the + same. + + Parameters that are specified but are not defined, out of range indices and + duplicate specifications are diagnosed. Additionally, numeric ranges that + can be proven to always overlap for any value of omp_num_args even before + expansion are also diagnosed. This provides diagnostics that occur before + the function is used. In hindsight, I wish I didn't waste my time on that + last one. + If a diagnostic is issued for a list item, it is not appened to the list and + parsing continues. Returns NULL_TREE if no valid list items are parsed. + + This function strictly handles a parameter-list, it does not parse clause + modifiers, or parenthesis other than in the expr of a numeric range. */ + +static tree +c_parser_omp_parm_list (c_parser *parser, tree decl, const int parm_count) +{ + /* TODO: C++ front end was enhanced a little, gotta make changes in here + to match it. */ + tree list = NULL_TREE; + /* Even though an adjust_args clause on a non-variadic function with 0 + parameters is silly, we should still probably handle it gracefully. */ + const bool variadic_p = TYPE_ARG_TYPES (TREE_TYPE (decl)) != void_list_node + && parm_count == 0; + const int omp_num_args_value = parm_count; + + auto unique_append_to_list = [&list, &variadic_p] (int idx, location_t loc) + { + gcc_assert (idx >= 0); + /* Keep track of the last chain to append to the list. */ + tree *chain = &list; + for (tree node = list; node; node = TREE_CHAIN (node)) + { + chain = &TREE_CHAIN (node); + tree item = TREE_VALUE (node); + /* Skip numeric range nodes, only valid for variadic functions. */ + if (variadic_p && TREE_CODE (TREE_VALUE (item)) != INTEGER_CST) + /* Early exit. */; + else if (wi::to_widest (TREE_VALUE (item)) == idx) + /* Return the item for diagnostic purposes. */ + return item; + } + gcc_assert (*chain == NULL_TREE); + /* Store the location in PURPOSE for use in diagnostics. */ + tree item = build_tree_list (build_empty_stmt (loc), + build_int_cst (integer_type_node, idx)); + /* Leave PURPOSE unused for use by the caller of + c_parser_omp_parm_list. */ + *chain = build_tree_list (NULL_TREE, item); + return NULL_TREE; + }; + + auto tok_terminates_item_p = [] (c_token *tok) + { + return tok->type == CPP_COMMA + || tok->type == CPP_CLOSE_PAREN; + }; + /* The first list item is (obviously) not preceded by a comma. */ + goto first_element; + do + { + /* Consume the comma. */ + c_parser_consume_token (parser); + first_element: + c_token *const tok = c_parser_peek_token (parser); + + /* OpenMP 6.0 (162:29-34) + A parameter list item can be one of the following: + • A named parameter list item; + • The position of a parameter in a parameter specification specified + by a positive integer, where 1 represents the first parameter; or + • A parameter range specified by lb : ub where both lb and ub must + be an expression of integer OpenMP type with the constant property + and the positive property. + + The spec does not support arbitrary expression outside of a numeric + range. In theory they could be supported as a parameter index, but + for now we do not support that case. */ + + /* If we don't see a comma or close paren this can't be a named parameter + list item or a parameter index, it can only be a numeric range. + As far as I can tell, there is no well-formed code that could break + this assumption. */ + if (!tok_terminates_item_p (c_parser_peek_2nd_token (parser)) + /* Or this edge case, there is a default lower bound. */ + || tok->type == CPP_COLON) + /* Early exit, numeric range case handled below. */; + else if (tok->type == CPP_NAME + && tok->id_kind == C_ID_ID) + { + if (strcmp (IDENTIFIER_POINTER (tok->value), "omp_num_args") == 0) + { + error_at (tok->location, "%<omp_num_args%> may only be used at " + "the start of a numeric range bound"); + c_parser_consume_token (parser); + continue; + } + tree parm_decl = lookup_name (tok->value); + + if (parm_decl && TREE_CODE (parm_decl) == PARM_DECL) + { + tree parm = DECL_ARGUMENTS (decl); + /* We store indices in 0 based form internally. */ + int idx = 0; + while (parm != parm_decl) + { + gcc_assert (parm != NULL_TREE && parm != void_list_node); + ++idx; + parm = DECL_CHAIN (parm); + } + if (tree dupe = unique_append_to_list (idx, tok->location)) + { + error_at (tok->location, + "OpenMP parameter list items must specify a " + "unique parameter"); + inform (EXPR_LOCATION (TREE_PURPOSE (dupe)), + "parameter previously specified here"); + } + } + else + { + /* It feels like the only reasonable solution is to cook our own + solution for this, undeclared_variable doesn't give us what + we wan't for more than a few reasons. */ + error_at (tok->location, + "%qs is not a function parameter", + IDENTIFIER_POINTER (tok->value)); + /* FIXME: Something like this is a good idea. */ + /* if (parm_decl && TREE_CONSTANT (parm_decl)) + inform (tok->location, + "an expression is only allowed in a " + "numeric range"); */ + /* Don't use undeclared_variable if we are parsing a decl + instead of a declaration, it breaks subsequent lookups in + later functions. */ + } + c_parser_consume_token (parser); + continue; + } + else if (tok->type == CPP_NUMBER) + { + if (wi::to_widest (tok->value) <= 0) + error_at (tok->location, "parameter indices in an OpenMP " + "parameter list must be positive"); + else if (wi::to_widest (tok->value) > INT_MAX) + error_at (tok->location, "parameter index is too big"); + else + { + /* We store indices 0 based internally, OpenMP specifies + 1 based indices, modify it. */ + const int idx = tree_to_shwi (tok->value) - 1; + if (!variadic_p && idx >= parm_count) + error_at (tok->location, + "parameter list item index is out of range"); + else + { + if (tree dupe = unique_append_to_list (idx, tok->location)) + { + error_at (tok->location, + "OpenMP parameter list items must specify a " + "unique parameter"); + inform (EXPR_LOCATION (TREE_PURPOSE (dupe)), + "parameter previously specified here"); + } + } + } + c_parser_consume_token (parser); + continue; + } + else + { + gcc_checking_assert (tok_terminates_item_p + (c_parser_peek_2nd_token (parser))); + error_at (tok->location, "expected parameter or integer"); + c_parser_consume_token (parser); + continue; + } + /* We have a numeric range or something ill formed now, this can be + an arbitrary expression. */ + + /* Empty bounds are delimited differently for lower and upper bounds, + handle them before calling parse_bound. */ + auto parse_bound = [&] () + { + enum omp_num_args + { + num_args_none, + num_args_plus, + num_args_minus, + num_args_no_offset + }; + /* (OpenMP 6.0, 162:35-37) + In both lb and ub, an expression using omp_num_args, that enables + identification of parameters relative to the last argument of the + call, can be used with the form: + omp_num_args [± logical_offset] */ + + const omp_num_args parsed_omp_num_args = [&] () + { + c_token *tok = c_parser_peek_token (parser); + if (tok->type == CPP_NAME + && tok->id_kind == C_ID_ID + && strcmp (IDENTIFIER_POINTER (tok->value), "omp_num_args") + == 0) + { + /* Consume omp_num_args. */ + c_parser_consume_token (parser); + c_token *op_tok = c_parser_peek_token (parser); + if (op_tok->type == CPP_PLUS) + { + c_parser_consume_token (parser); + return num_args_plus; + } + else if (op_tok->type == CPP_MINUS) + { + c_parser_consume_token (parser); + return num_args_minus; + } + return num_args_no_offset; + } + else + return num_args_none; + } (); /* IILE. */ + + /* If there was omp_num_args but no operator an expr is not + permitted, we are finished with this bound. */ + if (parsed_omp_num_args == num_args_no_offset) + return build_int_cst (integer_type_node, omp_num_args_value); + gcc_assert (parsed_omp_num_args < num_args_no_offset); + + c_expr expr = c_parser_expr_no_commas (parser, NULL); + /* I don't know if this location is correct. */ + const location_t expr_loc = expr.get_location (); + /* I don't think read_p true is correct. */ + expr = convert_lvalue_to_rvalue (expr_loc, expr, false, true); + if (expr.value == error_mark_node) + return error_mark_node; + tree folded = c_fully_fold (expr.value, false, NULL); + if (!TREE_CONSTANT (folded)) + { + error_at (expr_loc, "expression of a bound must be a " + "constant expression"); + return error_mark_node; + } + /* This seems wrong... */ + gcc_assert (TREE_CODE (folded) == INTEGER_CST); + /* If we have omp_num_args, expr can be 0, + if we don't, expr must be positive. */ + const int sgn = tree_int_cst_sgn (folded); + /* I'm sure this is wrong but I dunno a better way right now. */ + const ptrdiff_t value = tree_to_shwi (folded); + switch (parsed_omp_num_args) + { + case num_args_none: + { + if (sgn != 1) + { + error_at (expr_loc, "expression of bound must be " + "positive"); + return error_mark_node; + } + if (!variadic_p && value > omp_num_args_value) + { + error_at (expr_loc, "expression of bound is out " + "of range"); + return error_mark_node; + } + return build_int_cst (integer_type_node, value); + } + case num_args_plus: + { + if (sgn != 0) + { + error_at (expr_loc, + "logical offset must be equal to 0 in a bound " + "of the form %<omp_num_args+logical-offset%>"); + return error_mark_node; + } + return build_int_cst (integer_type_node, omp_num_args_value); + } + case num_args_minus: + { + if (sgn == -1) + { + error_at (expr_loc, + "logical offset must be non-negative"); + return error_mark_node; + } + if (variadic_p) + return build_int_cst (integer_type_node, -value); + const ptrdiff_t parm_index = omp_num_args_value - value; + if (parm_index <= 0) + { + error_at (expr_loc, + "bound with logical offset evaluates to an " + "out of range index"); + return error_mark_node; + } + return build_int_cst (integer_type_node, parm_index); + } + case num_args_no_offset: + /* Handled above. */ + default: + gcc_unreachable (); + } + gcc_unreachable (); + }; + const location_t num_range_loc_begin = tok->location; + + /* As stated above, empty bounds are handled here. */ + tree lb = c_parser_next_token_is (parser, CPP_COLON) ? NULL_TREE + : parse_bound (); + /* I wish we could error here saying that we expect an unqualified-id, + an integer, or an expression. Parsing the expression emits the error + right away though. */ + if (lb && error_operand_p (lb)) + { + c_parser_skip_to_end_of_parameter (parser); + continue; + } + /* Tokens get consumed by parse_bound. */ + if (c_parser_next_token_is_not (parser, CPP_COLON)) + { + /* lower_bound can only be null if the next token was a colon. */ + gcc_assert (lb != NULL_TREE); + c_parser_error (parser, "expected %<:%>"); + if (tok_terminates_item_p (c_parser_peek_token (parser))) + { + const location_t loc = make_location (num_range_loc_begin, + num_range_loc_begin, + input_location); + inform (loc, "an expression is only allowed in a numeric range"); + } + c_parser_skip_to_end_of_parameter (parser); + continue; + } + const location_t colon_loc = c_parser_peek_token (parser)->location; + c_parser_consume_token (parser); + + tree ub = tok_terminates_item_p (c_parser_peek_token (parser)) + ? NULL_TREE : parse_bound (); + if (!ub || ub == error_mark_node) + c_parser_skip_to_end_of_parameter (parser); + + location_t num_range_loc_end = ub != NULL_TREE ? input_location + : colon_loc; + location_t num_range_loc = make_location (num_range_loc_begin, + num_range_loc_begin, + num_range_loc_end); + /* I think we are supposed to have some sort of diagnostic here, I'm just + not sure what it should be. */ + if (lb == error_mark_node || ub == error_mark_node) + continue; + /* Handle default bounds. */ + const ptrdiff_t lb_val = lb ? tree_to_shwi (lb) + : 1; + const ptrdiff_t ub_val = ub ? tree_to_shwi (ub) + : omp_num_args_value; + + gcc_assert (variadic_p || (lb_val > 0 && ub_val > 0)); + /* We only know this at this point if they are both negative/zero or both + positive, so basically if both or neither use omp_num_args. */ + /* FIXME: need a test for this case, I think we are missing this case + in the C++ front end, so add it. */ + if (((lb_val <= 0) == (ub_val <= 0)) && lb_val > ub_val) + { + error_at (num_range_loc, + "numeric range lower bound must be less than " + "or equal to upper bound"); + continue; + } + + auto add_range_known = [&] (const int lb, const int ub) + { + gcc_assert (lb > 0 && ub > 0 && lb <= ub); + + for (int idx = lb; idx <= ub; ++idx) + { + gcc_assert (variadic_p || idx <= parm_count); + if (tree dupe = unique_append_to_list (idx - 1, num_range_loc)) + { + error_at (num_range_loc, + "expansion of numeric range specifies " + "non-unique index %d", idx); + inform (EXPR_LOCATION (TREE_PURPOSE (dupe)), + "parameter previously specified here"); + } + } + }; + /* Store ub as exclusive (one past the end) so we can differentiate an + empty range from a range of one index without ever encoding lb as + greater than ub. + Semantically, OpenMP does not allow this as numeric range bounds are + specified to be inclusive, but we utilize it for diagnostic purposes. + This is explained in detail below. */ + auto add_range_unknown = [&] (const int lb_in, + const bool lb_relative_p, + const int ub_in, + const bool ub_relative_p) + { + /* If both bounds are relative, then lb should be <= ub. */ + gcc_assert ((!(lb_relative_p && ub_relative_p) || lb_in <= ub_in) + /* We only deal with ranges that aren't known here, so + at least one bound should be relative to num args. */ + && (lb_relative_p || ub_relative_p)); + /* Adjust to be 0 based, -1 now corresponds to the last arg. */ + const int lb = lb_in - 1; + /* Adjust to be 0 based, but add 1 to make it one past the end. */ + const int ub = ub_in - 1 + 1; + /* We don't check against the non-range indices, we already check + that by adding any indices we can be sure of WAY below. */ + auto build_bound = [] (int val, bool add_num_args) + { + return build_tree_list (add_num_args + ? get_identifier ("omp relative bound") + : NULL_TREE, + build_int_cst (integer_type_node, val)); + }; + tree lb_node = build_bound (lb, lb_relative_p); + tree ub_node = build_bound (ub, ub_relative_p); + tree new_range = build_tree_list (lb_node, ub_node); + /* Keep track of the last chain to append to the list. */ + tree *chain = &list; + for (tree node = list; node; node = TREE_CHAIN (node)) + { + chain = &TREE_CHAIN (node); + tree item = TREE_VALUE (node); + gcc_assert (TREE_PURPOSE (item)); + if (TREE_CODE (TREE_VALUE (item)) == INTEGER_CST) + continue; + + tree range = TREE_VALUE (item); + if (c_omp_numeric_ranges_always_overlap (range, new_range)) + { + error_at (num_range_loc, + "numeric range always overlaps with another " + "range"); + inform (EXPR_LOCATION (TREE_PURPOSE (item)), + "overlaps with this range"); + /* Do not add this range. */ + return; + } + } + tree item = build_tree_list (build_empty_stmt (num_range_loc), + new_range); + /* Leave PURPOSE unused for use by the caller of + c_parser_omp_parm_list. */ + *chain = build_tree_list (NULL_TREE, item); + }; + + if (lb_val > 0 && ub_val > 0) + { + gcc_assert (variadic_p + || (lb_val <= parm_count && ub_val <= parm_count)); + add_range_known (lb_val, ub_val); + } + else if (lb_val <= 0 && ub_val <= 0) + { + gcc_assert (variadic_p); + add_range_unknown (lb_val, true, ub_val, true); + } + /* Add the indices that will be specified for all well-formed calls to + the function. This lets us diagnose indices that were specified + (or rather, will be when the numeric range is expanded) multiple times + before the function is even called. We must adjust the literal bound + of the numeric range accordingly depending on how many indices we + add to prevent them from being specified again erroneously once the + range is expanded at the call site. + We can do this because we support expansion of unknown ranges + evaluating to an empty interval, as mentioned above in + add_range_unknown. */ + else if (lb_val > 0) + { + gcc_assert (variadic_p); + /* FIXME: Make sure to add a test where lb > parm_count, that + originally could break this realized that would break this + optimization. */ + /* In the case that UB refers to the last argument, we can assume all + non-variadic arguments between LB and the last non-variadic arg, + if any, will always be specified. */ + const int known_upper_bound = ub_val == 0 && lb_val <= parm_count + ? parm_count : lb_val; + add_range_known (lb_val, known_upper_bound); + add_range_unknown (known_upper_bound + 1, false, ub_val, true); + } + else if (ub_val > 0) + { + gcc_assert (variadic_p); + /* We can do this because numeric ranges are inclusive, any + well-formed call to this function will cause the range to evaluate + to include the literal index. */ + add_range_known (ub_val, ub_val); + add_range_unknown (lb_val, true, ub_val - 1, false); + } + else + gcc_unreachable (); + + } while (c_parser_next_token_is (parser, CPP_COMMA)); + return list; +} + + /* OpenACC 2.0: copy ( variable-list ) copyin ( variable-list ) @@ -16875,7 +17921,7 @@ c_parser_oacc_data_clause (c_parser *parser, pragma_omp_clause c_kind, } } nl = c_parser_omp_variable_list (parser, open_loc, OMP_CLAUSE_MAP, list, - false); + C_ORT_ACC, false); parens.skip_until_found_close (parser); } @@ -16900,7 +17946,8 @@ c_parser_oacc_data_clause_deviceptr (c_parser *parser, tree list) /* Can't use OMP_CLAUSE_MAP here (that is, can't use the generic c_parser_oacc_data_clause), as for PRAGMA_OACC_CLAUSE_DEVICEPTR, variable-list must only allow for pointer variables. */ - vars = c_parser_omp_var_list_parens (parser, OMP_CLAUSE_ERROR, NULL); + vars = c_parser_omp_var_list_parens (parser, OMP_CLAUSE_ERROR, NULL, + C_ORT_ACC); for (t = vars; t && t; t = TREE_CHAIN (t)) { tree v = TREE_PURPOSE (t); @@ -18459,7 +19506,7 @@ c_parser_omp_clause_private (c_parser *parser, tree list) static tree c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind, - bool is_omp, tree list) + enum c_omp_region_type ort, tree list) { location_t clause_loc = c_parser_peek_token (parser)->location; matching_parens parens; @@ -18470,7 +19517,7 @@ c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind, enum tree_code code = ERROR_MARK; tree reduc_id = NULL_TREE; - if (kind == OMP_CLAUSE_REDUCTION && is_omp) + if (kind == OMP_CLAUSE_REDUCTION && ort == C_ORT_OMP) { if (c_parser_next_token_is_keyword (parser, RID_DEFAULT) && c_parser_peek_2nd_token (parser)->type == CPP_COMMA) @@ -18535,13 +19582,21 @@ c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind, code = MAX_EXPR; break; } + if (ort == C_ORT_ACC) + goto name_error; reduc_id = c_parser_peek_token (parser)->value; break; } default: - c_parser_error (parser, - "expected %<+%>, %<*%>, %<-%>, %<&%>, " - "%<^%>, %<|%>, %<&&%>, %<||%> or identifier"); + name_error: + if (ort == C_ORT_OMP) + c_parser_error (parser, + "expected %<+%>, %<*%>, %<-%>, %<&%>, " + "%<^%>, %<|%>, %<&&%>, %<||%> or identifier"); + else + c_parser_error (parser, + "expected %<+%>, %<*%>, %<-%>, %<&%>, " + "%<^%>, %<|%>, %<&&%>, %<||%>, %<min%> or %<max%>"); c_parser_skip_until_found (parser, CPP_CLOSE_PAREN, 0); return list; } @@ -18551,9 +19606,15 @@ c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind, { tree nl, c; - nl = c_parser_omp_variable_list (parser, clause_loc, kind, list); + nl = c_parser_omp_variable_list (parser, clause_loc, kind, list, ort); + for (c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) { + OMP_CLAUSE_REDUCTION_CODE (c) = code; + /* OpenACC does not require anything below. */ + if (ort == C_ORT_ACC) + continue; + tree d = OMP_CLAUSE_DECL (c), type; if (TREE_CODE (d) != OMP_ARRAY_SECTION) type = TREE_TYPE (d); @@ -18577,7 +19638,6 @@ c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind, } while (TREE_CODE (type) == ARRAY_TYPE) type = TREE_TYPE (type); - OMP_CLAUSE_REDUCTION_CODE (c) = code; if (task) OMP_CLAUSE_REDUCTION_TASK (c) = 1; else if (inscan) @@ -19212,6 +20272,213 @@ c_parser_omp_clause_allocate (c_parser *parser, tree list) return nl; } +/* OpenMP 5.0: + uses_allocators ( allocator-list ) + + allocator-list: + allocator + allocator , allocator-list + allocator ( traits-array ) + allocator ( traits-array ) , allocator-list + + OpenMP 5.2: + + uses_allocators ( modifier : allocator-list ) + uses_allocators ( modifier , modifier : allocator-list ) + + modifier: + traits ( traits-array ) + memspace ( mem-space-handle ) */ + +static tree +c_parser_omp_clause_uses_allocators (c_parser *parser, tree list) +{ + location_t clause_loc = c_parser_peek_token (parser)->location; + tree t = NULL_TREE, nl = list; + matching_parens parens; + if (!parens.require_open (parser)) + return list; + + tree memspace_expr = NULL_TREE; + tree traits_var = NULL_TREE; + + struct item_tok + { + location_t loc; + tree id; + item_tok (void) : loc (UNKNOWN_LOCATION), id (NULL_TREE) {} + }; + struct item { item_tok name, arg; }; + auto_vec<item> *modifiers = NULL, *allocators = NULL; + auto_vec<item> *cur_list = new auto_vec<item> (4); + + while (true) + { + item it; + + if (c_parser_next_token_is (parser, CPP_NAME)) + { + c_token *tok = c_parser_peek_token (parser); + it.name.id = tok->value; + it.name.loc = tok->location; + c_parser_consume_token (parser); + + if (c_parser_next_token_is (parser, CPP_OPEN_PAREN)) + { + matching_parens parens2; + parens2.consume_open (parser); + + if (c_parser_next_token_is (parser, CPP_NAME)) + { + tok = c_parser_peek_token (parser); + it.arg.id = tok->value; + it.arg.loc = tok->location; + c_parser_consume_token (parser); + } + else + { + c_parser_error (parser, "expected identifier"); + parens2.skip_until_found_close (parser); + goto end; + } + parens2.skip_until_found_close (parser); + } + } + + cur_list->safe_push (it); + + if (c_parser_next_token_is (parser, CPP_COMMA)) + c_parser_consume_token (parser); + else if (c_parser_next_token_is (parser, CPP_COLON)) + { + if (modifiers) + { + c_parser_error (parser, "expected %<)%>"); + goto end; + } + else + { + c_parser_consume_token (parser); + modifiers = cur_list; + cur_list = new auto_vec<item> (4); + } + } + else if (c_parser_next_token_is (parser, CPP_CLOSE_PAREN)) + { + gcc_assert (allocators == NULL); + allocators = cur_list; + cur_list = NULL; + break; + } + else + { + c_parser_error (parser, "expected %<)%>"); + goto end; + } + } + + if (modifiers) + for (unsigned i = 0; i < modifiers->length (); i++) + { + item& it = (*modifiers)[i]; + const char *p = IDENTIFIER_POINTER (it.name.id); + int strcmp_traits = 1, strcmp_memspace = 1; + + if ((strcmp_traits = strcmp ("traits", p)) == 0 + || (strcmp_memspace = strcmp ("memspace", p)) == 0) + { + if ((strcmp_traits == 0 && traits_var != NULL_TREE) + || (strcmp_memspace == 0 && memspace_expr != NULL_TREE)) + { + error_at (it.name.loc, "duplicate %qs modifier", p); + goto end; + } + t = lookup_name (it.arg.id); + if (t == NULL_TREE) + { + undeclared_variable (it.arg.loc, it.arg.id); + t = error_mark_node; + } + else if (strcmp_memspace == 0) + memspace_expr = t; + else if (strcmp_traits == 0) + traits_var = t; + else + gcc_unreachable (); + } + else + { + error_at (it.name.loc, "unknown modifier %qE", it.name.id); + goto end; + } + } + + if (allocators) + { + if (modifiers) + { + if (allocators->length () > 1) + { + error_at ((*allocators)[1].name.loc, + "%<uses_allocators%> clause only accepts a single " + "allocator when using modifiers"); + goto end; + } + else if ((*allocators)[0].arg.id) + { + error_at ((*allocators)[0].arg.loc, + "legacy %<%E(%E)%> traits syntax not allowed in " + "%<uses_allocators%> clause when using modifiers", + (*allocators)[0].name.id, (*allocators)[0].arg.id); + goto end; + } + } + + for (unsigned i = 0; i < allocators->length (); i++) + { + item& it = (*allocators)[i]; + t = lookup_name (it.name.id); + if (t == NULL_TREE) + { + undeclared_variable (it.name.loc, it.name.id); + goto end; + } + else if (t != error_mark_node) + { + tree t2 = NULL_TREE; + if (it.arg.id) + { + t2 = lookup_name (it.arg.id); + if (t2 == NULL_TREE) + { + undeclared_variable (it.arg.loc, it.arg.id); + goto end; + } + } + else + t2 = traits_var; + + tree c = build_omp_clause (clause_loc, + OMP_CLAUSE_USES_ALLOCATORS); + OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (c) = t; + OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (c) = memspace_expr; + OMP_CLAUSE_USES_ALLOCATORS_TRAITS (c) = t2; + OMP_CLAUSE_CHAIN (c) = nl; + nl = c; + } + } + } + end: + if (cur_list) + delete cur_list; + if (modifiers) + delete modifiers; + if (allocators) + delete allocators; + parens.skip_until_found_close (parser); + return nl; +} + /* OpenMP 4.0: linear ( variable-list ) linear ( variable-list : expression ) @@ -19651,10 +20918,10 @@ c_parser_omp_iterators (c_parser *parser) pushdecl (iter_var); *last = make_tree_vec (6); - TREE_VEC_ELT (*last, 0) = iter_var; - TREE_VEC_ELT (*last, 1) = begin; - TREE_VEC_ELT (*last, 2) = end; - TREE_VEC_ELT (*last, 3) = step; + OMP_ITERATORS_VAR (*last) = iter_var; + OMP_ITERATORS_BEGIN (*last) = begin; + OMP_ITERATORS_END (*last) = end; + OMP_ITERATORS_STEP (*last) = step; last = &TREE_CHAIN (*last); if (c_parser_next_token_is (parser, CPP_COMMA)) @@ -19719,7 +20986,7 @@ c_parser_omp_clause_affinity (c_parser *parser, tree list) tree block = pop_scope (); if (iterators != error_mark_node) { - TREE_VEC_ELT (iterators, 5) = block; + OMP_ITERATORS_BLOCK (iterators) = block; for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) OMP_CLAUSE_DECL (c) = build_tree_list (iterators, OMP_CLAUSE_DECL (c)); @@ -19836,7 +21103,7 @@ c_parser_omp_clause_depend (c_parser *parser, tree list) if (iterators == error_mark_node) iterators = NULL_TREE; else - TREE_VEC_ELT (iterators, 5) = block; + OMP_ITERATORS_BLOCK (iterators) = block; } for (c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) @@ -19936,13 +21203,12 @@ c_parser_omp_clause_doacross (c_parser *parser, tree list) map ( [map-type-modifier[,] ...] map-kind: variable-list ) map-type-modifier: - always | close */ + always | close | present | iterator (iterators-definition) */ static tree -c_parser_omp_clause_map (c_parser *parser, tree list) +c_parser_omp_clause_map (c_parser *parser, tree list, enum gomp_map_kind kind) { location_t clause_loc = c_parser_peek_token (parser)->location; - enum gomp_map_kind kind = GOMP_MAP_TOFROM; tree nl, c; matching_parens parens; @@ -19951,22 +21217,57 @@ c_parser_omp_clause_map (c_parser *parser, tree list) int pos = 1; int map_kind_pos = 0; - while (c_parser_peek_nth_token_raw (parser, pos)->type == CPP_NAME) + int iterator_length = 0; + for (;;) { - if (c_parser_peek_nth_token_raw (parser, pos + 1)->type == CPP_COLON) + c_token *tok = c_parser_peek_nth_token_raw (parser, pos); + if (tok->type != CPP_NAME) + break; + + const char *p = IDENTIFIER_POINTER (tok->value); + c_token *next_tok = c_parser_peek_nth_token_raw (parser, pos + 1); + if (strcmp (p, "iterator") == 0 && next_tok->type == CPP_OPEN_PAREN) + { + unsigned n = pos + 2; + if (c_parser_check_balanced_raw_token_sequence (parser, &n) + && c_parser_peek_nth_token_raw (parser, n)->type + == CPP_CLOSE_PAREN) + { + iterator_length = n - pos + 1; + pos = n; + next_tok = c_parser_peek_nth_token_raw (parser, pos + 1); + } + } + + if (next_tok->type == CPP_COLON) { map_kind_pos = pos; break; } - if (c_parser_peek_nth_token_raw (parser, pos + 1)->type == CPP_COMMA) + if (next_tok->type == CPP_COMMA) pos++; + else if (c_parser_peek_nth_token_raw (parser, pos + 1)->type + == CPP_OPEN_PAREN) + { + unsigned int npos = pos + 2; + if (c_parser_check_balanced_raw_token_sequence (parser, &npos) + && (c_parser_peek_nth_token_raw (parser, npos)->type + == CPP_CLOSE_PAREN) + && (c_parser_peek_nth_token_raw (parser, npos + 1)->type + == CPP_COMMA)) + pos = npos + 1; + } + pos++; } int always_modifier = 0; int close_modifier = 0; int present_modifier = 0; + int mapper_modifier = 0; + tree mapper_name = NULL_TREE; + tree iterators = NULL_TREE; for (int pos = 1; pos < map_kind_pos; ++pos) { c_token *tok = c_parser_peek_token (parser); @@ -19987,6 +21288,7 @@ c_parser_omp_clause_map (c_parser *parser, tree list) return list; } always_modifier++; + c_parser_consume_token (parser); } else if (strcmp ("close", p) == 0) { @@ -19997,6 +21299,60 @@ c_parser_omp_clause_map (c_parser *parser, tree list) return list; } close_modifier++; + c_parser_consume_token (parser); + } + else if (strcmp ("mapper", p) == 0) + { + c_parser_consume_token (parser); + + matching_parens mparens; + if (mparens.require_open (parser)) + { + if (mapper_modifier) + { + c_parser_error (parser, "too many %<mapper%> modifiers"); + /* Assume it's a well-formed mapper modifier, even if it + seems to be in the wrong place. */ + c_parser_consume_token (parser); + mparens.require_close (parser); + parens.skip_until_found_close (parser); + return list; + } + + tok = c_parser_peek_token (parser); + + switch (tok->type) + { + case CPP_NAME: + { + mapper_name = tok->value; + c_parser_consume_token (parser); + } + break; + + case CPP_KEYWORD: + if (tok->keyword == RID_DEFAULT) + { + c_parser_consume_token (parser); + break; + } + /* Fallthrough. */ + + default: + error_at (tok->location, + "expected identifier or %<default%>"); + return list; + } + + if (!mparens.require_close (parser)) + { + parens.skip_until_found_close (parser); + return list; + } + + mapper_modifier++; + pos += 3; + } } else if (strcmp ("present", p) == 0) { @@ -20007,16 +21363,29 @@ c_parser_omp_clause_map (c_parser *parser, tree list) return list; } present_modifier++; + c_parser_consume_token (parser); + } + else if (strcmp ("iterator", p) == 0 + && c_parser_peek_2nd_token (parser)->type == CPP_OPEN_PAREN) + { + if (iterators) + { + c_parser_error (parser, "too many %<iterator%> modifiers"); + parens.skip_until_found_close (parser); + return list; + } + iterators = c_parser_omp_iterators (parser); + pos += iterator_length - 1; + continue; } else { c_parser_error (parser, "%<map%> clause with map-type modifier other " - "than %<always%>, %<close%> or %<present%>"); + "than %<always%>, %<close%>, %<iterator%>, " + "%<mapper%> or %<present%>"); parens.skip_until_found_close (parser); return list; } - - c_parser_consume_token (parser); } if (c_parser_next_token_is (parser, CPP_NAME) @@ -20058,10 +21427,48 @@ c_parser_omp_clause_map (c_parser *parser, tree list) } nl = c_parser_omp_variable_list (parser, clause_loc, OMP_CLAUSE_MAP, list, - true); + (kind == GOMP_MAP_UNSET + ? C_ORT_OMP_DECLARE_MAPPER + : C_ORT_OMP), true); + + tree last_new = NULL_TREE; + + if (iterators) + { + tree block = pop_scope (); + if (iterators == error_mark_node) + iterators = NULL_TREE; + else + OMP_ITERATORS_BLOCK (iterators) = block; + } for (c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) - OMP_CLAUSE_SET_MAP_KIND (c, kind); + { + OMP_CLAUSE_SET_MAP_KIND (c, kind); + OMP_CLAUSE_ITERATORS (c) = iterators; + last_new = c; + } + + if (mapper_name) + { + tree name = build_omp_clause (input_location, OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_PUSH_MAPPER_NAME); + OMP_CLAUSE_DECL (name) = mapper_name; + if (iterators) + OMP_CLAUSE_ITERATORS (name) = iterators; + OMP_CLAUSE_CHAIN (name) = nl; + nl = name; + + gcc_assert (last_new); + + name = build_omp_clause (input_location, OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_POP_MAPPER_NAME); + OMP_CLAUSE_DECL (name) = null_pointer_node; + if (iterators) + OMP_CLAUSE_ITERATORS (name) = iterators; + OMP_CLAUSE_CHAIN (name) = OMP_CLAUSE_CHAIN (last_new); + OMP_CLAUSE_CHAIN (last_new) = name; + } parens.skip_until_found_close (parser); return nl; @@ -20301,8 +21708,11 @@ c_parser_omp_clause_device_type (c_parser *parser, tree list) to ( variable-list ) OpenMP 5.1: - from ( [present :] variable-list ) - to ( [present :] variable-list ) */ + from ( [motion-modifier[,] [motion-modifier[,]...]:] variable-list ) + to ( [motion-modifier[,] [motion-modifier[,]...]:] variable-list ) + + motion-modifier: + present | iterator (iterators-definition) */ static tree c_parser_omp_clause_from_to (c_parser *parser, enum omp_clause_code kind, @@ -20313,25 +21723,179 @@ c_parser_omp_clause_from_to (c_parser *parser, enum omp_clause_code kind, if (!parens.require_open (parser)) return list; - bool present = false; - c_token *token = c_parser_peek_token (parser); + int pos = 1, colon_pos = 0; + int iterator_length = 0; - if (token->type == CPP_NAME - && strcmp (IDENTIFIER_POINTER (token->value), "present") == 0 - && c_parser_peek_2nd_token (parser)->type == CPP_COLON) + while (c_parser_peek_nth_token_raw (parser, pos)->type == CPP_NAME) { - present = true; - c_parser_consume_token (parser); - c_parser_consume_token (parser); + const char *identifier = + IDENTIFIER_POINTER (c_parser_peek_nth_token_raw (parser, pos)->value); + if (c_parser_peek_nth_token_raw (parser, pos + 1)->type + == CPP_OPEN_PAREN) + { + unsigned int npos = pos + 2; + if (c_parser_check_balanced_raw_token_sequence (parser, &npos) + && (c_parser_peek_nth_token_raw (parser, npos)->type + == CPP_CLOSE_PAREN)) + { + if (strcmp (identifier, "iterator") == 0) + iterator_length = npos - pos + 1; + pos = npos; + } + } + if (c_parser_peek_nth_token_raw (parser, pos + 1)->type == CPP_COMMA) + pos += 2; + else + pos++; + if (c_parser_peek_nth_token_raw (parser, pos)->type == CPP_COLON) + { + colon_pos = pos; + break; + } + } + + int present_modifier = false; + int mapper_modifier = false; + tree mapper_name = NULL_TREE; + tree iterators = NULL_TREE; + + for (int pos = 1; pos < colon_pos; ++pos) + { + c_token *tok = c_parser_peek_token (parser); + if (tok->type == CPP_COMMA) + { + c_parser_consume_token (parser); + continue; + } + const char *p = IDENTIFIER_POINTER (tok->value); + if (strcmp ("present", p) == 0) + { + if (present_modifier) + { + c_parser_error (parser, "too many %<present%> modifiers"); + parens.skip_until_found_close (parser); + return list; + } + present_modifier++; + c_parser_consume_token (parser); + } + else if (strcmp ("iterator", p) == 0) + { + if (iterators) + { + c_parser_error (parser, "too many %<iterator%> modifiers"); + parens.skip_until_found_close (parser); + return list; + } + iterators = c_parser_omp_iterators (parser); + pos += iterator_length - 1; + } + else if (strcmp ("mapper", p) == 0) + { + c_parser_consume_token (parser); + + matching_parens mparens; + if (mparens.require_open (parser)) + { + if (mapper_modifier) + { + c_parser_error (parser, "too many %<mapper%> modifiers"); + /* Assume it's a well-formed mapper modifier, even if it + seems to be in the wrong place. */ + c_parser_consume_token (parser); + mparens.require_close (parser); + parens.skip_until_found_close (parser); + return list; + } + + tok = c_parser_peek_token (parser); + + switch (tok->type) + { + case CPP_NAME: + { + mapper_name = tok->value; + c_parser_consume_token (parser); + } + break; + + case CPP_KEYWORD: + if (tok->keyword == RID_DEFAULT) + { + c_parser_consume_token (parser); + break; + } + /* Fallthrough. */ + + default: + error_at (tok->location, + "expected identifier or %<default%>"); + return list; + } + + if (!mparens.require_close (parser)) + { + parens.skip_until_found_close (parser); + return list; + } + + mapper_modifier++; + pos += 3; + } + } + else + { + c_parser_error (parser, "%<to%> or %<from%> clause with modifier " + "other than %<iterator%>, %<mapper%> or %<present%>"); + parens.skip_until_found_close (parser); + return list; + } } - tree nl = c_parser_omp_variable_list (parser, loc, kind, list); + if (colon_pos) + c_parser_require (parser, CPP_COLON, "expected %<:%>"); + + tree nl = c_parser_omp_variable_list (parser, loc, kind, list, C_ORT_OMP, true); parens.skip_until_found_close (parser); - if (present) + if (present_modifier) for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) OMP_CLAUSE_MOTION_PRESENT (c) = 1; + if (mapper_name) + { + tree last_new = NULL_TREE; + for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) + last_new = c; + + tree name = build_omp_clause (input_location, OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_PUSH_MAPPER_NAME); + OMP_CLAUSE_DECL (name) = mapper_name; + OMP_CLAUSE_CHAIN (name) = nl; + nl = name; + + gcc_assert (last_new); + + name = build_omp_clause (input_location, OMP_CLAUSE_MAP); + OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_POP_MAPPER_NAME); + OMP_CLAUSE_DECL (name) = null_pointer_node; + OMP_CLAUSE_CHAIN (name) = OMP_CLAUSE_CHAIN (last_new); + OMP_CLAUSE_CHAIN (last_new) = name; + } + + if (iterators) + { + tree block = pop_scope (); + if (iterators == error_mark_node) + iterators = NULL_TREE; + else + OMP_ITERATORS_BLOCK (iterators) = block; + } + + if (iterators) + for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) + OMP_CLAUSE_ITERATORS (c) = iterators; + return nl; } @@ -20876,8 +22440,7 @@ c_parser_omp_clause_init (c_parser *parser, tree list) error_at (loc, "missing required %<target%> and/or %<targetsync%> modifier"); - tree nl = c_parser_omp_variable_list (parser, loc, OMP_CLAUSE_INIT, list, - false); + tree nl = c_parser_omp_variable_list (parser, loc, OMP_CLAUSE_INIT, list); parens.skip_until_found_close (parser); for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) @@ -21069,7 +22632,7 @@ c_parser_oacc_all_clauses (c_parser *parser, omp_clause_mask mask, case PRAGMA_OACC_CLAUSE_REDUCTION: clauses = c_parser_omp_clause_reduction (parser, OMP_CLAUSE_REDUCTION, - false, clauses); + C_ORT_ACC, clauses); c_name = "reduction"; break; case PRAGMA_OACC_CLAUSE_SELF: @@ -21235,7 +22798,7 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask, case PRAGMA_OMP_CLAUSE_IN_REDUCTION: clauses = c_parser_omp_clause_reduction (parser, OMP_CLAUSE_IN_REDUCTION, - true, clauses); + C_ORT_OMP, clauses); c_name = "in_reduction"; break; case PRAGMA_OMP_CLAUSE_INDIRECT: @@ -21281,7 +22844,7 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask, case PRAGMA_OMP_CLAUSE_REDUCTION: clauses = c_parser_omp_clause_reduction (parser, OMP_CLAUSE_REDUCTION, - true, clauses); + C_ORT_OMP, clauses); c_name = "reduction"; break; case PRAGMA_OMP_CLAUSE_SCHEDULE: @@ -21295,7 +22858,7 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask, case PRAGMA_OMP_CLAUSE_TASK_REDUCTION: clauses = c_parser_omp_clause_reduction (parser, OMP_CLAUSE_TASK_REDUCTION, - true, clauses); + C_ORT_OMP, clauses); c_name = "task_reduction"; break; case PRAGMA_OMP_CLAUSE_UNTIED: @@ -21397,6 +22960,10 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask, clauses = c_parser_omp_clause_allocate (parser, clauses); c_name = "allocate"; break; + case PRAGMA_OMP_CLAUSE_USES_ALLOCATORS: + clauses = c_parser_omp_clause_uses_allocators (parser, clauses); + c_name = "uses_allocators"; + break; case PRAGMA_OMP_CLAUSE_LINEAR: clauses = c_parser_omp_clause_linear (parser, clauses); c_name = "linear"; @@ -21430,7 +22997,7 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask, c_name = "interop"; break; case PRAGMA_OMP_CLAUSE_MAP: - clauses = c_parser_omp_clause_map (parser, clauses); + clauses = c_parser_omp_clause_map (parser, clauses, GOMP_MAP_TOFROM); c_name = "map"; break; case PRAGMA_OMP_CLAUSE_USE_DEVICE_PTR: @@ -21588,7 +23155,7 @@ c_parser_oacc_cache (location_t loc, c_parser *parser) readonly = true; } clauses = c_parser_omp_variable_list (parser, open_loc, - OMP_CLAUSE__CACHE_, NULL_TREE); + OMP_CLAUSE__CACHE_, NULL_TREE, C_ORT_ACC); parens.skip_until_found_close (parser); } @@ -22457,7 +24024,7 @@ c_parser_omp_allocate (c_parser *parser) != get_identifier ("omp_allocator_handle_t")) { error_at (expr_loc, - "%<allocator%> clause allocator expression has type " + "%<allocator%> clause expression has type " "%qT rather than %<omp_allocator_handle_t%>", TREE_TYPE (allocator)); allocator = NULL_TREE; @@ -25890,7 +27457,9 @@ c_parser_omp_target_data (location_t loc, c_parser *parser, bool *if_p) tree clauses = c_parser_omp_all_clauses (parser, OMP_TARGET_DATA_CLAUSE_MASK, - "#pragma omp target data"); + "#pragma omp target data", false); + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP); + clauses = c_finish_omp_clauses (clauses, C_ORT_OMP); c_omp_adjust_map_clauses (clauses, false); int map_seen = 0; for (tree *pc = &clauses; *pc;) @@ -25981,9 +27550,41 @@ c_parser_omp_target_update (location_t loc, c_parser *parser, tree clauses = c_parser_omp_all_clauses (parser, OMP_TARGET_UPDATE_CLAUSE_MASK, - "#pragma omp target update"); - if (omp_find_clause (clauses, OMP_CLAUSE_TO) == NULL_TREE - && omp_find_clause (clauses, OMP_CLAUSE_FROM) == NULL_TREE) + "#pragma omp target update", false); + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_UPDATE); + clauses = c_finish_omp_clauses (clauses, C_ORT_OMP_UPDATE); + bool to_clause = false, from_clause = false; + for (tree c = clauses; + c && !to_clause && !from_clause; + c = OMP_CLAUSE_CHAIN (c)) + { + switch (OMP_CLAUSE_CODE (c)) + { + case OMP_CLAUSE_TO: + to_clause = true; + break; + case OMP_CLAUSE_FROM: + from_clause = true; + break; + case OMP_CLAUSE_MAP: + switch (OMP_CLAUSE_MAP_KIND (c)) + { + case GOMP_MAP_TO_GRID: + to_clause = true; + break; + case GOMP_MAP_FROM_GRID: + from_clause = true; + break; + default: + ; + } + break; + default: + ; + } + } + + if (!to_clause && !from_clause) { error_at (loc, "%<#pragma omp target update%> must contain at least one " @@ -26048,7 +27649,9 @@ c_parser_omp_target_enter_data (location_t loc, c_parser *parser, tree clauses = c_parser_omp_all_clauses (parser, OMP_TARGET_ENTER_DATA_CLAUSE_MASK, - "#pragma omp target enter data"); + "#pragma omp target enter data", false); + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP); + clauses = c_finish_omp_clauses (clauses, C_ORT_OMP); c_omp_adjust_map_clauses (clauses, false); int map_seen = 0; for (tree *pc = &clauses; *pc;) @@ -26159,6 +27762,7 @@ c_parser_omp_target_exit_data (location_t loc, c_parser *parser, tree clauses = c_parser_omp_all_clauses (parser, OMP_TARGET_EXIT_DATA_CLAUSE_MASK, "#pragma omp target exit data", false); + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_EXIT_DATA); clauses = c_finish_omp_clauses (clauses, C_ORT_OMP_EXIT_DATA); c_omp_adjust_map_clauses (clauses, false); int map_seen = 0; @@ -26242,14 +27846,15 @@ c_parser_omp_target_exit_data (location_t loc, c_parser *parser, | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IN_REDUCTION) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_THREAD_LIMIT) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IS_DEVICE_PTR)\ - | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_HAS_DEVICE_ADDR)) + | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_HAS_DEVICE_ADDR)\ + | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_USES_ALLOCATORS)) static bool c_parser_omp_target (c_parser *parser, enum pragma_context context, bool *if_p) { location_t loc = c_parser_peek_token (parser)->location; c_parser_consume_pragma (parser); - tree *pc = NULL, stmt, block; + tree *pc = NULL, stmt, block, body, clauses; if (context != pragma_stmt && context != pragma_compound) { @@ -26404,10 +28009,9 @@ c_parser_omp_target (c_parser *parser, enum pragma_context context, bool *if_p) stmt = make_node (OMP_TARGET); TREE_TYPE (stmt) = void_type_node; - OMP_TARGET_CLAUSES (stmt) - = c_parser_omp_all_clauses (parser, OMP_TARGET_CLAUSE_MASK, - "#pragma omp target", false); - for (tree c = OMP_TARGET_CLAUSES (stmt); c; c = OMP_CLAUSE_CHAIN (c)) + clauses = c_parser_omp_all_clauses (parser, OMP_TARGET_CLAUSE_MASK, + "#pragma omp target", false); + for (tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c)) if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION) { tree nc = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP); @@ -26416,14 +28020,19 @@ c_parser_omp_target (c_parser *parser, enum pragma_context context, bool *if_p) OMP_CLAUSE_CHAIN (nc) = OMP_CLAUSE_CHAIN (c); OMP_CLAUSE_CHAIN (c) = nc; } - OMP_TARGET_CLAUSES (stmt) - = c_finish_omp_clauses (OMP_TARGET_CLAUSES (stmt), C_ORT_OMP_TARGET); - c_omp_adjust_map_clauses (OMP_TARGET_CLAUSES (stmt), true); + clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_TARGET); + clauses = c_finish_omp_clauses (clauses, C_ORT_OMP_TARGET); + c_omp_adjust_map_clauses (clauses, true); - pc = &OMP_TARGET_CLAUSES (stmt); keep_next_level (); block = c_begin_compound_stmt (true); - add_stmt (c_parser_omp_structured_block (parser, if_p)); + body = c_parser_omp_structured_block (parser, if_p); + + c_omp_scan_mapper_bindings (loc, &clauses, body); + + add_stmt (body); + OMP_TARGET_CLAUSES (stmt) = clauses; + pc = &OMP_TARGET_CLAUSES (stmt); OMP_TARGET_BODY (stmt) = c_end_compound_stmt (loc, block, true); SET_EXPR_LOCATION (stmt, loc); @@ -26938,16 +28547,56 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms) parens.require_close (parser); + const int parm_count = [&] () + { + tree parm = TYPE_ARG_TYPES (TREE_TYPE (fndecl)); + int parm_count = 0; + while (parm != NULL_TREE && parm != void_list_node) + { + ++parm_count; + parm = TREE_CHAIN (parm); + } + gcc_assert (!parm || parm == void_list_node); + return parm == void_list_node ? parm_count : 0; + } (); /* IILE. */ + /* Do we care about non-variadic functions with 0 parameters? I don't think + we do, but lets handle for that case anyway, at least as long as we aren't + diagnosing for it. */ + const bool variadic_p = TYPE_ARG_TYPES (TREE_TYPE (fndecl)) == void_list_node + ? false : parm_count == 0; + tree append_args_tree = NULL_TREE; tree append_args_last; - vec<tree> adjust_args_list = vNULL; + hash_map<int_hash<int, -1, -2>, tree> adjust_args_idxs; bool has_match = false, has_adjust_args = false; location_t adjust_args_loc = UNKNOWN_LOCATION; location_t append_args_loc = UNKNOWN_LOCATION; location_t match_loc = UNKNOWN_LOCATION; - tree need_device_ptr_list = NULL_TREE; tree ctx = error_mark_node; + tree adjust_args_list = NULL_TREE; + auto append_adjust_args = [chain = &adjust_args_list] (tree node) mutable + { + gcc_assert (chain && *chain == NULL_TREE); + *chain = node; + chain = &TREE_CHAIN (node); + }; + + auto compare_ranges = [&] (tree item) + { + for (tree n2 = adjust_args_list; n2; n2 = TREE_CHAIN (n2)) + { + tree item2 = TREE_VALUE (n2); + if (TREE_CODE (TREE_VALUE (item2)) == INTEGER_CST) + continue; + else if (c_omp_numeric_ranges_always_overlap (TREE_VALUE (item2), + TREE_VALUE (item))) + /* Return the location. */ + return TREE_PURPOSE (item2); + } + return NULL_TREE; + }; + do { if (c_parser_next_token_is (parser, CPP_COMMA) @@ -26992,7 +28641,8 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms) if (!parens.require_open (parser)) goto fail; - + /* This almost certainly causes problems with technically correct, but + insane functions that are variadic with no params. */ if (parms == NULL_TREE) parms = error_mark_node; @@ -27006,6 +28656,20 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms) goto fail; ctx = omp_check_context_selector (match_loc, ctx, OMP_CTX_DECLARE_VARIANT); + + /* The OpenMP spec says the merging rules for enclosing + "begin declare variant" contexts apply to "declare variant + directives" -- the term it uses to refer to both directive + forms. */ + if (ctx != error_mark_node + && !vec_safe_is_empty (current_omp_declare_variant_attribute)) + { + c_omp_declare_variant_attr a + = current_omp_declare_variant_attribute->last (); + tree outer_ctx = a.selector; + ctx = omp_merge_context_selectors (match_loc, outer_ctx, ctx, + OMP_CTX_DECLARE_VARIANT); + } if (ctx != error_mark_node && variant != error_mark_node) { if (TREE_CODE (variant) != FUNCTION_DECL) @@ -27037,62 +28701,119 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms) if (c_parser_next_token_is (parser, CPP_NAME) && c_parser_peek_2nd_token (parser)->type == CPP_COLON) { - const char *p - = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value); + tree modifier_id = c_parser_peek_token (parser)->value; + const char *p = IDENTIFIER_POINTER (modifier_id); if (strcmp (p, "need_device_ptr") == 0 || strcmp (p, "nothing") == 0) { - c_parser_consume_token (parser); // need_device_ptr + c_parser_consume_token (parser); // need_device_ptr / nothing c_parser_consume_token (parser); // : loc = c_parser_peek_token (parser)->location; - tree list - = c_parser_omp_variable_list (parser, loc, OMP_CLAUSE_ERROR, - NULL_TREE); + const tree parm_list + = c_parser_omp_parm_list (parser, fndecl, parm_count); - tree arg; if (variant != error_mark_node) - for (tree c = list; c != NULL_TREE; c = TREE_CHAIN (c)) + for (tree next, n = parm_list; n != NULL_TREE; n = next) { - tree decl = TREE_PURPOSE (c); - location_t arg_loc = EXPR_LOCATION (TREE_VALUE (c)); - int idx; - for (arg = parms, idx = 0; arg != NULL; - arg = TREE_CHAIN (arg), idx++) - if (arg == decl) - break; - if (arg == NULL_TREE) + next = TREE_CHAIN (n); + TREE_CHAIN (n) = NULL_TREE; + TREE_PURPOSE (n) = modifier_id; + + tree item = TREE_VALUE (n); + const location_t item_loc + = EXPR_LOCATION (TREE_PURPOSE (item)); + if (TREE_CODE (TREE_VALUE (item)) == TREE_LIST) { - error_at (arg_loc, - "%qD is not a function argument", - decl); - goto fail; + /* Ranges are expanded by c_parser_omp_parm_list + in non-variadic functions. */ + gcc_assert (variadic_p); + if (tree dupe = compare_ranges (item)) + { + const location_t dupe_item_loc + = EXPR_LOCATION (dupe); + + error_at (item_loc, + "numeric range always overlaps with " + "previously specified numeric " + "range"); + inform (dupe_item_loc, + "previously specified here"); + } + else + append_adjust_args (n); + continue; } - if (adjust_args_list.contains (arg)) + gcc_assert (TREE_CODE (TREE_VALUE (item)) + == INTEGER_CST); + const int idx = tree_to_shwi (TREE_VALUE (item)); + /* Indices are 0 based, c_parser_omp_parm_list is + supposed to handle out of range indices. */ + gcc_assert (idx >= 0 + && (variadic_p || idx < parm_count)); + + if (tree *dupe = adjust_args_idxs.get (idx)) { - error_at (arg_loc, - "%qD is specified more than once", - decl); + const location_t prev_item_loc + = EXPR_LOCATION (TREE_PURPOSE (*dupe)); + /* Ensure the wording matches that in + c_parser_omp_parm_list. */ + error_at (item_loc, + "parameter list item specified more " + "than once"); + inform (prev_item_loc, + "previously specified here"); + /* FIXME: Don't fail, keep going. */ goto fail; } - if (strcmp (p, "need_device_ptr") == 0 - && TREE_CODE (TREE_TYPE (arg)) != POINTER_TYPE) + /* Unconditionally push idx so we don't emit the + following errors multiple times. */ + if (adjust_args_idxs.put (idx, item)) + gcc_unreachable (); + + if (strcmp (p, "need_device_ptr") == 0) { - error_at (loc, "%qD is not of pointer type", decl); - goto fail; + const tree parm = [&] () + { + if (idx >= parm_count) + return NULL_TREE; + int curr_idx = 0; + tree parm = parms; + while (parm != NULL_TREE) + { + if (curr_idx == idx) + return parm; + ++curr_idx; + parm = TREE_CHAIN (parm); + } + /* We already confirmed a parm exists in + c_parser_omp_parm_list. */ + gcc_unreachable (); + } (); /* IILE. */ + /* If we don't have an argument (because the index + is to a variadic arg) we can't check this. */ + if (parm + && TREE_CODE (TREE_TYPE (parm)) + != POINTER_TYPE) + { + error_at (DECL_SOURCE_LOCATION (parm), + "%qD is not of pointer type", parm); + inform (item_loc, "specified here"); + /* FIXME: Don't fail, keep going. */ + goto fail; + } + append_adjust_args (n); } - adjust_args_list.safe_push (arg); - if (strcmp (p, "need_device_ptr") == 0) + else if (strcmp (p, "nothing") == 0) { - need_device_ptr_list = chainon ( - need_device_ptr_list, - build_tree_list ( - NULL_TREE, - build_int_cst ( - integer_type_node, - idx))); // Store 0-based argument index, - // as in gimplify_call_expr + /* We only need to save parameter list items from a + clause with the nothing modifier if the function + is variadic. */ + if (variadic_p) + append_adjust_args (n); } + else + gcc_unreachable (); } } else @@ -27321,11 +29042,13 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms) } if ((ctx != error_mark_node && variant != error_mark_node) - && (need_device_ptr_list || append_args_tree)) + && (adjust_args_list || append_args_tree)) { tree variant_decl = tree_strip_nop_conversions (variant); - tree t = build_tree_list (need_device_ptr_list, - NULL_TREE /* need_device_addr */); + tree t = build_tree_list (CHECKING_P + ? get_identifier ("omp adjust args idxs") + : NULL_TREE, + adjust_args_list); TREE_CHAIN (t) = append_args_tree; DECL_ATTRIBUTES (variant_decl) = tree_cons (get_identifier ("omp declare variant variant args"), t, @@ -27412,6 +29135,87 @@ c_finish_omp_declare_simd (c_parser *parser, tree fndecl, tree parms, clauses[0].type = CPP_PRAGMA; } +/* This is consistent with the C++ front end. */ + +#if !defined (NO_DOT_IN_LABEL) +#define JOIN_STR "." +#elif !defined (NO_DOLLAR_IN_LABEL) +#define JOIN_STR "$" +#else +#define JOIN_STR "_" +#endif + +/* Helper function for OpenMP "begin declare variant" directives. + Function definitions inside the construct need to have their names + mangled according to the context selector CTX. The DECLARATOR is + modified in place to point to a new identifier; the original name of + the function is returned. */ +static tree +omp_start_variant_function (c_declarator *declarator, tree ctx) +{ + c_declarator *id = declarator; + while (id->kind != cdk_id) + { + id = id->declarator; + gcc_assert (id); + } + tree name = id->u.id.id; + id->u.id.id = omp_mangle_variant_name (name, ctx, JOIN_STR); + return name; +} + +/* Helper function for OpenMP "begin declare variant" directives. Now + that we have a DECL for the variant function, and BASE_NAME for the + base function, add an "omp declare variant base" attribute pointing + at CTX to the base decl, and an "omp declare variant variant" + attribute to the variant DECL. */ +static void +omp_finish_variant_function (tree decl, tree base_name, tree ctx) +{ + /* First look up BASE_NAME and ensure it matches DECL. */ + tree base_decl = lookup_name (base_name); + if (base_decl == error_mark_node) + base_decl = NULL_TREE; + if (!base_decl) + { + error_at (DECL_SOURCE_LOCATION (decl), + "no previous declaration of base function"); + return; + } + + if (!comptypes (TREE_TYPE (decl), TREE_TYPE (base_decl))) + { + error_at (DECL_SOURCE_LOCATION (decl), + "variant function definition does not match previous " + "declaration of %qE", base_decl); + return; + } + + /* Now set the attributes on the base and variant decls for the middle + end. */ + omp_check_for_duplicate_variant (DECL_SOURCE_LOCATION (decl), + base_decl, ctx); + tree construct + = omp_get_context_selector_list (ctx, OMP_TRAIT_SET_CONSTRUCT); + omp_mark_declare_variant (DECL_SOURCE_LOCATION (decl), decl, construct); + tree attrs = DECL_ATTRIBUTES (base_decl); + tree match_loc_node + = maybe_wrap_with_location (integer_zero_node, + DECL_SOURCE_LOCATION (base_decl)); + tree loc_node = tree_cons (match_loc_node, integer_zero_node, + build_tree_list (match_loc_node, + integer_zero_node)); + attrs = tree_cons (get_identifier ("omp declare variant base"), + tree_cons (decl, ctx, loc_node), attrs); + DECL_ATTRIBUTES (base_decl) = attrs; + + /* Variant functions are essentially anonymous and cannot be referenced + outside the compilation unit. */ + TREE_PUBLIC (decl) = 0; + DECL_COMDAT (decl) = 0; +} + + /* D should be C_TOKEN_VEC from omp::decl attribute. If it contains a threadprivate, groupprivate, allocate or declare target directive, return true and parse it for DECL. */ @@ -27644,7 +29448,9 @@ c_parser_omp_declare_target (c_parser *parser) /* OpenMP 5.1 #pragma omp begin assumes clauses[optseq] new-line - #pragma omp begin declare target clauses[optseq] new-line */ + #pragma omp begin declare target clauses[optseq] new-line + + #pragma omp begin declare variant (match context-selector) new-line */ #define OMP_BEGIN_DECLARE_TARGET_CLAUSE_MASK \ ( (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DEVICE_TYPE) \ @@ -27684,11 +29490,75 @@ c_parser_omp_begin (c_parser *parser) indirect }; vec_safe_push (current_omp_declare_target_attribute, attr); } - else + else if (strcmp (p, "variant") == 0) { - c_parser_error (parser, "expected %<target%>"); + c_parser_consume_token (parser); + const char *clause = ""; + matching_parens parens; + location_t match_loc = c_parser_peek_token (parser)->location; + if (c_parser_next_token_is (parser, CPP_NAME)) + { + tree id = c_parser_peek_token (parser)->value; + clause = IDENTIFIER_POINTER (id); + } + if (strcmp (clause, "match") != 0) + { + c_parser_error (parser, "expected %<match%>"); + c_parser_skip_to_pragma_eol (parser); + return; + } + + c_parser_consume_token (parser); + + if (!parens.require_open (parser)) + { + c_parser_skip_to_pragma_eol (parser, false); + return; + } + + tree ctx = + c_parser_omp_context_selector_specification (parser, NULL_TREE); + if (ctx != error_mark_node) + ctx = omp_check_context_selector (match_loc, ctx, + OMP_CTX_BEGIN_DECLARE_VARIANT); + + if (ctx != error_mark_node + && !vec_safe_is_empty (current_omp_declare_variant_attribute)) + { + c_omp_declare_variant_attr a + = current_omp_declare_variant_attribute->last (); + tree outer_ctx = a.selector; + ctx = omp_merge_context_selectors (match_loc, outer_ctx, ctx, + OMP_CTX_BEGIN_DECLARE_VARIANT); + } + + if (ctx == error_mark_node + || !omp_context_selector_matches (ctx, NULL_TREE, false, true)) + { + /* The context is either invalid or cannot possibly match. + In the latter case the spec says all code in the begin/end + sequence will be elided. In the former case we'll get bogus + errors from trying to parse it without a valid context to + use for name-mangling, so elide that too. */ + c_parser_skip_to_pragma_eol (parser, false); + c_parser_skip_to_pragma_omp_end_declare_variant (parser); + return; + } + else + { + bool attr_syntax = parser->in_omp_attribute_pragma != NULL; + c_omp_declare_variant_attr a = { attr_syntax, ctx }; + vec_safe_push (current_omp_declare_variant_attribute, a); + } + + parens.require_close (parser); c_parser_skip_to_pragma_eol (parser); } + else + { + c_parser_error (parser, "expected %<target%> or %<variant%>"); + c_parser_skip_to_pragma_eol (parser, false); + } } else if (strcmp (p, "assumes") == 0) { @@ -27700,7 +29570,8 @@ c_parser_omp_begin (c_parser *parser) } else { - c_parser_error (parser, "expected %<declare target%> or %<assumes%>"); + c_parser_error (parser, "expected %<declare target%>, " + "%<declare variant%>, or %<assumes%>"); c_parser_skip_to_pragma_eol (parser); } } @@ -27709,7 +29580,8 @@ c_parser_omp_begin (c_parser *parser) #pragma omp end declare target OpenMP 5.1 - #pragma omp end assumes */ + #pragma omp end assumes + #pragma omp end declare variant new-line */ static void c_parser_omp_end (c_parser *parser) @@ -27722,44 +29594,74 @@ c_parser_omp_end (c_parser *parser) if (strcmp (p, "declare") == 0) { c_parser_consume_token (parser); - if (c_parser_next_token_is (parser, CPP_NAME) - && strcmp (IDENTIFIER_POINTER (c_parser_peek_token (parser)->value), - "target") == 0) - c_parser_consume_token (parser); - else + p = ""; + if (c_parser_next_token_is (parser, CPP_NAME)) + p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value); + if (strcmp (p, "target") == 0) { - c_parser_error (parser, "expected %<target%>"); + c_parser_consume_token (parser); + bool attr_syntax = parser->in_omp_attribute_pragma != NULL; c_parser_skip_to_pragma_eol (parser); - return; + if (!vec_safe_length (current_omp_declare_target_attribute)) + error_at (loc, "%<#pragma omp end declare target%> without " + "corresponding %<#pragma omp declare target%> or " + "%<#pragma omp begin declare target%>"); + else + { + c_omp_declare_target_attr + a = current_omp_declare_target_attribute->pop (); + if (a.attr_syntax != attr_syntax) + { + if (a.attr_syntax) + error_at (loc, + "%qs in attribute syntax terminated " + "with %qs in pragma syntax", + a.device_type >= 0 ? "begin declare target" + : "declare target", + "end declare target"); + else + error_at (loc, + "%qs in pragma syntax terminated " + "with %qs in attribute syntax", + a.device_type >= 0 ? "begin declare target" + : "declare target", + "end declare target"); + } + } } - bool attr_syntax = parser->in_omp_attribute_pragma != NULL; - c_parser_skip_to_pragma_eol (parser); - if (!vec_safe_length (current_omp_declare_target_attribute)) - error_at (loc, "%<#pragma omp end declare target%> without " - "corresponding %<#pragma omp declare target%> or " - "%<#pragma omp begin declare target%>"); - else + else if (strcmp (p, "variant") == 0) { - c_omp_declare_target_attr - a = current_omp_declare_target_attribute->pop (); - if (a.attr_syntax != attr_syntax) + c_parser_consume_token (parser); + bool attr_syntax = parser->in_omp_attribute_pragma != NULL; + c_parser_skip_to_pragma_eol (parser); + if (!vec_safe_length (current_omp_declare_variant_attribute)) + error_at (loc, "%<#pragma omp end declare variant%> without " + "corresponding %<#pragma omp begin declare variant%>"); + else { - if (a.attr_syntax) - error_at (loc, - "%qs in attribute syntax terminated " - "with %qs in pragma syntax", - a.device_type >= 0 ? "begin declare target" - : "declare target", - "end declare target"); - else - error_at (loc, - "%qs in pragma syntax terminated " - "with %qs in attribute syntax", - a.device_type >= 0 ? "begin declare target" - : "declare target", - "end declare target"); + c_omp_declare_variant_attr + a = current_omp_declare_variant_attribute->pop (); + if (a.attr_syntax != attr_syntax) + { + if (a.attr_syntax) + error_at (loc, + "%<begin declare variant%> in attribute syntax " + "terminated with " + "%<end declare variant%> in pragma syntax"); + else + error_at (loc, + "%<begin declare variant%> in pragma syntax " + "terminated with " + "%<end declare variant%> in attribute syntax"); + } } } + else + { + c_parser_error (parser, "expected %<target%> or %<variant%>"); + c_parser_skip_to_pragma_eol (parser); + return; + } } else if (strcmp (p, "assumes") == 0) { @@ -27795,6 +29697,151 @@ c_parser_omp_end (c_parser *parser) } } +/* OpenMP 5.0 + #pragma omp declare mapper ([mapper-identifier :] type var) \ + [clause [ [,] clause ] ... ] new-line */ + +static void +c_parser_omp_declare_mapper (c_parser *parser, enum pragma_context context) +{ + tree type, mapper_name = NULL_TREE, var = NULL_TREE, stmt, stmtlist; + tree maplist = NULL_TREE, mapper_id, mapper_decl, t; + c_token *token; + + if (context == pragma_struct || context == pragma_param) + { + error ("%<#pragma omp declare reduction%> not at file or block scope"); + goto fail; + } + + if (!c_parser_require (parser, CPP_OPEN_PAREN, "expected %<(%>")) + goto fail; + + token = c_parser_peek_token (parser); + + if (c_parser_peek_2nd_token (parser)->type == CPP_COLON) + { + switch (token->type) + { + case CPP_NAME: + mapper_name = token->value; + c_parser_consume_token (parser); + break; + case CPP_KEYWORD: + if (token->keyword == RID_DEFAULT) + { + mapper_name = NULL_TREE; + c_parser_consume_token (parser); + break; + } + /* Fallthrough. */ + default: + error_at (token->location, "expected identifier or %<default%>"); + c_parser_skip_to_pragma_eol (parser, false); + return; + } + + if (!c_parser_require (parser, CPP_COLON, "expected %<:%>")) + goto fail; + } + + mapper_id = c_omp_mapper_id (mapper_name); + mapper_decl = c_omp_mapper_decl (mapper_id); + + { + location_t loc = c_parser_peek_token (parser)->location; + struct c_type_name *ctype = c_parser_type_name (parser); + type = groktypename (ctype, NULL, NULL); + if (type == error_mark_node) + goto fail; + if (TREE_CODE (type) != RECORD_TYPE + && TREE_CODE (type) != UNION_TYPE) + { + error_at (loc, "%qT is not a struct or union type in " + "%<#pragma omp declare mapper%>", type); + c_parser_skip_to_pragma_eol (parser, false); + return; + } + for (tree t = DECL_INITIAL (mapper_decl); t; t = TREE_CHAIN (t)) + if (comptypes (TREE_PURPOSE (t), type)) + { + error_at (loc, "redeclaration of %qs %<#pragma omp declare " + "mapper%> for type %qT", IDENTIFIER_POINTER (mapper_id) + + sizeof ("omp declare mapper ") - 1, + type); + tree prevmapper = TREE_VALUE (t); + /* Hmm, this location might not be very accurate. */ + location_t ploc + = DECL_SOURCE_LOCATION (OMP_DECLARE_MAPPER_DECL (prevmapper)); + error_at (ploc, "previous %<#pragma omp declare mapper%>"); + c_parser_skip_to_pragma_eol (parser, false); + return; + } + } + + token = c_parser_peek_token (parser); + if (token->type == CPP_NAME) + { + var = build_decl (token->location, VAR_DECL, token->value, type); + c_parser_consume_token (parser); + DECL_ARTIFICIAL (var) = 1; + } + else + { + error_at (token->location, "expected identifier"); + goto fail; + } + + if (!c_parser_require (parser, CPP_CLOSE_PAREN, "expected %<)%>")) + goto fail; + + push_scope (); + stmtlist = push_stmt_list (); + pushdecl (var); + DECL_CONTEXT (var) = current_function_decl; + + while (c_parser_next_token_is_not (parser, CPP_PRAGMA_EOL)) + { + location_t here; + pragma_omp_clause c_kind; + here = c_parser_peek_token (parser)->location; + c_kind = c_parser_omp_clause_name (parser); + if (c_kind != PRAGMA_OMP_CLAUSE_MAP) + { + error_at (here, "unexpected clause"); + goto fail; + } + maplist = c_parser_omp_clause_map (parser, maplist, GOMP_MAP_UNSET); + } + + if (maplist == NULL_TREE) + { + error_at (input_location, "missing %<map%> clause"); + goto fail; + } + + stmt = make_node (OMP_DECLARE_MAPPER); + TREE_TYPE (stmt) = type; + OMP_DECLARE_MAPPER_ID (stmt) = mapper_name; + OMP_DECLARE_MAPPER_DECL (stmt) = var; + OMP_DECLARE_MAPPER_CLAUSES (stmt) = maplist; + + add_stmt (stmt); + + pop_stmt_list (stmtlist); + pop_scope (); + + c_parser_skip_to_pragma_eol (parser); + + t = tree_cons (type, stmt, DECL_INITIAL (mapper_decl)); + DECL_INITIAL (mapper_decl) = t; + + return; + + fail: + c_parser_skip_to_pragma_eol (parser); +} + /* OpenMP 4.0 #pragma omp declare reduction (reduction-id : typename-list : expression) \ initializer-clause[opt] new-line @@ -28186,6 +30233,12 @@ c_parser_omp_declare (c_parser *parser, enum pragma_context context) c_parser_omp_declare_reduction (parser, context); return false; } + if (strcmp (p, "mapper") == 0) + { + c_parser_consume_token (parser); + c_parser_omp_declare_mapper (parser, context); + return false; + } if (!flag_openmp) /* flag_openmp_simd */ { c_parser_skip_to_pragma_eol (parser, false); |