Hi! I've backported following 11 patches from trunk to gcc-9-branch, bootstrapped/regtested on x86_64-linux and i686-linux, committed.
Jakub
2019-05-17 Jakub Jelinek <ja...@redhat.com> Backported from mainline 2019-04-26 Jakub Jelinek <ja...@redhat.com> PR debug/90197 * c-tree.h (c_finish_loop): Add 2 further location_t arguments. * c-parser.c (c_parser_while_statement): Adjust c_finish_loop caller. (c_parser_do_statement): Likewise. (c_parser_for_statement): Likewise. Formatting fixes. * c-typeck.c (c_finish_loop): Add COND_LOCUS and INCR_LOCUS arguments, emit DEBUG_BEGIN_STMTs if needed. --- gcc/c/c-tree.h (revision 270605) +++ gcc/c/c-tree.h (revision 270606) @@ -694,7 +694,8 @@ extern int c_types_compatible_p (tree, t extern tree c_begin_compound_stmt (bool); extern tree c_end_compound_stmt (location_t, tree, bool); extern void c_finish_if_stmt (location_t, tree, tree, tree); -extern void c_finish_loop (location_t, tree, tree, tree, tree, tree, bool); +extern void c_finish_loop (location_t, location_t, tree, location_t, tree, + tree, tree, tree, bool); extern tree c_begin_stmt_expr (void); extern tree c_finish_stmt_expr (location_t, tree); extern tree c_process_expr_stmt (location_t, tree); --- gcc/c/c-parser.c (revision 270605) +++ gcc/c/c-parser.c (revision 270606) @@ -6001,7 +6001,8 @@ c_parser_while_statement (c_parser *pars location_t loc_after_labels; bool open_brace = c_parser_next_token_is (parser, CPP_OPEN_BRACE); body = c_parser_c99_block_statement (parser, if_p, &loc_after_labels); - c_finish_loop (loc, cond, NULL, body, c_break_label, c_cont_label, true); + c_finish_loop (loc, loc, cond, UNKNOWN_LOCATION, NULL, body, + c_break_label, c_cont_label, true); add_stmt (c_end_compound_stmt (loc, block, flag_isoc99)); c_parser_maybe_reclassify_token (parser); @@ -6046,6 +6047,7 @@ c_parser_do_statement (c_parser *parser, c_break_label = save_break; new_cont = c_cont_label; c_cont_label = save_cont; + location_t cond_loc = c_parser_peek_token (parser)->location; cond = c_parser_paren_condition (parser); if (ivdep && cond != error_mark_node) cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond, @@ -6059,7 +6061,8 @@ c_parser_do_statement (c_parser *parser, build_int_cst (integer_type_node, unroll)); if (!c_parser_require (parser, CPP_SEMICOLON, "expected %<;%>")) c_parser_skip_to_end_of_block_or_statement (parser); - c_finish_loop (loc, cond, NULL, body, new_break, new_cont, false); + c_finish_loop (loc, cond_loc, cond, UNKNOWN_LOCATION, NULL, body, + new_break, new_cont, false); add_stmt (c_end_compound_stmt (loc, block, flag_isoc99)); } @@ -6132,7 +6135,9 @@ c_parser_for_statement (c_parser *parser /* Silence the bogus uninitialized warning. */ tree collection_expression = NULL; location_t loc = c_parser_peek_token (parser)->location; - location_t for_loc = c_parser_peek_token (parser)->location; + location_t for_loc = loc; + location_t cond_loc = UNKNOWN_LOCATION; + location_t incr_loc = UNKNOWN_LOCATION; bool is_foreach_statement = false; gcc_assert (c_parser_next_token_is_keyword (parser, RID_FOR)); token_indent_info for_tinfo @@ -6166,7 +6171,8 @@ c_parser_for_statement (c_parser *parser c_parser_consume_token (parser); is_foreach_statement = true; if (check_for_loop_decls (for_loc, true) == NULL_TREE) - c_parser_error (parser, "multiple iterating variables in fast enumeration"); + c_parser_error (parser, "multiple iterating variables in " + "fast enumeration"); } else check_for_loop_decls (for_loc, flag_isoc99); @@ -6196,7 +6202,8 @@ c_parser_for_statement (c_parser *parser c_parser_consume_token (parser); is_foreach_statement = true; if (check_for_loop_decls (for_loc, true) == NULL_TREE) - c_parser_error (parser, "multiple iterating variables in fast enumeration"); + c_parser_error (parser, "multiple iterating variables in " + "fast enumeration"); } else check_for_loop_decls (for_loc, flag_isoc99); @@ -6218,15 +6225,18 @@ c_parser_for_statement (c_parser *parser c_parser_consume_token (parser); is_foreach_statement = true; if (! lvalue_p (init_expression)) - c_parser_error (parser, "invalid iterating variable in fast enumeration"); - object_expression = c_fully_fold (init_expression, false, NULL); + c_parser_error (parser, "invalid iterating variable in " + "fast enumeration"); + object_expression + = c_fully_fold (init_expression, false, NULL); } else { ce = convert_lvalue_to_rvalue (loc, ce, true, false); init_expression = ce.value; c_finish_expr_stmt (loc, init_expression); - c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>"); + c_parser_skip_until_found (parser, CPP_SEMICOLON, + "expected %<;%>"); } } } @@ -6235,18 +6245,19 @@ c_parser_for_statement (c_parser *parser gcc_assert (!parser->objc_could_be_foreach_context); if (!is_foreach_statement) { + cond_loc = c_parser_peek_token (parser)->location; if (c_parser_next_token_is (parser, CPP_SEMICOLON)) { if (ivdep) { - c_parser_error (parser, "missing loop condition in loop with " - "%<GCC ivdep%> pragma"); + c_parser_error (parser, "missing loop condition in loop " + "with %<GCC ivdep%> pragma"); cond = error_mark_node; } else if (unroll) { - c_parser_error (parser, "missing loop condition in loop with " - "%<GCC unroll%> pragma"); + c_parser_error (parser, "missing loop condition in loop " + "with %<GCC unroll%> pragma"); cond = error_mark_node; } else @@ -6275,11 +6286,13 @@ c_parser_for_statement (c_parser *parser /* Parse the increment expression (the third expression in a for-statement). In the case of a foreach-statement, this is the expression that follows the 'in'. */ + loc = incr_loc = c_parser_peek_token (parser)->location; if (c_parser_next_token_is (parser, CPP_CLOSE_PAREN)) { if (is_foreach_statement) { - c_parser_error (parser, "missing collection in fast enumeration"); + c_parser_error (parser, + "missing collection in fast enumeration"); collection_expression = error_mark_node; } else @@ -6288,8 +6301,8 @@ c_parser_for_statement (c_parser *parser else { if (is_foreach_statement) - collection_expression = c_fully_fold (c_parser_expression (parser).value, - false, NULL); + collection_expression + = c_fully_fold (c_parser_expression (parser).value, false, NULL); else { struct c_expr ce = c_parser_expression (parser); @@ -6312,10 +6325,14 @@ c_parser_for_statement (c_parser *parser body = c_parser_c99_block_statement (parser, if_p, &loc_after_labels); if (is_foreach_statement) - objc_finish_foreach_loop (loc, object_expression, collection_expression, body, c_break_label, c_cont_label); + objc_finish_foreach_loop (for_loc, object_expression, + collection_expression, body, c_break_label, + c_cont_label); else - c_finish_loop (loc, cond, incr, body, c_break_label, c_cont_label, true); - add_stmt (c_end_compound_stmt (loc, block, flag_isoc99 || c_dialect_objc ())); + c_finish_loop (for_loc, cond_loc, cond, incr_loc, incr, body, + c_break_label, c_cont_label, true); + add_stmt (c_end_compound_stmt (for_loc, block, + flag_isoc99 || c_dialect_objc ())); c_parser_maybe_reclassify_token (parser); token_indent_info next_tinfo --- gcc/c/c-typeck.c (revision 270605) +++ gcc/c/c-typeck.c (revision 270606) @@ -10858,11 +10858,14 @@ c_finish_if_stmt (location_t if_locus, t the beginning of the loop. COND is the loop condition. COND_IS_FIRST is false for DO loops. INCR is the FOR increment expression. BODY is the statement controlled by the loop. BLAB is the break label. CLAB is - the continue label. Everything is allowed to be NULL. */ + the continue label. Everything is allowed to be NULL. + COND_LOCUS is the location of the loop condition, INCR_LOCUS is the + location of the FOR increment expression. */ void -c_finish_loop (location_t start_locus, tree cond, tree incr, tree body, - tree blab, tree clab, bool cond_is_first) +c_finish_loop (location_t start_locus, location_t cond_locus, tree cond, + location_t incr_locus, tree incr, tree body, tree blab, + tree clab, bool cond_is_first) { tree entry = NULL, exit = NULL, t; @@ -10904,12 +10907,8 @@ c_finish_loop (location_t start_locus, t } t = build_and_jump (&blab); - if (cond_is_first) - exit = fold_build3_loc (start_locus, - COND_EXPR, void_type_node, cond, exit, t); - else - exit = fold_build3_loc (input_location, - COND_EXPR, void_type_node, cond, exit, t); + exit = fold_build3_loc (cond_is_first ? start_locus : input_location, + COND_EXPR, void_type_node, cond, exit, t); } else { @@ -10930,9 +10929,23 @@ c_finish_loop (location_t start_locus, t if (clab) add_stmt (build1 (LABEL_EXPR, void_type_node, clab)); if (incr) - add_stmt (incr); + { + if (MAY_HAVE_DEBUG_MARKER_STMTS && incr_locus != UNKNOWN_LOCATION) + { + t = build0 (DEBUG_BEGIN_STMT, void_type_node); + SET_EXPR_LOCATION (t, incr_locus); + add_stmt (t); + } + add_stmt (incr); + } if (entry) add_stmt (entry); + if (MAY_HAVE_DEBUG_MARKER_STMTS && cond_locus != UNKNOWN_LOCATION) + { + t = build0 (DEBUG_BEGIN_STMT, void_type_node); + SET_EXPR_LOCATION (t, cond_locus); + add_stmt (t); + } if (exit) add_stmt (exit); if (blab)
2019-05-17 Jakub Jelinek <ja...@redhat.com> Backported from mainline 2019-05-03 Jakub Jelinek <ja...@redhat.com> PR tree-optimization/90303 * ipa-devirt.c (obj_type_ref_class, get_odr_type): Don't use TYPE_CANONICAL for TYPE_STRUCTURAL_EQUALITY_P types in !in_lto_p mode. * g++.target/i386/pr90303.C: New test. --- gcc/ipa-devirt.c (revision 270834) +++ gcc/ipa-devirt.c (revision 270835) @@ -2020,7 +2020,7 @@ obj_type_ref_class (const_tree ref) ref = TREE_VALUE (TYPE_ARG_TYPES (ref)); gcc_checking_assert (TREE_CODE (ref) == POINTER_TYPE); tree ret = TREE_TYPE (ref); - if (!in_lto_p) + if (!in_lto_p && !TYPE_STRUCTURAL_EQUALITY_P (ret)) ret = TYPE_CANONICAL (ret); else ret = get_odr_type (ret)->type; @@ -2042,7 +2042,7 @@ get_odr_type (tree type, bool insert) int base_id = -1; type = TYPE_MAIN_VARIANT (type); - if (!in_lto_p) + if (!in_lto_p && !TYPE_STRUCTURAL_EQUALITY_P (type)) type = TYPE_CANONICAL (type); gcc_checking_assert (can_be_name_hashed_p (type) --- gcc/testsuite/g++.target/i386/pr90303.C (nonexistent) +++ gcc/testsuite/g++.target/i386/pr90303.C (revision 270835) @@ -0,0 +1,8 @@ +// PR tree-optimization/90303 +// { dg-do compile { target ia32 } } +// { dg-additional-options "-O2" } + +struct A { virtual void foo (); }; +template <class> class B : A {}; +typedef void (__attribute__((fastcall)) F) (); +B<F> e;
2019-05-17 Jakub Jelinek <ja...@redhat.com> Backported from mainline 2019-05-10 Jakub Jelinek <ja...@redhat.com> PR pch/90326 cp/ * config-lang.in (gtfiles): Remove c-family/c-lex.c, add c-family/c-cppbuiltin.c. objc/ * config-lang.in (gtfiles): Add c-family/c-format.c. objcp/ * config-lang.in (gtfiles): Don't add c-family/c-cppbuiltin.c. testsuite/ * g++.dg/pch/pr90326.C: New test. * g++.dg/pch/pr90326.Hs: New file. --- gcc/cp/config-lang.in (revision 271054) +++ gcc/cp/config-lang.in (revision 271055) @@ -37,7 +37,7 @@ gtfiles="\ \$(srcdir)/c-family/c-pragma.h \$(srcdir)/cp/decl.h \ \$(srcdir)/cp/parser.h \ \$(srcdir)/c-family/c-common.c \$(srcdir)/c-family/c-format.c \ -\$(srcdir)/c-family/c-lex.c \$(srcdir)/c-family/c-pragma.c \ +\$(srcdir)/c-family/c-cppbuiltin.c \$(srcdir)/c-family/c-pragma.c \ \$(srcdir)/cp/call.c \$(srcdir)/cp/class.c \$(srcdir)/cp/constexpr.c \ \$(srcdir)/cp/cp-gimplify.c \ \$(srcdir)/cp/cp-lang.c \$(srcdir)/cp/cp-objcp-common.c \ --- gcc/objc/config-lang.in (revision 271054) +++ gcc/objc/config-lang.in (revision 271055) @@ -35,4 +35,4 @@ lang_requires="c" # Order is important. If you change this list, make sure you test # building without C++ as well; that is, remove the gcc/cp directory, # and build with --enable-languages=c,objc. -gtfiles="\$(srcdir)/objc/objc-map.h \$(srcdir)/c-family/c-objc.h \$(srcdir)/objc/objc-act.h \$(srcdir)/objc/objc-act.c \$(srcdir)/objc/objc-runtime-shared-support.c \$(srcdir)/objc/objc-gnu-runtime-abi-01.c \$(srcdir)/objc/objc-next-runtime-abi-01.c \$(srcdir)/objc/objc-next-runtime-abi-02.c \$(srcdir)/c/c-parser.h \$(srcdir)/c/c-parser.c \$(srcdir)/c/c-tree.h \$(srcdir)/c/c-decl.c \$(srcdir)/c/c-lang.h \$(srcdir)/c/c-objc-common.c \$(srcdir)/c-family/c-common.c \$(srcdir)/c-family/c-common.h \$(srcdir)/c-family/c-cppbuiltin.c \$(srcdir)/c-family/c-pragma.h \$(srcdir)/c-family/c-pragma.c" +gtfiles="\$(srcdir)/objc/objc-map.h \$(srcdir)/c-family/c-objc.h \$(srcdir)/objc/objc-act.h \$(srcdir)/objc/objc-act.c \$(srcdir)/objc/objc-runtime-shared-support.c \$(srcdir)/objc/objc-gnu-runtime-abi-01.c \$(srcdir)/objc/objc-next-runtime-abi-01.c \$(srcdir)/objc/objc-next-runtime-abi-02.c \$(srcdir)/c/c-parser.h \$(srcdir)/c/c-parser.c \$(srcdir)/c/c-tree.h \$(srcdir)/c/c-decl.c \$(srcdir)/c/c-lang.h \$(srcdir)/c/c-objc-common.c \$(srcdir)/c-family/c-common.c \$(srcdir)/c-family/c-common.h \$(srcdir)/c-family/c-cppbuiltin.c \$(srcdir)/c-family/c-pragma.h \$(srcdir)/c-family/c-pragma.c \$(srcdir)/c-family/c-format.c" --- gcc/objcp/config-lang.in (revision 271054) +++ gcc/objcp/config-lang.in (revision 271055) @@ -52,7 +52,6 @@ gtfiles="$(. $srcdir/cp/config-lang.in ; gtfiles="$gtfiles \ \$(srcdir)/objc/objc-act.h \ \$(srcdir)/objc/objc-map.h \ -\$(srcdir)/c-family/c-cppbuiltin.c \ \$(srcdir)/objc/objc-act.c \ \$(srcdir)/objc/objc-gnu-runtime-abi-01.c \ \$(srcdir)/objc/objc-next-runtime-abi-01.c \ --- gcc/testsuite/g++.dg/pch/pr90326.Hs (nonexistent) +++ gcc/testsuite/g++.dg/pch/pr90326.Hs (revision 271055) @@ -0,0 +1 @@ +// empty --- gcc/testsuite/g++.dg/pch/pr90326.C (nonexistent) +++ gcc/testsuite/g++.dg/pch/pr90326.C (revision 271055) @@ -0,0 +1,9 @@ +#include "pr90326.H" + +int main() +{ + float f = __FLT_MAX__; + if (f == 0.0) + __builtin_abort (); + return 0; +}
2019-05-17 Jakub Jelinek <ja...@redhat.com> Backported from mainline 2019-05-10 Jakub Jelinek <ja...@redhat.com> PR c++/90383 * tree-inline.h (struct copy_body_data): Add do_not_fold member. * tree-inline.c (remap_gimple_op_r): Avoid folding expressions if id->do_not_fold. (copy_tree_body_r): Likewise. (copy_fn): Set id.do_not_fold to true. * g++.dg/cpp1y/constexpr-90383-1.C: New test. * g++.dg/cpp1y/constexpr-90383-2.C: New test. --- gcc/tree-inline.h (revision 271057) +++ gcc/tree-inline.h (revision 271058) @@ -113,6 +113,9 @@ struct copy_body_data /* True if trees may not be unshared. */ bool do_not_unshare; + /* True if trees should not be folded during the copying. */ + bool do_not_fold; + /* True if new declarations may not be created during type remapping. */ bool prevent_decl_creation_for_types; --- gcc/tree-inline.c (revision 271057) +++ gcc/tree-inline.c (revision 271058) @@ -1101,7 +1101,7 @@ remap_gimple_op_r (tree *tp, int *walk_s /* Otherwise, just copy the node. Note that copy_tree_r already knows not to copy VAR_DECLs, etc., so this is safe. */ - if (TREE_CODE (*tp) == MEM_REF) + if (TREE_CODE (*tp) == MEM_REF && !id->do_not_fold) { /* We need to re-canonicalize MEM_REFs from inline substitutions that can happen when a pointer argument is an ADDR_EXPR. @@ -1327,11 +1327,11 @@ copy_tree_body_r (tree *tp, int *walk_su tree type = TREE_TYPE (*tp); tree ptr = id->do_not_unshare ? *n : unshare_expr (*n); tree old = *tp; - *tp = gimple_fold_indirect_ref (ptr); + *tp = id->do_not_fold ? NULL : gimple_fold_indirect_ref (ptr); if (! *tp) { type = remap_type (type, id); - if (TREE_CODE (ptr) == ADDR_EXPR) + if (TREE_CODE (ptr) == ADDR_EXPR && !id->do_not_fold) { *tp = fold_indirect_ref_1 (EXPR_LOCATION (ptr), type, ptr); @@ -1360,7 +1360,7 @@ copy_tree_body_r (tree *tp, int *walk_su return NULL; } } - else if (TREE_CODE (*tp) == MEM_REF) + else if (TREE_CODE (*tp) == MEM_REF && !id->do_not_fold) { /* We need to re-canonicalize MEM_REFs from inline substitutions that can happen when a pointer argument is an ADDR_EXPR. @@ -1432,7 +1432,8 @@ copy_tree_body_r (tree *tp, int *walk_su /* Handle the case where we substituted an INDIRECT_REF into the operand of the ADDR_EXPR. */ - if (TREE_CODE (TREE_OPERAND (*tp, 0)) == INDIRECT_REF) + if (TREE_CODE (TREE_OPERAND (*tp, 0)) == INDIRECT_REF + && !id->do_not_fold) { tree t = TREE_OPERAND (TREE_OPERAND (*tp, 0), 0); if (TREE_TYPE (t) != TREE_TYPE (*tp)) @@ -6370,6 +6371,7 @@ copy_fn (tree fn, tree& parms, tree& res since front-end specific mechanisms may rely on sharing. */ id.regimplify = false; id.do_not_unshare = true; + id.do_not_fold = true; /* We're not inside any EH region. */ id.eh_lp_nr = 0; --- gcc/testsuite/g++.dg/cpp1y/constexpr-90383-1.C (nonexistent) +++ gcc/testsuite/g++.dg/cpp1y/constexpr-90383-1.C (revision 271058) @@ -0,0 +1,15 @@ +// PR c++/90383 +// { dg-do compile { target c++14 } } + +struct alignas(8) A { constexpr A (bool x) : a(x) {} A () = delete; bool a; }; +struct B { A b; }; + +constexpr bool +foo () +{ + B w{A (true)}; + w.b = A (true); + return w.b.a; +} + +static_assert (foo (), ""); --- gcc/testsuite/g++.dg/cpp1y/constexpr-90383-2.C (nonexistent) +++ gcc/testsuite/g++.dg/cpp1y/constexpr-90383-2.C (revision 271058) @@ -0,0 +1,22 @@ +// PR c++/90383 +// { dg-do run { target c++14 } } +// { dg-options "-O2" } + +extern "C" void abort (); +struct alignas(8) A { constexpr A (bool x) : a(x) {} A () = default; bool a; }; +struct B { A b; }; + +constexpr bool +foo () +{ + B w{A (true)}; + w.b = A (true); + return w.b.a; +} + +int +main () +{ + if (!foo ()) + abort (); +}
2019-05-17 Jakub Jelinek <ja...@redhat.com> Backported from mainline 2019-05-10 Jakub Jelinek <ja...@redhat.com> PR tree-optimization/90385 * tree-parloops.c (try_create_reduction_list): Punt on non-SSA_NAME arguments of the exit phis. * gfortran.dg/pr90385.f90: New test. --- gcc/tree-parloops.c (revision 271058) +++ gcc/tree-parloops.c (revision 271059) @@ -2794,8 +2794,16 @@ try_create_reduction_list (loop_p loop, gimple *reduc_phi; tree val = PHI_ARG_DEF_FROM_EDGE (phi, exit); - if (TREE_CODE (val) == SSA_NAME && !virtual_operand_p (val)) + if (!virtual_operand_p (val)) { + if (TREE_CODE (val) != SSA_NAME) + { + if (dump_file && (dump_flags & TDF_DETAILS)) + fprintf (dump_file, + " FAILED: exit PHI argument invariant.\n"); + return false; + } + if (dump_file && (dump_flags & TDF_DETAILS)) { fprintf (dump_file, "phi is "); --- gcc/testsuite/gfortran.dg/pr90385.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/pr90385.f90 (revision 271059) @@ -0,0 +1,6 @@ +! PR tree-optimization/90385 +! { dg-do compile } +! { dg-require-effective-target pthread } +! { dg-options "-O1 -ftree-parallelize-loops=2 -fno-tree-ccp -fno-tree-ch -fno-tree-copy-prop -fno-tree-forwprop -fno-tree-sink --param parloops-min-per-thread=5" } + +include 'array_constructor_47.f90'
2019-05-17 Jakub Jelinek <ja...@redhat.com> Backported from mainline 2019-05-15 Jakub Jelinek <ja...@redhat.com> PR debug/90197 * cp-gimplify.c (genericize_cp_loop): Emit a DEBUG_BEGIN_STMT before the condition (or if missing or constant non-zero at the end of the loop. Emit a DEBUG_BEGIN_STMT before the increment expression if any. Don't call protected_set_expr_location on incr if it already has a location. --- gcc/cp/cp-gimplify.c (revision 271268) +++ gcc/cp/cp-gimplify.c (revision 271269) @@ -241,8 +241,10 @@ genericize_cp_loop (tree *stmt_p, locati tree blab, clab; tree exit = NULL; tree stmt_list = NULL; + tree debug_begin = NULL; - protected_set_expr_location (incr, start_locus); + if (EXPR_LOCATION (incr) == UNKNOWN_LOCATION) + protected_set_expr_location (incr, start_locus); cp_walk_tree (&cond, cp_genericize_r, data, NULL); cp_walk_tree (&incr, cp_genericize_r, data, NULL); @@ -253,6 +255,13 @@ genericize_cp_loop (tree *stmt_p, locati cp_walk_tree (&body, cp_genericize_r, data, NULL); *walk_subtrees = 0; + if (MAY_HAVE_DEBUG_MARKER_STMTS + && (!cond || !integer_zerop (cond))) + { + debug_begin = build0 (DEBUG_BEGIN_STMT, void_type_node); + SET_EXPR_LOCATION (debug_begin, cp_expr_loc_or_loc (cond, start_locus)); + } + if (cond && TREE_CODE (cond) != INTEGER_CST) { /* If COND is constant, don't bother building an exit. If it's false, @@ -265,10 +274,24 @@ genericize_cp_loop (tree *stmt_p, locati } if (exit && cond_is_first) - append_to_statement_list (exit, &stmt_list); + { + append_to_statement_list (debug_begin, &stmt_list); + debug_begin = NULL_TREE; + append_to_statement_list (exit, &stmt_list); + } append_to_statement_list (body, &stmt_list); finish_bc_block (&stmt_list, bc_continue, clab); - append_to_statement_list (incr, &stmt_list); + if (incr) + { + if (MAY_HAVE_DEBUG_MARKER_STMTS) + { + tree d = build0 (DEBUG_BEGIN_STMT, void_type_node); + SET_EXPR_LOCATION (d, cp_expr_loc_or_loc (incr, start_locus)); + append_to_statement_list (d, &stmt_list); + } + append_to_statement_list (incr, &stmt_list); + } + append_to_statement_list (debug_begin, &stmt_list); if (exit && !cond_is_first) append_to_statement_list (exit, &stmt_list);
2019-05-17 Jakub Jelinek <ja...@redhat.com> Backported from mainline 2019-05-15 Jakub Jelinek <ja...@redhat.com> * omp-low.c (lower_rec_input_clauses): For if (0) or simdlen (1) set max_vf to 1. * omp-expand.c (expand_omp_simd): For if (0) or simdlen (1) clear safelen_int and set loop->dont_vectorize. * c-c++-common/gomp/simd8.c: New test. --- gcc/omp-low.c (revision 271269) +++ gcc/omp-low.c (revision 271270) @@ -3811,6 +3811,14 @@ lower_rec_input_clauses (tree clauses, g || is_variable_sized (OMP_CLAUSE_DECL (c))) sctx.max_vf = 1; break; + case OMP_CLAUSE_IF: + if (integer_zerop (OMP_CLAUSE_IF_EXPR (c))) + sctx.max_vf = 1; + break; + case OMP_CLAUSE_SIMDLEN: + if (integer_onep (OMP_CLAUSE_SIMDLEN_EXPR (c))) + sctx.max_vf = 1; + break; default: continue; } --- gcc/omp-expand.c (revision 271269) +++ gcc/omp-expand.c (revision 271270) @@ -4664,10 +4664,15 @@ expand_omp_simd (struct omp_region *regi tree *counts = NULL; int i; int safelen_int = INT_MAX; + bool dont_vectorize = false; tree safelen = omp_find_clause (gimple_omp_for_clauses (fd->for_stmt), OMP_CLAUSE_SAFELEN); tree simduid = omp_find_clause (gimple_omp_for_clauses (fd->for_stmt), OMP_CLAUSE__SIMDUID_); + tree ifc = omp_find_clause (gimple_omp_for_clauses (fd->for_stmt), + OMP_CLAUSE_IF); + tree simdlen = omp_find_clause (gimple_omp_for_clauses (fd->for_stmt), + OMP_CLAUSE_SIMDLEN); tree n1, n2; if (safelen) @@ -4681,6 +4686,12 @@ expand_omp_simd (struct omp_region *regi if (safelen_int == 1) safelen_int = 0; } + if ((ifc && integer_zerop (OMP_CLAUSE_IF_EXPR (ifc))) + || (simdlen && integer_onep (OMP_CLAUSE_SIMDLEN_EXPR (simdlen)))) + { + safelen_int = 0; + dont_vectorize = true; + } type = TREE_TYPE (fd->loop.v); entry_bb = region->entry; cont_bb = region->cont; @@ -4965,6 +4976,8 @@ expand_omp_simd (struct omp_region *regi loop->force_vectorize = true; cfun->has_force_vectorize_loops = true; } + else if (dont_vectorize) + loop->dont_vectorize = true; } else if (simduid) cfun->has_simduid_loops = true; --- gcc/testsuite/c-c++-common/gomp/simd8.c (nonexistent) +++ gcc/testsuite/c-c++-common/gomp/simd8.c (revision 271270) @@ -0,0 +1,37 @@ +/* { dg-do compile } */ +/* { dg-options "-fopenmp -O3 -fdump-tree-vect-details" } */ +/* { dg-final { scan-tree-dump-times "vectorized 0 loops in function" 4 "vect" } } */ + +int a[1024]; + +void +foo (void) +{ + #pragma omp simd if (0) + for (int i = 0; i < 1024; ++i) + a[i] = a[i] + 1; +} + +void +bar (void) +{ + #pragma omp simd if (0) safelen (256) simdlen (8) + for (int i = 0; i < 512; ++i) + a[i] = a[i] + 1; +} + +void +baz (void) +{ + #pragma omp simd safelen (256) simdlen (1) + for (int i = 0; i < 512; ++i) + a[i] = a[i] + 1; +} + +void +qux (void) +{ + #pragma omp simd simdlen (1) if (1) + for (int i = 0; i < 512; ++i) + a[i] = a[i] + 1; +}
2019-05-17 Jakub Jelinek <ja...@redhat.com> Backported from mainline 2019-05-16 Jakub Jelinek <ja...@redhat.com> * omp-low.c (lower_rec_input_clauses): If OMP_CLAUSE_IF has non-constant expression, force sctx.lane and use two argument IFN_GOMP_SIMD_LANE instead of single argument. * tree-ssa-dce.c (eliminate_unnecessary_stmts): Don't DCE two argument IFN_GOMP_SIMD_LANE without lhs. * tree-vectorizer.h (struct _loop_vec_info): Add simd_if_cond member. (LOOP_VINFO_SIMD_IF_COND, LOOP_REQUIRES_VERSIONING_FOR_SIMD_IF_COND): Define. (LOOP_REQUIRES_VERSIONING): Or in LOOP_REQUIRES_VERSIONING_FOR_SIMD_IF_COND. * tree-vect-loop.c (_loop_vec_info::_loop_vec_info): Initialize simd_if_cond. (vect_analyze_loop_2): Punt if LOOP_VINFO_SIMD_IF_COND is constant 0. * tree-vect-loop-manip.c (vect_loop_versioning): Add runtime check from simd if clause if needed. * gcc.dg/vect/vect-simd-1.c: New test. * gcc.dg/vect/vect-simd-2.c: New test. * gcc.dg/vect/vect-simd-3.c: New test. * gcc.dg/vect/vect-simd-4.c: New test. --- gcc/omp-low.c (revision 271297) +++ gcc/omp-low.c (revision 271298) @@ -3783,6 +3783,7 @@ lower_rec_input_clauses (tree clauses, g tree simt_lane = NULL_TREE, simtrec = NULL_TREE; tree ivar = NULL_TREE, lvar = NULL_TREE, uid = NULL_TREE; gimple_seq llist[3] = { }; + tree nonconst_simd_if = NULL_TREE; copyin_seq = NULL; sctx.is_simt = is_simd && omp_find_clause (clauses, OMP_CLAUSE__SIMT_); @@ -3814,6 +3815,8 @@ lower_rec_input_clauses (tree clauses, g case OMP_CLAUSE_IF: if (integer_zerop (OMP_CLAUSE_IF_EXPR (c))) sctx.max_vf = 1; + else if (TREE_CODE (OMP_CLAUSE_IF_EXPR (c)) != INTEGER_CST) + nonconst_simd_if = OMP_CLAUSE_IF_EXPR (c); break; case OMP_CLAUSE_SIMDLEN: if (integer_onep (OMP_CLAUSE_SIMDLEN_EXPR (c))) @@ -5190,6 +5193,17 @@ lower_rec_input_clauses (tree clauses, g if (known_eq (sctx.max_vf, 1U)) sctx.is_simt = false; + if (nonconst_simd_if) + { + if (sctx.lane == NULL_TREE) + { + sctx.idx = create_tmp_var (unsigned_type_node); + sctx.lane = create_tmp_var (unsigned_type_node); + } + /* FIXME: For now. */ + sctx.is_simt = false; + } + if (sctx.lane || sctx.is_simt) { uid = create_tmp_var (ptr_type_node, "simduid"); @@ -5219,8 +5233,9 @@ lower_rec_input_clauses (tree clauses, g } if (sctx.lane) { - gimple *g - = gimple_build_call_internal (IFN_GOMP_SIMD_LANE, 1, uid); + gimple *g = gimple_build_call_internal (IFN_GOMP_SIMD_LANE, + 1 + (nonconst_simd_if != NULL), + uid, nonconst_simd_if); gimple_call_set_lhs (g, sctx.lane); gimple_stmt_iterator gsi = gsi_start_1 (gimple_omp_body_ptr (ctx->stmt)); gsi_insert_before_without_update (&gsi, g, GSI_SAME_STMT); --- gcc/tree-vect-loop-manip.c (revision 271297) +++ gcc/tree-vect-loop-manip.c (revision 271298) @@ -3009,6 +3009,8 @@ vect_loop_versioning (loop_vec_info loop bool version_align = LOOP_REQUIRES_VERSIONING_FOR_ALIGNMENT (loop_vinfo); bool version_alias = LOOP_REQUIRES_VERSIONING_FOR_ALIAS (loop_vinfo); bool version_niter = LOOP_REQUIRES_VERSIONING_FOR_NITERS (loop_vinfo); + tree version_simd_if_cond + = LOOP_REQUIRES_VERSIONING_FOR_SIMD_IF_COND (loop_vinfo); if (check_profitability) cond_expr = fold_build2 (GE_EXPR, boolean_type_node, scalar_loop_iters, @@ -3044,6 +3046,31 @@ vect_loop_versioning (loop_vec_info loop vect_create_cond_for_alias_checks (loop_vinfo, &cond_expr); } + if (version_simd_if_cond) + { + gcc_assert (dom_info_available_p (CDI_DOMINATORS)); + if (flag_checking) + if (basic_block bb + = gimple_bb (SSA_NAME_DEF_STMT (version_simd_if_cond))) + gcc_assert (bb != loop->header + && dominated_by_p (CDI_DOMINATORS, loop->header, bb) + && (scalar_loop == NULL + || (bb != scalar_loop->header + && dominated_by_p (CDI_DOMINATORS, + scalar_loop->header, bb)))); + tree zero = build_zero_cst (TREE_TYPE (version_simd_if_cond)); + tree c = fold_build2 (NE_EXPR, boolean_type_node, + version_simd_if_cond, zero); + if (cond_expr) + cond_expr = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, + c, cond_expr); + else + cond_expr = c; + if (dump_enabled_p ()) + dump_printf_loc (MSG_NOTE, vect_location, + "created versioning for simd if condition check.\n"); + } + cond_expr = force_gimple_operand_1 (unshare_expr (cond_expr), &gimplify_stmt_list, is_gimple_condexpr, NULL_TREE); --- gcc/tree-vectorizer.h (revision 271297) +++ gcc/tree-vectorizer.h (revision 271298) @@ -428,6 +428,13 @@ typedef struct _loop_vec_info : public v loops. */ tree mask_compare_type; + /* For #pragma omp simd if (x) loops the x expression. If constant 0, + the loop should not be vectorized, if constant non-zero, simd_if_cond + shouldn't be set and loop vectorized normally, if SSA_NAME, the loop + should be versioned on that condition, using scalar loop if the condition + is false and vectorized loop otherwise. */ + tree simd_if_cond; + /* Unknown DRs according to which loop was peeled. */ struct dr_vec_info *unaligned_dr; @@ -591,6 +598,7 @@ typedef struct _loop_vec_info : public v #define LOOP_VINFO_SCALAR_ITERATION_COST(L) (L)->scalar_cost_vec #define LOOP_VINFO_SINGLE_SCALAR_ITERATION_COST(L) (L)->single_scalar_iteration_cost #define LOOP_VINFO_ORIG_LOOP_INFO(L) (L)->orig_loop_info +#define LOOP_VINFO_SIMD_IF_COND(L) (L)->simd_if_cond #define LOOP_REQUIRES_VERSIONING_FOR_ALIGNMENT(L) \ ((L)->may_misalign_stmts.length () > 0) @@ -600,10 +608,13 @@ typedef struct _loop_vec_info : public v || (L)->lower_bounds.length () > 0) #define LOOP_REQUIRES_VERSIONING_FOR_NITERS(L) \ (LOOP_VINFO_NITERS_ASSUMPTIONS (L)) +#define LOOP_REQUIRES_VERSIONING_FOR_SIMD_IF_COND(L) \ + (LOOP_VINFO_SIMD_IF_COND (L)) #define LOOP_REQUIRES_VERSIONING(L) \ (LOOP_REQUIRES_VERSIONING_FOR_ALIGNMENT (L) \ || LOOP_REQUIRES_VERSIONING_FOR_ALIAS (L) \ - || LOOP_REQUIRES_VERSIONING_FOR_NITERS (L)) + || LOOP_REQUIRES_VERSIONING_FOR_NITERS (L) \ + || LOOP_REQUIRES_VERSIONING_FOR_SIMD_IF_COND (L)) #define LOOP_VINFO_NITERS_KNOWN_P(L) \ (tree_fits_shwi_p ((L)->num_iters) && tree_to_shwi ((L)->num_iters) > 0) --- gcc/tree-vect-loop.c (revision 271297) +++ gcc/tree-vect-loop.c (revision 271298) @@ -819,6 +819,7 @@ _loop_vec_info::_loop_vec_info (struct l max_vectorization_factor (0), mask_skip_niters (NULL_TREE), mask_compare_type (NULL_TREE), + simd_if_cond (NULL_TREE), unaligned_dr (NULL), peeling_for_alignment (0), ptr_mask (0), @@ -862,6 +863,26 @@ _loop_vec_info::_loop_vec_info (struct l gimple *stmt = gsi_stmt (si); gimple_set_uid (stmt, 0); add_stmt (stmt); + /* If .GOMP_SIMD_LANE call for the current loop has 2 arguments, the + second argument is the #pragma omp simd if (x) condition, when 0, + loop shouldn't be vectorized, when non-zero constant, it should + be vectorized normally, otherwise versioned with vectorized loop + done if the condition is non-zero at runtime. */ + if (loop_in->simduid + && is_gimple_call (stmt) + && gimple_call_internal_p (stmt) + && gimple_call_internal_fn (stmt) == IFN_GOMP_SIMD_LANE + && gimple_call_num_args (stmt) >= 2 + && TREE_CODE (gimple_call_arg (stmt, 0)) == SSA_NAME + && (loop_in->simduid + == SSA_NAME_VAR (gimple_call_arg (stmt, 0)))) + { + tree arg = gimple_call_arg (stmt, 1); + if (integer_zerop (arg) || TREE_CODE (arg) == SSA_NAME) + simd_if_cond = arg; + else + gcc_assert (integer_nonzerop (arg)); + } } } } @@ -1769,6 +1790,11 @@ vect_analyze_loop_2 (loop_vec_info loop_ /* The first group of checks is independent of the vector size. */ fatal = true; + if (LOOP_VINFO_SIMD_IF_COND (loop_vinfo) + && integer_zerop (LOOP_VINFO_SIMD_IF_COND (loop_vinfo))) + return opt_result::failure_at (vect_location, + "not vectorized: simd if(0)\n"); + /* Find all data references in the loop (which correspond to vdefs/vuses) and analyze their evolution in the loop. */ --- gcc/tree-ssa-dce.c (revision 271297) +++ gcc/tree-ssa-dce.c (revision 271298) @@ -1328,12 +1328,16 @@ eliminate_unnecessary_stmts (void) update_stmt (stmt); release_ssa_name (name); - /* GOMP_SIMD_LANE or ASAN_POISON without lhs is not - needed. */ + /* GOMP_SIMD_LANE (unless two argument) or ASAN_POISON + without lhs is not needed. */ if (gimple_call_internal_p (stmt)) switch (gimple_call_internal_fn (stmt)) { case IFN_GOMP_SIMD_LANE: + if (gimple_call_num_args (stmt) >= 2 + && !integer_nonzerop (gimple_call_arg (stmt, 1))) + break; + /* FALLTHRU */ case IFN_ASAN_POISON: remove_dead_stmt (&gsi, bb, to_remove_edges); break; --- gcc/testsuite/gcc.dg/vect/vect-simd-1.c (nonexistent) +++ gcc/testsuite/gcc.dg/vect/vect-simd-1.c (revision 271298) @@ -0,0 +1,64 @@ +/* { dg-additional-options "-fopenmp-simd" } */ +/* { dg-additional-options "-mavx" { target avx_runtime } } */ + +#include "tree-vect.h" + +#define N 1024 +int a[N]; +int x; + +__attribute__((noipa)) int +bar (void) +{ + return x; +} + +__attribute__((noipa)) void +foo (void) +{ + #pragma omp simd if (bar ()) + for (int i = 0; i < N; ++i) + a[i] = a[i] + 1; +} + +__attribute__((noipa)) void +baz (void) +{ + int c = 0; + #pragma omp simd if (c) + for (int i = 0; i < N; ++i) + a[i] = a[i] + 1; +} + +__attribute__((noipa)) void +qux (void) +{ + int c = 1; + #pragma omp simd if (c) + for (int i = 0; i < N; ++i) + a[i] = a[i] + 1; +} + +int +main () +{ + check_vect (); + foo (); + for (int i = 0; i < N; ++i) + if (a[i] != 1) + abort (); + x = 1; + foo (); + for (int i = 0; i < N; ++i) + if (a[i] != 2) + abort (); + baz (); + for (int i = 0; i < N; ++i) + if (a[i] != 3) + abort (); + qux (); + for (int i = 0; i < N; ++i) + if (a[i] != 4) + abort (); + return 0; +} --- gcc/testsuite/gcc.dg/vect/vect-simd-2.c (nonexistent) +++ gcc/testsuite/gcc.dg/vect/vect-simd-2.c (revision 271298) @@ -0,0 +1,18 @@ +/* { dg-do compile } */ +/* { dg-require-effective-target vect_int } */ +/* { dg-additional-options "-fopenmp-simd" } */ + +#define N 1024 +int a[N]; +int bar (void); + +void +foo (void) +{ + #pragma omp simd if (bar ()) + for (int i = 0; i < N; ++i) + a[i] = a[i] + 1; +} + +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" } } */ +/* { dg-final { scan-tree-dump-times "created versioning for simd if condition check" 1 "vect" } } */ --- gcc/testsuite/gcc.dg/vect/vect-simd-3.c (nonexistent) +++ gcc/testsuite/gcc.dg/vect/vect-simd-3.c (revision 271298) @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-require-effective-target vect_int } */ +/* { dg-additional-options "-fopenmp-simd" } */ + +#define N 1024 +int a[N]; + +void +foo (void) +{ + int c = 0; + #pragma omp simd if (c) + for (int i = 0; i < N; ++i) + a[i] = a[i] + 1; +} + +/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" } } */ --- gcc/testsuite/gcc.dg/vect/vect-simd-4.c (nonexistent) +++ gcc/testsuite/gcc.dg/vect/vect-simd-4.c (revision 271298) @@ -0,0 +1,18 @@ +/* { dg-do compile } */ +/* { dg-require-effective-target vect_int } */ +/* { dg-additional-options "-fopenmp-simd" } */ + +#define N 1024 +int a[N]; + +void +foo (void) +{ + int c = 1; + #pragma omp simd if (c) + for (int i = 0; i < N; ++i) + a[i] = a[i] + 1; +} + +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" } } */ +/* { dg-final { scan-tree-dump-not "created versioning for simd if condition check" "vect" } } */
2019-05-17 Jakub Jelinek <ja...@redhat.com> Backported from mainline 2019-05-16 Jakub Jelinek <ja...@redhat.com> PR c++/90484 * tree-ssa-scopedtables.c (equal_mem_array_ref_p): Don't assert that sz0 is equal to sz1, instead return false in that case. --- gcc/tree-ssa-scopedtables.c (revision 271298) +++ gcc/tree-ssa-scopedtables.c (revision 271299) @@ -537,13 +537,10 @@ equal_mem_array_ref_p (tree t0, tree t1) || maybe_ne (sz1, max1)) return false; - if (rev0 != rev1) + if (rev0 != rev1 || maybe_ne (sz0, sz1) || maybe_ne (off0, off1)) return false; - /* Types were compatible, so this is a sanity check. */ - gcc_assert (known_eq (sz0, sz1)); - - return known_eq (off0, off1) && operand_equal_p (base0, base1, 0); + return operand_equal_p (base0, base1, 0); } /* Compare two hashable_expr structures for equivalence. They are
2019-05-17 Jakub Jelinek <ja...@redhat.com> PR fortran/54613 * gfortran.map (GFORTRAN_9.2): New symbol version, export _gfortran_{,m,s}findloc0_i2 in it. --- libgfortran/gfortran.map (revision 271333) +++ libgfortran/gfortran.map (revision 271334) @@ -1590,3 +1590,9 @@ GFORTRAN_9 { __ieee_arithmetic_MOD_ieee_support_subnormal_8; __ieee_arithmetic_MOD_ieee_support_subnormal_noarg; } GFORTRAN_8; + +GFORTRAN_9.2 { + _gfortran_findloc0_i2; + _gfortran_mfindloc0_i2; + _gfortran_sfindloc0_i2; +} GFORTRAN_9;
2019-05-17 Jakub Jelinek <ja...@redhat.com> PR fortran/54613 * gfortran.map (GFORTRAN_9.2): Export _gfortran_{,m,s}findloc{0,1}_r10. * Makefile.am (i_findloc0_c): Add $(srcdir)/generated/findloc0_r10.c. (i_findloc1_c): Add $(srcdir)/generated/findloc1_r10.c. * Makefile.in: Regenerated. * generated/findloc0_r10.c: Generated. * generated/findloc1_r10.c: Generated. --- libgfortran/gfortran.map (revision 271334) +++ libgfortran/gfortran.map (revision 271335) @@ -1593,6 +1593,12 @@ GFORTRAN_9 { GFORTRAN_9.2 { _gfortran_findloc0_i2; + _gfortran_findloc0_r10; _gfortran_mfindloc0_i2; + _gfortran_mfindloc0_r10; _gfortran_sfindloc0_i2; + _gfortran_sfindloc0_r10; + _gfortran_findloc1_r10; + _gfortran_mfindloc1_r10; + _gfortran_sfindloc1_r10; } GFORTRAN_9; --- libgfortran/Makefile.am (revision 271334) +++ libgfortran/Makefile.am (revision 271335) @@ -278,6 +278,7 @@ $(srcdir)/generated/findloc0_i8.c \ $(srcdir)/generated/findloc0_i16.c \ $(srcdir)/generated/findloc0_r4.c \ $(srcdir)/generated/findloc0_r8.c \ +$(srcdir)/generated/findloc0_r10.c \ $(srcdir)/generated/findloc0_r16.c \ $(srcdir)/generated/findloc0_c4.c \ $(srcdir)/generated/findloc0_c8.c \ @@ -295,6 +296,7 @@ $(srcdir)/generated/findloc1_i8.c \ $(srcdir)/generated/findloc1_i16.c \ $(srcdir)/generated/findloc1_r4.c \ $(srcdir)/generated/findloc1_r8.c \ +$(srcdir)/generated/findloc1_r10.c \ $(srcdir)/generated/findloc1_r16.c \ $(srcdir)/generated/findloc1_c4.c \ $(srcdir)/generated/findloc1_c8.c \ --- libgfortran/Makefile.in (revision 271334) +++ libgfortran/Makefile.in (revision 271335) @@ -371,11 +371,13 @@ am__objects_45 = maxval1_s1.lo maxval1_s am__objects_46 = minval1_s1.lo minval1_s4.lo am__objects_47 = findloc0_i1.lo findloc0_i2.lo findloc0_i4.lo \ findloc0_i8.lo findloc0_i16.lo findloc0_r4.lo findloc0_r8.lo \ - findloc0_r16.lo findloc0_c4.lo findloc0_c8.lo findloc0_c16.lo + findloc0_r10.lo findloc0_r16.lo findloc0_c4.lo findloc0_c8.lo \ + findloc0_c16.lo am__objects_48 = findloc0_s1.lo findloc0_s4.lo am__objects_49 = findloc1_i1.lo findloc1_i2.lo findloc1_i4.lo \ findloc1_i8.lo findloc1_i16.lo findloc1_r4.lo findloc1_r8.lo \ - findloc1_r16.lo findloc1_c4.lo findloc1_c8.lo findloc1_c16.lo + findloc1_r10.lo findloc1_r16.lo findloc1_c4.lo findloc1_c8.lo \ + findloc1_c16.lo am__objects_50 = findloc1_s1.lo findloc1_s4.lo am__objects_51 = findloc2_s1.lo findloc2_s4.lo am__objects_52 = ISO_Fortran_binding.lo @@ -836,6 +838,7 @@ $(srcdir)/generated/findloc0_i8.c \ $(srcdir)/generated/findloc0_i16.c \ $(srcdir)/generated/findloc0_r4.c \ $(srcdir)/generated/findloc0_r8.c \ +$(srcdir)/generated/findloc0_r10.c \ $(srcdir)/generated/findloc0_r16.c \ $(srcdir)/generated/findloc0_c4.c \ $(srcdir)/generated/findloc0_c8.c \ @@ -853,6 +856,7 @@ $(srcdir)/generated/findloc1_i8.c \ $(srcdir)/generated/findloc1_i16.c \ $(srcdir)/generated/findloc1_r4.c \ $(srcdir)/generated/findloc1_r8.c \ +$(srcdir)/generated/findloc1_r10.c \ $(srcdir)/generated/findloc1_r16.c \ $(srcdir)/generated/findloc1_c4.c \ $(srcdir)/generated/findloc1_c8.c \ @@ -1824,6 +1828,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_i2.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_i4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_r10.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_r16.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_r4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_r8.Plo@am__quote@ @@ -1837,6 +1842,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_i2.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_i4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_r10.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_r16.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_r4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_r8.Plo@am__quote@ @@ -5949,6 +5955,13 @@ findloc0_r8.lo: $(srcdir)/generated/find @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o findloc0_r8.lo `test -f '$(srcdir)/generated/findloc0_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_r8.c +findloc0_r10.lo: $(srcdir)/generated/findloc0_r10.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc0_r10.lo -MD -MP -MF $(DEPDIR)/findloc0_r10.Tpo -c -o findloc0_r10.lo `test -f '$(srcdir)/generated/findloc0_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_r10.c +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/findloc0_r10.Tpo $(DEPDIR)/findloc0_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$(srcdir)/generated/findloc0_r10.c' object='findloc0_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o findloc0_r10.lo `test -f '$(srcdir)/generated/findloc0_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_r10.c + findloc0_r16.lo: $(srcdir)/generated/findloc0_r16.c @am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc0_r16.lo -MD -MP -MF $(DEPDIR)/findloc0_r16.Tpo -c -o findloc0_r16.lo `test -f '$(srcdir)/generated/findloc0_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_r16.c @am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/findloc0_r16.Tpo $(DEPDIR)/findloc0_r16.Plo @@ -6040,6 +6053,13 @@ findloc1_r8.lo: $(srcdir)/generated/find @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o findloc1_r8.lo `test -f '$(srcdir)/generated/findloc1_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_r8.c +findloc1_r10.lo: $(srcdir)/generated/findloc1_r10.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc1_r10.lo -MD -MP -MF $(DEPDIR)/findloc1_r10.Tpo -c -o findloc1_r10.lo `test -f '$(srcdir)/generated/findloc1_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_r10.c +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/findloc1_r10.Tpo $(DEPDIR)/findloc1_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$(srcdir)/generated/findloc1_r10.c' object='findloc1_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o findloc1_r10.lo `test -f '$(srcdir)/generated/findloc1_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_r10.c + findloc1_r16.lo: $(srcdir)/generated/findloc1_r16.c @am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc1_r16.lo -MD -MP -MF $(DEPDIR)/findloc1_r16.Tpo -c -o findloc1_r16.lo `test -f '$(srcdir)/generated/findloc1_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_r16.c @am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/findloc1_r16.Tpo $(DEPDIR)/findloc1_r16.Plo --- libgfortran/generated/findloc0_r10.c (nonexistent) +++ libgfortran/generated/findloc0_r10.c (revision 271336) @@ -0,0 +1,375 @@ + +/* Implementation of the FINDLOC intrinsic + Copyright (C) 2018-2019 Free Software Foundation, Inc. + Contributed by Thomas König <t...@tkoenig.net> + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + +#include "libgfortran.h" +#include <assert.h> + +#if defined (HAVE_GFC_REAL_10) +extern void findloc0_r10 (gfc_array_index_type * const restrict retarray, + gfc_array_r10 * const restrict array, GFC_REAL_10 value, + GFC_LOGICAL_4); +export_proto(findloc0_r10); + +void +findloc0_r10 (gfc_array_index_type * const restrict retarray, + gfc_array_r10 * const restrict array, GFC_REAL_10 value, + GFC_LOGICAL_4 back) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_10 *base; + index_type * restrict dest; + index_type rank; + index_type n; + index_type sz; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->base_addr == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); + retarray->dtype.rank = 1; + retarray->offset = 0; + retarray->base_addr = xmallocarray (rank, sizeof (index_type)); + } + else + { + if (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "FINDLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->base_addr; + + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + + sz = 1; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + sz *= extent[n]; + if (extent[n] <= 0) + return; + } + + for (n = 0; n < rank; n++) + count[n] = 0; + + if (back) + { + base = array->base_addr + (sz - 1) * 1; + + while (1) + { + do + { + if (unlikely(*base == value)) + { + for (n = 0; n < rank; n++) + dest[n * dstride] = extent[n] - count[n]; + + return; + } + base -= sstride[0] * 1; + } while(++count[0] != extent[0]); + + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base += sstride[n] * extent[n] * 1; + n++; + if (n >= rank) + return; + else + { + count[n]++; + base -= sstride[n] * 1; + } + } while (count[n] == extent[n]); + } + } + else + { + base = array->base_addr; + while (1) + { + do + { + if (unlikely(*base == value)) + { + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + + return; + } + base += sstride[0] * 1; + } while(++count[0] != extent[0]); + + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n] * 1; + n++; + if (n >= rank) + return; + else + { + count[n]++; + base += sstride[n] * 1; + } + } while (count[n] == extent[n]); + } + } + return; +} + +extern void mfindloc0_r10 (gfc_array_index_type * const restrict retarray, + gfc_array_r10 * const restrict array, GFC_REAL_10 value, + gfc_array_l1 *const restrict, GFC_LOGICAL_4); +export_proto(mfindloc0_r10); + +void +mfindloc0_r10 (gfc_array_index_type * const restrict retarray, + gfc_array_r10 * const restrict array, GFC_REAL_10 value, + gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_10 *base; + index_type * restrict dest; + GFC_LOGICAL_1 *mbase; + index_type rank; + index_type n; + int mask_kind; + index_type sz; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->base_addr == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); + retarray->dtype.rank = 1; + retarray->offset = 0; + retarray->base_addr = xmallocarray (rank, sizeof (index_type)); + } + else + { + if (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "FINDLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "FINDLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->base_addr; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + internal_error (NULL, "Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->base_addr; + + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + + sz = 1; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + sz *= extent[n]; + if (extent[n] <= 0) + return; + } + + for (n = 0; n < rank; n++) + count[n] = 0; + + if (back) + { + base = array->base_addr + (sz - 1) * 1; + mbase = mbase + (sz - 1) * mask_kind; + while (1) + { + do + { + if (unlikely(*mbase && *base == value)) + { + for (n = 0; n < rank; n++) + dest[n * dstride] = extent[n] - count[n]; + + return; + } + base -= sstride[0] * 1; + mbase -= mstride[0]; + } while(++count[0] != extent[0]); + + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base += sstride[n] * extent[n] * 1; + mbase -= mstride[n] * extent[n]; + n++; + if (n >= rank) + return; + else + { + count[n]++; + base -= sstride[n] * 1; + mbase += mstride[n]; + } + } while (count[n] == extent[n]); + } + } + else + { + base = array->base_addr; + while (1) + { + do + { + if (unlikely(*mbase && *base == value)) + { + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + + return; + } + base += sstride[0] * 1; + mbase += mstride[0]; + } while(++count[0] != extent[0]); + + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n] * 1; + mbase -= mstride[n] * extent[n]; + n++; + if (n >= rank) + return; + else + { + count[n]++; + base += sstride[n]* 1; + mbase += mstride[n]; + } + } while (count[n] == extent[n]); + } + } + return; +} + +extern void sfindloc0_r10 (gfc_array_index_type * const restrict retarray, + gfc_array_r10 * const restrict array, GFC_REAL_10 value, + GFC_LOGICAL_4 *, GFC_LOGICAL_4); +export_proto(sfindloc0_r10); + +void +sfindloc0_r10 (gfc_array_index_type * const restrict retarray, + gfc_array_r10 * const restrict array, GFC_REAL_10 value, + GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back) +{ + index_type rank; + index_type dstride; + index_type * restrict dest; + index_type n; + + if (mask == NULL || *mask) + { + findloc0_r10 (retarray, array, value, back); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + internal_error (NULL, "Rank of array needs to be > 0"); + + if (retarray->base_addr == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); + retarray->dtype.rank = 1; + retarray->offset = 0; + retarray->base_addr = xmallocarray (rank, sizeof (index_type)); + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "FINDLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->base_addr; + for (n = 0; n<rank; n++) + dest[n * dstride] = 0 ; +} + +#endif --- libgfortran/generated/findloc1_r10.c (nonexistent) +++ libgfortran/generated/findloc1_r10.c (revision 271336) @@ -0,0 +1,523 @@ +/* Implementation of the FINDLOC intrinsic + Copyright (C) 2018-2019 Free Software Foundation, Inc. + Contributed by Thomas König <t...@tkoenig.net> + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + +#include "libgfortran.h" +#include <assert.h> + +#if defined (HAVE_GFC_REAL_10) +extern void findloc1_r10 (gfc_array_index_type * const restrict retarray, + gfc_array_r10 * const restrict array, GFC_REAL_10 value, + const index_type * restrict pdim, GFC_LOGICAL_4 back); +export_proto(findloc1_r10); + +extern void +findloc1_r10 (gfc_array_index_type * const restrict retarray, + gfc_array_r10 * const restrict array, GFC_REAL_10 value, + const index_type * restrict pdim, GFC_LOGICAL_4 back) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + index_type * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + rank = GFC_DESCRIPTOR_RANK (array) - 1; + dim = (*pdim) - 1; + + if (unlikely (dim < 0 || dim > rank)) + { + runtime_error ("Dim argument incorrect in FINDLOC intrinsic: " + "is %ld, should be between 1 and %ld", + (long int) dim + 1, (long int) rank + 1); + } + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->base_addr == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype.rank = rank; + + alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + + retarray->base_addr = xmallocarray (alloc_size, sizeof (index_type)); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " FINDLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "FINDLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->base_addr; + continue_loop = 1; + + base = array->base_addr; + while (continue_loop) + { + const GFC_REAL_10 * restrict src; + index_type result; + + result = 0; + if (back) + { + src = base + (len - 1) * delta * 1; + for (n = len; n > 0; n--, src -= delta * 1) + { + if (*src == value) + { + result = n; + break; + } + } + } + else + { + src = base; + for (n = 1; n <= len; n++, src += delta * 1) + { + if (*src == value) + { + result = n; + break; + } + } + } + *dest = result; + + count[0]++; + base += sstride[0] * 1; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + count[n] = 0; + base -= sstride[n] * extent[n] * 1; + dest -= dstride[n] * extent[n]; + n++; + if (n >= rank) + { + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n] * 1; + dest += dstride[n]; + } + } + } +} +extern void mfindloc1_r10 (gfc_array_index_type * const restrict retarray, + gfc_array_r10 * const restrict array, GFC_REAL_10 value, + const index_type * restrict pdim, gfc_array_l1 *const restrict mask, + GFC_LOGICAL_4 back); +export_proto(mfindloc1_r10); + +extern void +mfindloc1_r10 (gfc_array_index_type * const restrict retarray, + gfc_array_r10 * const restrict array, GFC_REAL_10 value, + const index_type * restrict pdim, gfc_array_l1 *const restrict mask, + GFC_LOGICAL_4 back) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + index_type * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + index_type dim; + int mask_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + rank = GFC_DESCRIPTOR_RANK (array) - 1; + dim = (*pdim) - 1; + + if (unlikely (dim < 0 || dim > rank)) + { + runtime_error ("Dim argument incorrect in FINDLOC intrinsic: " + "is %ld, should be between 1 and %ld", + (long int) dim + 1, (long int) rank + 1); + } + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + mbase = mask->base_addr; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + internal_error (NULL, "Funny sized logical array"); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->base_addr == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype.rank = rank; + + alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + + retarray->base_addr = xmallocarray (alloc_size, sizeof (index_type)); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " FINDLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "FINDLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->base_addr; + continue_loop = 1; + + base = array->base_addr; + while (continue_loop) + { + const GFC_REAL_10 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + index_type result; + + result = 0; + if (back) + { + src = base + (len - 1) * delta * 1; + msrc = mbase + (len - 1) * mdelta; + for (n = len; n > 0; n--, src -= delta * 1, msrc -= mdelta) + { + if (*msrc && *src == value) + { + result = n; + break; + } + } + } + else + { + src = base; + msrc = mbase; + for (n = 1; n <= len; n++, src += delta * 1, msrc += mdelta) + { + if (*msrc && *src == value) + { + result = n; + break; + } + } + } + *dest = result; + + count[0]++; + base += sstride[0] * 1; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + count[n] = 0; + base -= sstride[n] * extent[n] * 1; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n >= rank) + { + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n] * 1; + dest += dstride[n]; + } + } + } +} +extern void sfindloc1_r10 (gfc_array_index_type * const restrict retarray, + gfc_array_r10 * const restrict array, GFC_REAL_10 value, + const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask, + GFC_LOGICAL_4 back); +export_proto(sfindloc1_r10); + +extern void +sfindloc1_r10 (gfc_array_index_type * const restrict retarray, + gfc_array_r10 * const restrict array, GFC_REAL_10 value, + const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask, + GFC_LOGICAL_4 back) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type dim; + bool continue_loop; + + if (mask == NULL || *mask) + { + findloc1_r10 (retarray, array, value, pdim, back); + return; + } + /* Make dim zero based to avoid confusion. */ + rank = GFC_DESCRIPTOR_RANK (array) - 1; + dim = (*pdim) - 1; + + if (unlikely (dim < 0 || dim > rank)) + { + runtime_error ("Dim argument incorrect in FINDLOC intrinsic: " + "is %ld, should be between 1 and %ld", + (long int) dim + 1, (long int) rank + 1); + } + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + + if (retarray->base_addr == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + } + + retarray->offset = 0; + retarray->dtype.rank = rank; + + alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + + retarray->base_addr = xmallocarray (alloc_size, sizeof (index_type)); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " FINDLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "FINDLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + dest = retarray->base_addr; + continue_loop = 1; + + while (continue_loop) + { + *dest = 0; + + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + count[n] = 0; + dest -= dstride[n] * extent[n]; + n++; + if (n >= rank) + { + continue_loop = 0; + break; + } + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} +#endif