Backports to gcc-9-branch
Jakub Jelinek
jakub@redhat.com
Fri May 17 20:00:00 GMT 2019
Hi!
I've backported following 11 patches from trunk to gcc-9-branch,
bootstrapped/regtested on x86_64-linux and i686-linux, committed.
Jakub
-------------- next part --------------
2019-05-17 Jakub Jelinek <jakub@redhat.com>
Backported from mainline
2019-04-26 Jakub Jelinek <jakub@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)
-------------- next part --------------
2019-05-17 Jakub Jelinek <jakub@redhat.com>
Backported from mainline
2019-05-03 Jakub Jelinek <jakub@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;
-------------- next part --------------
2019-05-17 Jakub Jelinek <jakub@redhat.com>
Backported from mainline
2019-05-10 Jakub Jelinek <jakub@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;
+}
-------------- next part --------------
2019-05-17 Jakub Jelinek <jakub@redhat.com>
Backported from mainline
2019-05-10 Jakub Jelinek <jakub@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 ();
+}
-------------- next part --------------
2019-05-17 Jakub Jelinek <jakub@redhat.com>
Backported from mainline
2019-05-10 Jakub Jelinek <jakub@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'
-------------- next part --------------
2019-05-17 Jakub Jelinek <jakub@redhat.com>
Backported from mainline
2019-05-15 Jakub Jelinek <jakub@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);
-------------- next part --------------
2019-05-17 Jakub Jelinek <jakub@redhat.com>
Backported from mainline
2019-05-15 Jakub Jelinek <jakub@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;
+}
-------------- next part --------------
2019-05-17 Jakub Jelinek <jakub@redhat.com>
Backported from mainline
2019-05-16 Jakub Jelinek <jakub@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" } } */
-------------- next part --------------
2019-05-17 Jakub Jelinek <jakub@redhat.com>
Backported from mainline
2019-05-16 Jakub Jelinek <jakub@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
-------------- next part --------------
2019-05-17 Jakub Jelinek <jakub@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;
-------------- next part --------------
2019-05-17 Jakub Jelinek <jakub@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 <tk@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 <tk@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
More information about the Gcc-patches
mailing list