diff options
| author | yroux <yroux@138bc75d-0d04-0410-961f-82ee72b054a4> | 2014-07-16 14:43:37 +0000 |
|---|---|---|
| committer | yroux <yroux@138bc75d-0d04-0410-961f-82ee72b054a4> | 2014-07-16 14:43:37 +0000 |
| commit | 22f273dd122dd5e98dc9cfac46679d5ae9820f39 (patch) | |
| tree | d900c1f5612876011350fce385e3405b655aed32 /gcc | |
| parent | adbd300ac2f701398d973750759b0460c8c79364 (diff) | |
| download | linaro-gcc-22f273dd122dd5e98dc9cfac46679d5ae9820f39.tar.gz linaro-gcc-22f273dd122dd5e98dc9cfac46679d5ae9820f39.tar.bz2 linaro-gcc-22f273dd122dd5e98dc9cfac46679d5ae9820f39.zip | |
Merge branches/gcc-4_9-branch rev 212419
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/linaro/gcc-4_9-branch@212661 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
212 files changed, 13318 insertions, 2346 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index cb0d5e44140..641e4faf48a 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,352 @@ +2014-07-09 Alan Lawrence <alan.lawrence@arm.com> + + Backport r211369 from trunk. + 2014-06-09 Alan Lawrence <alan.lawrence@arm.com> + + PR target/61062 + * config/arm/arm_neon.h (vtrn_s8, vtrn_s16, vtrn_u8, vtrn_u16, vtrn_p8, + vtrn_p16, vtrn_s32, vtrn_f32, vtrn_u32, vtrnq_s8, vtrnq_s16, vtrnq_s32, + vtrnq_f32, vtrnq_u8, vtrnq_u16, vtrnq_u32, vtrnq_p8, vtrnq_p16, vzip_s8, + vzip_s16, vzip_u8, vzip_u16, vzip_p8, vzip_p16, vzip_s32, vzip_f32, + vzip_u32, vzipq_s8, vzipq_s16, vzipq_s32, vzipq_f32, vzipq_u8, + vzipq_u16, vzipq_u32, vzipq_p8, vzipq_p16, vuzp_s8, vuzp_s16, vuzp_s32, + vuzp_f32, vuzp_u8, vuzp_u16, vuzp_u32, vuzp_p8, vuzp_p16, vuzpq_s8, + vuzpq_s16, vuzpq_s32, vuzpq_f32, vuzpq_u8, vuzpq_u16, vuzpq_u32, + vuzpq_p8, vuzpq_p16): Correct mask for bigendian. + + +2014-07-09 Alan Lawrence <alan.lawrence@arm.com> + + Backport r210219 from trunk. + 2014-05-08 Ramana Radhakrishnan <ramana.radhakrishnan@arm.com> + + * config/arm/arm_neon.h: Update comment. + * config/arm/neon-docgen.ml: Delete. + * config/arm/neon-gen.ml: Delete. + * doc/arm-neon-intrinsics.texi: Update comment. + +2014-07-09 Zhenqiang Chen <zhenqiang.chen@linaro.org> + + Backport r211775 from trunk. + 2014-06-18 Terry Guo <terry.guo@arm.com> + + PR target/61544 + * config/arm/arm.c (thumb1_reorg): Move to next basic block if we + reach the head. + +2014-07-08 Jakub Jelinek <jakub@redhat.com> + + PR rtl-optimization/61673 + * combine.c (simplify_comparison): Test just mode's sign bit + in tmode rather than the sign bit and any bits above it. + +2014-07-08 James Greenhalgh <james.greenhalgh@arm.com> + + Backport r212298 from trunk. + 2014-07-04 James Greenhalgh <james.greenhalgh@arm.com> + + * config/aarch64/aarch64-simd.md (move_lo_quad_internal_<mode>): New. + (move_lo_quad_internal_be_<mode>): Likewise. + (move_lo_quad_<mode>): Convert to define_expand. + (aarch64_simd_move_hi_quad_<mode>): Gate on BYTES_BIG_ENDIAN. + (aarch64_simd_move_hi_quad_be_<mode>): New. + (move_hi_quad_<mode>): Use appropriate insn for BYTES_BIG_ENDIAN. + (aarch64_combinez<mode>): Gate on BYTES_BIG_ENDIAN. + (aarch64_combinez_be<mode>): New. + (aarch64_combine<mode>): Convert to define_expand. + (aarch64_combine_internal<mode>): New. + (aarch64_simd_combine<mode>): Remove bogus RTL description. + +2014-07-08 Richard Biener <rguenther@suse.de> + + PR tree-optimization/61680 + * tree-vect-data-refs.c (vect_analyze_data_ref_dependence): + Handle properly all read-write dependences with group accesses. + + PR tree-optimization/61681 + * tree-ssa-structalias.c (find_what_var_points_to): Expand + NONLOCAL inside ESCAPED. + +2014-07-08 Alan Lawrence <alan.lawrence@arm.com> + + Backport r211502 from mainline. + 2014-06-10 Alan Lawrence <alan.lawrence@arm.com> + + PR target/59843 + * config/aarch64/aarch64-modes.def: Add V1DFmode. + * config/aarch64/aarch64.c (aarch64_vector_mode_supported_p): + Support V1DFmode. + +2014-07-08 Jakub Jelinek <jakub@redhat.com> + + PR tree-optimization/61725 + * tree-vrp.c (extract_range_basic): Don't assume vr0 is unsigned + range, use range_includes_zerop_p instead of integer_zerop on + vr0->min, only use log2 of max if min is not negative. + +2014-07-06 Gerald Pfeifer <gerald@pfeifer.com> + + * doc/install.texi (Specific, aarch64*-*-*): Fix markup. Reword a bit. + +2014-07-04 Jakub Jelinek <jakub@redhat.com> + + PR middle-end/61654 + * cgraphunit.c (expand_thunk): Call free_dominance_info. + + PR tree-optimization/61684 + * tree-ssa-ifcombine.c (recognize_single_bit_test): Make sure + rhs1 of conversion is a SSA_NAME before using SSA_NAME_DEF_STMT on it. + +2014-06-30 Jakub Jelinek <jakub@redhat.com> + + Backported from mainline + 2014-06-27 Jakub Jelinek <jakub@redhat.com> + + PR tree-optimization/57233 + PR tree-optimization/61299 + * tree-vect-generic.c (get_compute_type, count_type_subparts): New + functions. + (expand_vector_operations_1): Use them. If {L,R}ROTATE_EXPR + would be lowered to scalar shifts, check if corresponding + shifts and vector BIT_IOR_EXPR are supported and don't lower + or lower just to narrower vector type in that case. + * expmed.c (expand_shift_1): Fix up handling of vector + shifts and rotates. + + 2014-06-25 Jakub Jelinek <jakub@redhat.com> + + * langhooks-def.h (LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR): Define. + (LANG_HOOKS_DECLS): Add it. + * gimplify.c (gimplify_omp_for): Make sure OMP_CLAUSE_LINEAR_STEP + has correct type. + * tree.h (OMP_CLAUSE_LINEAR_ARRAY): Define. + * langhooks.h (struct lang_hooks_for_decls): Add + omp_clause_linear_ctor hook. + * omp-low.c (lower_rec_input_clauses): Set max_vf even if + OMP_CLAUSE_LINEAR_ARRAY is set. Don't fold_convert + OMP_CLAUSE_LINEAR_STEP. For OMP_CLAUSE_LINEAR_ARRAY in + combined simd loop use omp_clause_linear_ctor hook. + + 2014-06-24 Jakub Jelinek <jakub@redhat.com> + + * gimplify.c (gimplify_scan_omp_clauses) <case OMP_CLAUSE_MAP, + OMP_CLAUSE_TO, OMP_CLAUSE_FROM): Make sure OMP_CLAUSE_SIZE is + non-NULL. + <case OMP_CLAUSE_ALIGNED>: Gimplify OMP_CLAUSE_ALIGNED_ALIGNMENT. + (gimplify_adjust_omp_clauses_1): Make sure OMP_CLAUSE_SIZE is + non-NULL. + (gimplify_adjust_omp_clauses): Likewise. + * omp-low.c (lower_rec_simd_input_clauses, + lower_rec_input_clauses, expand_omp_simd): Handle non-constant + safelen the same as safelen(1). + * tree-nested.c (convert_nonlocal_omp_clauses, + convert_local_omp_clauses): Handle OMP_CLAUSE_ALIGNED. For + OMP_CLAUSE_{MAP,TO,FROM} if not decl use walk_tree. + (convert_nonlocal_reference_stmt, convert_local_reference_stmt): + Fixup handling of GIMPLE_OMP_TARGET. + (convert_tramp_reference_stmt, convert_gimple_call): Handle + GIMPLE_OMP_TARGET. + + 2014-06-18 Jakub Jelinek <jakub@redhat.com> + + * gimplify.c (omp_notice_variable): If n is non-NULL + and no flags change in ORT_TARGET region, don't jump to + do_outer. + (struct gimplify_adjust_omp_clauses_data): New type. + (gimplify_adjust_omp_clauses_1): Adjust for data being + a struct gimplify_adjust_omp_clauses_data pointer instead + of tree *. Pass pre_p as a new argument to + lang_hooks.decls.omp_finish_clause hook. + (gimplify_adjust_omp_clauses): Add pre_p argument, adjust + splay_tree_foreach to pass both list_p and pre_p. + (gimplify_omp_parallel, gimplify_omp_task, gimplify_omp_for, + gimplify_omp_workshare, gimplify_omp_target_update): Adjust + gimplify_adjust_omp_clauses callers. + * langhooks.c (lhd_omp_finish_clause): New function. + * langhooks-def.h (lhd_omp_finish_clause): New prototype. + (LANG_HOOKS_OMP_FINISH_CLAUSE): Define to lhd_omp_finish_clause. + * langhooks.h (struct lang_hooks_for_decls): Add a new + gimple_seq * argument to omp_finish_clause hook. + * omp-low.c (scan_sharing_clauses): Call scan_omp_op on + non-DECL_P OMP_CLAUSE_DECL if ctx->outer. + (scan_omp_parallel, lower_omp_for): When adding + _LOOPTEMP_ clause var, add it to outer ctx's decl_map + as identity. + * tree-core.h (OMP_CLAUSE_MAP_TO_PSET): New map kind. + * tree-nested.c (convert_nonlocal_omp_clauses, + convert_local_omp_clauses): Handle various OpenMP 4.0 clauses. + * tree-pretty-print.c (dump_omp_clause): Handle + OMP_CLAUSE_MAP_TO_PSET. + + 2014-06-10 Jakub Jelinek <jakub@redhat.com> + + PR fortran/60928 + * omp-low.c (lower_rec_input_clauses) <case OMP_CLAUSE_LASTPRIVATE>: + Set lastprivate_firstprivate even if omp_private_outer_ref + langhook returns true. + <case OMP_CLAUSE_REDUCTION>: When calling omp_clause_default_ctor + langhook, call unshare_expr on new_var and call + build_outer_var_ref to get the last argument. + + 2014-05-11 Jakub Jelinek <jakub@redhat.com> + + * tree.h (OMP_CLAUSE_LINEAR_STMT): Define. + * tree.c (omp_clause_num_ops): Increase OMP_CLAUSE_LINEAR + number of operands to 3. + (walk_tree_1): Walk all operands of OMP_CLAUSE_LINEAR. + * tree-nested.c (convert_nonlocal_omp_clauses, + convert_local_omp_clauses): Handle OMP_CLAUSE_DEPEND. + * gimplify.c (gimplify_scan_omp_clauses): Handle + OMP_CLAUSE_LINEAR_STMT. + * omp-low.c (lower_rec_input_clauses): Fix typo. + (maybe_add_implicit_barrier_cancel, lower_omp_1): Add + cast between Fortran boolean_type_node and C _Bool if + needed. + +2014-06-30 Jason Merrill <jason@redhat.com> + + PR c++/51253 + PR c++/61382 + * gimplify.c (gimplify_arg): Non-static. + * gimplify.h: Declare it. + +2014-06-30 Marcus Shawcroft <marcus.shawcroft@arm.com> + + Backport from Mainline + 2014-06-30 Marcus Shawcroft <marcus.shawcroft@arm.com> + + PR target/61633 + * config/aarch64/aarch64.md (*aarch64_ashr_sisd_or_int_<mode>3): + Add alternative; make early clobber. Adjust both split patterns + to use operand 0 as the working register. + +2014-06-30 Kyrylo Tkachov <kyrylo.tkachov@arm.com> + + * config/aarch64/iterators.md (VCOND): Handle SI and HI modes. + Update comments. + (VCONQ): Make comment more helpful. + (VCON): Delete. + * config/aarch64/aarch64-simd.md + (aarch64_sqdmulh_lane<mode>): + Use VCOND for operands 2. Update lane checking and flipping logic. + (aarch64_sqrdmulh_lane<mode>): Likewise. + (aarch64_sq<r>dmulh_lane<mode>_internal): Likewise. + (aarch64_sqdmull2<mode>): Remove VCON, use VQ_HSI mode iterator. + (aarch64_sqdml<SBINQOPS:as>l_lane<mode>_internal, VD_HSI): Change mode + attribute of operand 3 to VCOND. + (aarch64_sqdml<SBINQOPS:as>l_lane<mode>_internal, SD_HSI): Likewise. + (aarch64_sqdml<SBINQOPS:as>l2_lane<mode>_internal): Likewise. + (aarch64_sqdmull_lane<mode>_internal, VD_HSI): Likewise. + (aarch64_sqdmull_lane<mode>_internal, SD_HSI): Likewise. + (aarch64_sqdmull2_lane<mode>_internal): Likewise. + (aarch64_sqdml<SBINQOPS:as>l_laneq<mode>_internal, VD_HSI: New + define_insn. + (aarch64_sqdml<SBINQOPS:as>l_laneq<mode>_internal, SD_HSI): Likewise. + (aarch64_sqdml<SBINQOPS:as>l2_laneq<mode>_internal): Likewise. + (aarch64_sqdmull_laneq<mode>_internal, VD_HSI): Likewise. + (aarch64_sqdmull_laneq<mode>_internal, SD_HSI): Likewise. + (aarch64_sqdmull2_laneq<mode>_internal): Likewise. + (aarch64_sqdmlal_lane<mode>): Change mode attribute of penultimate + operand to VCOND. Update lane flipping and bounds checking logic. + (aarch64_sqdmlal2_lane<mode>): Likewise. + (aarch64_sqdmlsl_lane<mode>): Likewise. + (aarch64_sqdmull_lane<mode>): Likewise. + (aarch64_sqdmull2_lane<mode>): Likewise. + (aarch64_sqdmlal_laneq<mode>): + Replace VCON usage with VCONQ. + Emit aarch64_sqdmlal_laneq<mode>_internal insn. + (aarch64_sqdmlal2_laneq<mode>): Emit + aarch64_sqdmlal2_laneq<mode>_internal insn. + Replace VCON with VCONQ. + (aarch64_sqdmlsl2_lane<mode>): Replace VCON with VCONQ. + (aarch64_sqdmlsl2_laneq<mode>): Likewise. + (aarch64_sqdmull_laneq<mode>): Emit + aarch64_sqdmull_laneq<mode>_internal insn. + Replace VCON with VCONQ. + (aarch64_sqdmull2_laneq<mode>): Emit + aarch64_sqdmull2_laneq<mode>_internal insn. + (aarch64_sqdmlsl_laneq<mode>): Replace VCON usage with VCONQ. + * config/aarch64/arm_neon.h (vqdmlal_high_lane_s16): Change type + of 3rd argument to int16x4_t. + (vqdmlalh_lane_s16): Likewise. + (vqdmlslh_lane_s16): Likewise. + (vqdmull_high_lane_s16): Likewise. + (vqdmullh_lane_s16): Change type of 2nd argument to int16x4_t. + (vqdmlal_lane_s16): Don't create temporary int16x8_t value. + (vqdmlsl_lane_s16): Likewise. + (vqdmull_lane_s16): Don't create temporary int16x8_t value. + (vqdmlal_high_lane_s32): Change type 3rd argument to int32x2_t. + (vqdmlals_lane_s32): Likewise. + (vqdmlsls_lane_s32): Likewise. + (vqdmull_high_lane_s32): Change type 2nd argument to int32x2_t. + (vqdmulls_lane_s32): Likewise. + (vqdmlal_lane_s32): Don't create temporary int32x4_t value. + (vqdmlsl_lane_s32): Likewise. + (vqdmull_lane_s32): Don't create temporary int32x4_t value. + (vqdmulhh_lane_s16): Change type of second argument to int16x4_t. + (vqrdmulhh_lane_s16): Likewise. + (vqdmlsl_high_lane_s16): Likewise. + (vqdmulhs_lane_s32): Change type of second argument to int32x2_t. + (vqdmlsl_high_lane_s32): Likewise. + (vqrdmulhs_lane_s32): Likewise. + +2014-06-30 Thomas Preud'homme <thomas.preudhomme@arm.com> + + Backport from Mainline + 2014-06-20 Jakub Jelinek <jakub@redhat.com> + 2014-06-11 Thomas Preud'homme <thomas.preudhomme@arm.com> + + PR tree-optimization/61306 + * tree-ssa-math-opts.c (struct symbolic_number): Store type of + expression instead of its size. + (do_shift_rotate): Adapt to change in struct symbolic_number. Return + false to prevent optimization when the result is unpredictable due to + arithmetic right shift of signed type with highest byte is set. + (verify_symbolic_number_p): Adapt to change in struct symbolic_number. + (find_bswap_1): Likewise. Return NULL to prevent optimization when the + result is unpredictable due to sign extension. + (find_bswap): Adapt to change in struct symbolic_number. + +2014-06-27 Martin Jambor <mjambor@suse.cz> + + PR ipa/61160 + * cgraphclones.c (duplicate_thunk_for_node): Removed parameter + args_to_skip, use those from node instead. Copy args_to_skip and + combined_args_to_skip from node to the new thunk. + (redirect_edge_duplicating_thunks): Removed parameter args_to_skip. + (cgraph_create_virtual_clone): Moved computation of + combined_args_to_skip... + (cgraph_clone_node): ...here, simplify it to bitmap_ior.. + +2014-06-27 Uros Bizjak <ubizjak@gmail.com> + + Backport from mainline + 2014-06-26 Uros Bizjak <ubizjak@gmail.com> + + PR target/61586 + * config/alpha/alpha.c (alpha_handle_trap_shadows): Handle BARRIER RTX. + +2014-06-26 Bill Schmidt <wschmidt@linux.vnet.ibm.com> + + PR target/61542 + * config/rs6000/vsx.md (vsx_extract_v4sf): Fix bug with element + extraction other than index 3. + +2014-06-26 Marc Glisse <marc.glisse@inria.fr> + + PR target/61503 + * config/i386/i386.md (x86_64_shrd, x86_shrd, + ix86_rotr<dwi>3_doubleword): Replace ashiftrt with lshiftrt. + +2014-06-26 Martin Jambor <mjambor@suse.cz> + + Backport from mainline + * ipa-prop.c (ipa_impossible_devirt_target): No longer static, + renamed to ipa_impossible_devirt_target. Fix typo. + * ipa-prop.h (ipa_impossible_devirt_target): Declare. + * ipa-cp.c (ipa_get_indirect_edge_target_1): Use + ipa_impossible_devirt_target. + 2014-06-24 Jakub Jelinek <jakub@redhat.com> PR target/61570 @@ -184,7 +533,7 @@ 2014-06-12 Jeff Law <law@redhat.com> - PR tree-optimization/61009 + PR tree-optimization/61009 * tree-ssa-threadedge.c (thread_through_normal_block): Correct return value when we stop processing a block due to problematic PHIs. diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 42831acc9b1..0f31f03257c 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20140625 +20140710 diff --git a/gcc/c-family/ChangeLog b/gcc/c-family/ChangeLog index 1e406e448b4..1fa0dd088e1 100644 --- a/gcc/c-family/ChangeLog +++ b/gcc/c-family/ChangeLog @@ -1,3 +1,12 @@ +2014-06-30 Jakub Jelinek <jakub@redhat.com> + + Backported from mainline + 2014-06-10 Jakub Jelinek <jakub@redhat.com> + + PR fortran/60928 + * c-pragma.c (omp_pragmas_simd): Move PRAGMA_OMP_TASK... + (omp_pragmas): ... back here. + 2014-06-12 Jakub Jelinek <jakub@redhat.com> PR middle-end/61486 diff --git a/gcc/c-family/c-pragma.c b/gcc/c-family/c-pragma.c index 9e2a00eb16e..ad115e998e4 100644 --- a/gcc/c-family/c-pragma.c +++ b/gcc/c-family/c-pragma.c @@ -1188,6 +1188,7 @@ static const struct omp_pragma_def omp_pragmas[] = { { "section", PRAGMA_OMP_SECTION }, { "sections", PRAGMA_OMP_SECTIONS }, { "single", PRAGMA_OMP_SINGLE }, + { "task", PRAGMA_OMP_TASK }, { "taskgroup", PRAGMA_OMP_TASKGROUP }, { "taskwait", PRAGMA_OMP_TASKWAIT }, { "taskyield", PRAGMA_OMP_TASKYIELD }, @@ -1200,7 +1201,6 @@ static const struct omp_pragma_def omp_pragmas_simd[] = { { "parallel", PRAGMA_OMP_PARALLEL }, { "simd", PRAGMA_OMP_SIMD }, { "target", PRAGMA_OMP_TARGET }, - { "task", PRAGMA_OMP_TASK }, { "teams", PRAGMA_OMP_TEAMS }, }; diff --git a/gcc/c/ChangeLog b/gcc/c/ChangeLog index acfb3704cd0..e31d4a8a36c 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,27 @@ +2014-06-30 Jakub Jelinek <jakub@redhat.com> + + Backported from mainline + 2014-06-25 Jakub Jelinek <jakub@redhat.com> + + * c-typeck.c (c_finish_omp_clauses): Make sure + OMP_CLAUSE_LINEAR_STEP has correct type. + +2014-06-30 Sebastian Huber <sebastian.huber@embedded-brains.de> + + * c-parser.c (c_parser_declaration_or_fndef): Discard all type + qualifiers in __auto_type for atomic types. + (c_parser_typeof_specifier): Discard all type qualifiers in + __typeof__ for atomic types. + +2014-06-30 Igor Zamyatin <igor.zamyatin@intel.com> + + PR middle-end/57541 + * c-array-notation.c (fix_builtin_array_notation_fn): + Check for 0 arguments in builtin call. Check that bultin argument is + correct. + * c-parser.c (c_parser_array_notation): Check for incorrect initial + index. + 2014-06-24 Jakub Jelinek <jakub@redhat.com> * c-parser.c (c_parser_omp_for_loop): For diff --git a/gcc/c/c-array-notation.c b/gcc/c/c-array-notation.c index f8cebbaa3c8..2305e1e0304 100644 --- a/gcc/c/c-array-notation.c +++ b/gcc/c/c-array-notation.c @@ -214,6 +214,13 @@ fix_builtin_array_notation_fn (tree an_builtin_fn, tree *new_var) if (an_type == BUILT_IN_NONE) return NULL_TREE; + /* Builtin call should contain at least one argument. */ + if (call_expr_nargs (an_builtin_fn) == 0) + { + error_at (EXPR_LOCATION (an_builtin_fn), "Invalid builtin arguments"); + return error_mark_node; + } + if (an_type == BUILT_IN_CILKPLUS_SEC_REDUCE || an_type == BUILT_IN_CILKPLUS_SEC_REDUCE_MUTATING) { @@ -238,7 +245,10 @@ fix_builtin_array_notation_fn (tree an_builtin_fn, tree *new_var) return error_mark_node; if (rank == 0) - return an_builtin_fn; + { + error_at (location, "Invalid builtin arguments"); + return error_mark_node; + } else if (rank > 1 && (an_type == BUILT_IN_CILKPLUS_SEC_REDUCE_MAX_IND || an_type == BUILT_IN_CILKPLUS_SEC_REDUCE_MIN_IND)) diff --git a/gcc/c/c-parser.c b/gcc/c/c-parser.c index 99ff5466dbb..a51af2e305d 100644 --- a/gcc/c/c-parser.c +++ b/gcc/c/c-parser.c @@ -1707,14 +1707,10 @@ c_parser_declaration_or_fndef (c_parser *parser, bool fndef_ok, " initializer"); init = convert_lvalue_to_rvalue (init_loc, init, true, true); tree init_type = TREE_TYPE (init.value); - /* As with typeof, remove _Atomic and const - qualifiers from atomic types. */ + /* As with typeof, remove all qualifiers from atomic types. */ if (init_type != error_mark_node && TYPE_ATOMIC (init_type)) init_type - = c_build_qualified_type (init_type, - (TYPE_QUALS (init_type) - & ~(TYPE_QUAL_ATOMIC - | TYPE_QUAL_CONST))); + = c_build_qualified_type (init_type, TYPE_UNQUALIFIED); bool vm_type = variably_modified_type_p (init_type, NULL_TREE); if (vm_type) @@ -3011,16 +3007,11 @@ c_parser_typeof_specifier (c_parser *parser) if (was_vm) ret.expr = c_fully_fold (expr.value, false, &ret.expr_const_operands); pop_maybe_used (was_vm); - /* For use in macros such as those in <stdatomic.h>, remove - _Atomic and const qualifiers from atomic types. (Possibly - all qualifiers should be removed; const can be an issue for - more macros using typeof than just the <stdatomic.h> - ones.) */ + /* For use in macros such as those in <stdatomic.h>, remove all + qualifiers from atomic types. (const can be an issue for more macros + using typeof than just the <stdatomic.h> ones.) */ if (ret.spec != error_mark_node && TYPE_ATOMIC (ret.spec)) - ret.spec = c_build_qualified_type (ret.spec, - (TYPE_QUALS (ret.spec) - & ~(TYPE_QUAL_ATOMIC - | TYPE_QUAL_CONST))); + ret.spec = c_build_qualified_type (ret.spec, TYPE_UNQUALIFIED); } c_parser_skip_until_found (parser, CPP_CLOSE_PAREN, "expected %<)%>"); return ret; @@ -14073,7 +14064,7 @@ c_parser_array_notation (location_t loc, c_parser *parser, tree initial_index, tree value_tree = NULL_TREE, type = NULL_TREE, array_type = NULL_TREE; tree array_type_domain = NULL_TREE; - if (array_value == error_mark_node) + if (array_value == error_mark_node || initial_index == error_mark_node) { /* No need to continue. If either of these 2 were true, then an error must be emitted already. Thus, no need to emit them twice. */ diff --git a/gcc/c/c-typeck.c b/gcc/c/c-typeck.c index 65aad45651c..5838d6a7215 100644 --- a/gcc/c/c-typeck.c +++ b/gcc/c/c-typeck.c @@ -11925,6 +11925,9 @@ c_finish_omp_clauses (tree clauses) s = size_one_node; OMP_CLAUSE_LINEAR_STEP (c) = s; } + else + OMP_CLAUSE_LINEAR_STEP (c) + = fold_convert (TREE_TYPE (t), OMP_CLAUSE_LINEAR_STEP (c)); goto check_dup_generic; check_dup_generic: diff --git a/gcc/cgraphclones.c b/gcc/cgraphclones.c index 257939cb022..972ca0708c4 100644 --- a/gcc/cgraphclones.c +++ b/gcc/cgraphclones.c @@ -302,14 +302,13 @@ set_new_clone_decl_and_node_flags (cgraph_node *new_node) thunk is this_adjusting but we are removing this parameter. */ static cgraph_node * -duplicate_thunk_for_node (cgraph_node *thunk, cgraph_node *node, - bitmap args_to_skip) +duplicate_thunk_for_node (cgraph_node *thunk, cgraph_node *node) { cgraph_node *new_thunk, *thunk_of; thunk_of = cgraph_function_or_thunk_node (thunk->callees->callee); if (thunk_of->thunk.thunk_p) - node = duplicate_thunk_for_node (thunk_of, node, args_to_skip); + node = duplicate_thunk_for_node (thunk_of, node); struct cgraph_edge *cs; for (cs = node->callers; cs; cs = cs->next_caller) @@ -321,17 +320,18 @@ duplicate_thunk_for_node (cgraph_node *thunk, cgraph_node *node, return cs->caller; tree new_decl; - if (!args_to_skip) + if (!node->clone.args_to_skip) new_decl = copy_node (thunk->decl); else { /* We do not need to duplicate this_adjusting thunks if we have removed this. */ if (thunk->thunk.this_adjusting - && bitmap_bit_p (args_to_skip, 0)) + && bitmap_bit_p (node->clone.args_to_skip, 0)) return node; - new_decl = build_function_decl_skip_args (thunk->decl, args_to_skip, + new_decl = build_function_decl_skip_args (thunk->decl, + node->clone.args_to_skip, false); } gcc_checking_assert (!DECL_STRUCT_FUNCTION (new_decl)); @@ -349,6 +349,8 @@ duplicate_thunk_for_node (cgraph_node *thunk, cgraph_node *node, new_thunk->thunk = thunk->thunk; new_thunk->unique_name = in_lto_p; new_thunk->former_clone_of = thunk->decl; + new_thunk->clone.args_to_skip = node->clone.args_to_skip; + new_thunk->clone.combined_args_to_skip = node->clone.combined_args_to_skip; struct cgraph_edge *e = cgraph_create_edge (new_thunk, node, NULL, 0, CGRAPH_FREQ_BASE); @@ -365,12 +367,11 @@ duplicate_thunk_for_node (cgraph_node *thunk, cgraph_node *node, chain. */ void -redirect_edge_duplicating_thunks (struct cgraph_edge *e, struct cgraph_node *n, - bitmap args_to_skip) +redirect_edge_duplicating_thunks (struct cgraph_edge *e, struct cgraph_node *n) { cgraph_node *orig_to = cgraph_function_or_thunk_node (e->callee); if (orig_to->thunk.thunk_p) - n = duplicate_thunk_for_node (orig_to, n, args_to_skip); + n = duplicate_thunk_for_node (orig_to, n); cgraph_redirect_edge_callee (e, n); } @@ -423,9 +424,21 @@ cgraph_clone_node (struct cgraph_node *n, tree decl, gcov_type count, int freq, new_node->rtl = n->rtl; new_node->count = count; new_node->frequency = n->frequency; - new_node->clone = n->clone; - new_node->clone.tree_map = NULL; new_node->tp_first_run = n->tp_first_run; + + new_node->clone.tree_map = NULL; + new_node->clone.args_to_skip = args_to_skip; + if (!args_to_skip) + new_node->clone.combined_args_to_skip = n->clone.combined_args_to_skip; + else if (n->clone.combined_args_to_skip) + { + new_node->clone.combined_args_to_skip = BITMAP_GGC_ALLOC (); + bitmap_ior (new_node->clone.combined_args_to_skip, + n->clone.combined_args_to_skip, args_to_skip); + } + else + new_node->clone.combined_args_to_skip = args_to_skip; + if (n->count) { if (new_node->count > n->count) @@ -450,10 +463,9 @@ cgraph_clone_node (struct cgraph_node *n, tree decl, gcov_type count, int freq, if (!e->callee || DECL_BUILT_IN_CLASS (e->callee->decl) != BUILT_IN_NORMAL || DECL_FUNCTION_CODE (e->callee->decl) != BUILT_IN_UNREACHABLE) - redirect_edge_duplicating_thunks (e, new_node, args_to_skip); + redirect_edge_duplicating_thunks (e, new_node); } - for (e = n->callees;e; e=e->next_callee) cgraph_clone_edge (e, new_node, e->call_stmt, e->lto_stmt_uid, count_scale, freq, update_original); @@ -562,7 +574,6 @@ cgraph_create_virtual_clone (struct cgraph_node *old_node, DECL_SECTION_NAME (new_node->decl) = NULL; set_new_clone_decl_and_node_flags (new_node); new_node->clone.tree_map = tree_map; - new_node->clone.args_to_skip = args_to_skip; /* Clones of global symbols or symbols with unique names are unique. */ if ((TREE_PUBLIC (old_decl) @@ -574,32 +585,6 @@ cgraph_create_virtual_clone (struct cgraph_node *old_node, FOR_EACH_VEC_SAFE_ELT (tree_map, i, map) ipa_maybe_record_reference (new_node, map->new_tree, IPA_REF_ADDR, NULL); - if (!args_to_skip) - new_node->clone.combined_args_to_skip = old_node->clone.combined_args_to_skip; - else if (old_node->clone.combined_args_to_skip) - { - int newi = 0, oldi = 0; - tree arg; - bitmap new_args_to_skip = BITMAP_GGC_ALLOC (); - struct cgraph_node *orig_node; - for (orig_node = old_node; orig_node->clone_of; orig_node = orig_node->clone_of) - ; - for (arg = DECL_ARGUMENTS (orig_node->decl); - arg; arg = DECL_CHAIN (arg), oldi++) - { - if (bitmap_bit_p (old_node->clone.combined_args_to_skip, oldi)) - { - bitmap_set_bit (new_args_to_skip, oldi); - continue; - } - if (bitmap_bit_p (args_to_skip, newi)) - bitmap_set_bit (new_args_to_skip, oldi); - newi++; - } - new_node->clone.combined_args_to_skip = new_args_to_skip; - } - else - new_node->clone.combined_args_to_skip = args_to_skip; cgraph_call_node_duplication_hooks (old_node, new_node); diff --git a/gcc/cgraphunit.c b/gcc/cgraphunit.c index 06283fc3f64..04ef6faec44 100644 --- a/gcc/cgraphunit.c +++ b/gcc/cgraphunit.c @@ -1680,6 +1680,7 @@ expand_thunk (struct cgraph_node *node, bool output_asm_thunks) #ifdef ENABLE_CHECKING verify_flow_info (); #endif + free_dominance_info (CDI_DOMINATORS); /* Since we want to emit the thunk, we explicitly mark its name as referenced. */ diff --git a/gcc/combine.c b/gcc/combine.c index f7a279e86d5..7c00452056c 100644 --- a/gcc/combine.c +++ b/gcc/combine.c @@ -11987,7 +11987,7 @@ simplify_comparison (enum rtx_code code, rtx *pop0, rtx *pop1) = (unsigned HOST_WIDE_INT) 1 << (GET_MODE_BITSIZE (mode) - 1); op0 = simplify_gen_binary (AND, tmode, gen_lowpart (tmode, op0), - gen_int_mode (sign, mode)); + gen_int_mode (sign, tmode)); code = (code == LT) ? NE : EQ; break; } diff --git a/gcc/config/aarch64/aarch64-modes.def b/gcc/config/aarch64/aarch64-modes.def index 1d2cc767946..f9c436948a6 100644 --- a/gcc/config/aarch64/aarch64-modes.def +++ b/gcc/config/aarch64/aarch64-modes.def @@ -31,6 +31,7 @@ VECTOR_MODES (INT, 8); /* V8QI V4HI V2SI. */ VECTOR_MODES (INT, 16); /* V16QI V8HI V4SI V2DI. */ VECTOR_MODES (FLOAT, 8); /* V2SF. */ VECTOR_MODES (FLOAT, 16); /* V4SF V2DF. */ +VECTOR_MODE (FLOAT, DF, 1); /* V1DF. */ /* Oct Int: 256-bit integer mode needed for 32-byte vector arguments. */ INT_MODE (OI, 32); diff --git a/gcc/config/aarch64/aarch64-simd.md b/gcc/config/aarch64/aarch64-simd.md index 825c748b5b0..dde2311dc08 100644 --- a/gcc/config/aarch64/aarch64-simd.md +++ b/gcc/config/aarch64/aarch64-simd.md @@ -942,14 +942,22 @@ [(set_attr "type" "neon_minmax<q>")] ) -;; Move into low-half clearing high half to 0. +;; vec_concat gives a new vector with the low elements from operand 1, and +;; the high elements from operand 2. That is to say, given op1 = { a, b } +;; op2 = { c, d }, vec_concat (op1, op2) = { a, b, c, d }. +;; What that means, is that the RTL descriptions of the below patterns +;; need to change depending on endianness. -(define_insn "move_lo_quad_<mode>" +;; Move to the low architectural bits of the register. +;; On little-endian this is { operand, zeroes } +;; On big-endian this is { zeroes, operand } + +(define_insn "move_lo_quad_internal_<mode>" [(set (match_operand:VQ 0 "register_operand" "=w,w,w") (vec_concat:VQ (match_operand:<VHALF> 1 "register_operand" "w,r,r") (vec_duplicate:<VHALF> (const_int 0))))] - "TARGET_SIMD" + "TARGET_SIMD && !BYTES_BIG_ENDIAN" "@ dup\\t%d0, %1.d[0] fmov\\t%d0, %1 @@ -960,7 +968,39 @@ (set_attr "length" "4")] ) -;; Move into high-half. +(define_insn "move_lo_quad_internal_be_<mode>" + [(set (match_operand:VQ 0 "register_operand" "=w,w,w") + (vec_concat:VQ + (vec_duplicate:<VHALF> (const_int 0)) + (match_operand:<VHALF> 1 "register_operand" "w,r,r")))] + "TARGET_SIMD && BYTES_BIG_ENDIAN" + "@ + dup\\t%d0, %1.d[0] + fmov\\t%d0, %1 + dup\\t%d0, %1" + [(set_attr "type" "neon_dup<q>,f_mcr,neon_dup<q>") + (set_attr "simd" "yes,*,yes") + (set_attr "fp" "*,yes,*") + (set_attr "length" "4")] +) + +(define_expand "move_lo_quad_<mode>" + [(match_operand:VQ 0 "register_operand") + (match_operand:VQ 1 "register_operand")] + "TARGET_SIMD" +{ + if (BYTES_BIG_ENDIAN) + emit_insn (gen_move_lo_quad_internal_be_<mode> (operands[0], operands[1])); + else + emit_insn (gen_move_lo_quad_internal_<mode> (operands[0], operands[1])); + DONE; +} +) + +;; Move operand1 to the high architectural bits of the register, keeping +;; the low architectural bits of operand2. +;; For little-endian this is { operand2, operand1 } +;; For big-endian this is { operand1, operand2 } (define_insn "aarch64_simd_move_hi_quad_<mode>" [(set (match_operand:VQ 0 "register_operand" "+w,w") @@ -969,12 +1009,25 @@ (match_dup 0) (match_operand:VQ 2 "vect_par_cnst_lo_half" "")) (match_operand:<VHALF> 1 "register_operand" "w,r")))] - "TARGET_SIMD" + "TARGET_SIMD && !BYTES_BIG_ENDIAN" "@ ins\\t%0.d[1], %1.d[0] ins\\t%0.d[1], %1" - [(set_attr "type" "neon_ins") - (set_attr "length" "4")] + [(set_attr "type" "neon_ins")] +) + +(define_insn "aarch64_simd_move_hi_quad_be_<mode>" + [(set (match_operand:VQ 0 "register_operand" "+w,w") + (vec_concat:VQ + (match_operand:<VHALF> 1 "register_operand" "w,r") + (vec_select:<VHALF> + (match_dup 0) + (match_operand:VQ 2 "vect_par_cnst_hi_half" ""))))] + "TARGET_SIMD && BYTES_BIG_ENDIAN" + "@ + ins\\t%0.d[1], %1.d[0] + ins\\t%0.d[1], %1" + [(set_attr "type" "neon_ins")] ) (define_expand "move_hi_quad_<mode>" @@ -982,9 +1035,13 @@ (match_operand:<VHALF> 1 "register_operand" "")] "TARGET_SIMD" { - rtx p = aarch64_simd_vect_par_cnst_half (<MODE>mode, false); - emit_insn (gen_aarch64_simd_move_hi_quad_<mode> (operands[0], - operands[1], p)); + rtx p = aarch64_simd_vect_par_cnst_half (<MODE>mode, BYTES_BIG_ENDIAN); + if (BYTES_BIG_ENDIAN) + emit_insn (gen_aarch64_simd_move_hi_quad_be_<mode> (operands[0], + operands[1], p)); + else + emit_insn (gen_aarch64_simd_move_hi_quad_<mode> (operands[0], + operands[1], p)); DONE; }) @@ -2338,12 +2395,44 @@ (vec_concat:<VDBL> (match_operand:VDIC 1 "register_operand" "w") (match_operand:VDIC 2 "aarch64_simd_imm_zero" "Dz")))] - "TARGET_SIMD" + "TARGET_SIMD && !BYTES_BIG_ENDIAN" "mov\\t%0.8b, %1.8b" [(set_attr "type" "neon_move<q>")] ) -(define_insn_and_split "aarch64_combine<mode>" +(define_insn "*aarch64_combinez_be<mode>" + [(set (match_operand:<VDBL> 0 "register_operand" "=&w") + (vec_concat:<VDBL> + (match_operand:VDIC 2 "aarch64_simd_imm_zero" "Dz") + (match_operand:VDIC 1 "register_operand" "w")))] + "TARGET_SIMD && BYTES_BIG_ENDIAN" + "mov\\t%0.8b, %1.8b" + [(set_attr "type" "neon_move<q>")] +) + +(define_expand "aarch64_combine<mode>" + [(match_operand:<VDBL> 0 "register_operand") + (match_operand:VDC 1 "register_operand") + (match_operand:VDC 2 "register_operand")] + "TARGET_SIMD" +{ + rtx op1, op2; + if (BYTES_BIG_ENDIAN) + { + op1 = operands[2]; + op2 = operands[1]; + } + else + { + op1 = operands[1]; + op2 = operands[2]; + } + emit_insn (gen_aarch64_combine_internal<mode> (operands[0], op1, op2)); + DONE; +} +) + +(define_insn_and_split "aarch64_combine_internal<mode>" [(set (match_operand:<VDBL> 0 "register_operand" "=&w") (vec_concat:<VDBL> (match_operand:VDC 1 "register_operand" "w") (match_operand:VDC 2 "register_operand" "w")))] @@ -2352,16 +2441,19 @@ "&& reload_completed" [(const_int 0)] { - aarch64_split_simd_combine (operands[0], operands[1], operands[2]); + if (BYTES_BIG_ENDIAN) + aarch64_split_simd_combine (operands[0], operands[2], operands[1]); + else + aarch64_split_simd_combine (operands[0], operands[1], operands[2]); DONE; } [(set_attr "type" "multiple")] ) (define_expand "aarch64_simd_combine<mode>" - [(set (match_operand:<VDBL> 0 "register_operand" "=&w") - (vec_concat:<VDBL> (match_operand:VDC 1 "register_operand" "w") - (match_operand:VDC 2 "register_operand" "w")))] + [(match_operand:<VDBL> 0 "register_operand") + (match_operand:VDC 1 "register_operand") + (match_operand:VDC 2 "register_operand")] "TARGET_SIMD" { emit_insn (gen_move_lo_quad_<Vdbl> (operands[0], operands[1])); @@ -2752,12 +2844,12 @@ (define_expand "aarch64_sqdmulh_lane<mode>" [(match_operand:SD_HSI 0 "register_operand" "") (match_operand:SD_HSI 1 "register_operand" "") - (match_operand:<VCONQ> 2 "register_operand" "") + (match_operand:<VCOND> 2 "register_operand" "") (match_operand:SI 3 "immediate_operand" "")] "TARGET_SIMD" { - aarch64_simd_lane_bounds (operands[3], 0, GET_MODE_NUNITS (<VCONQ>mode)); - operands[3] = GEN_INT (ENDIAN_LANE_N (<VCONQ>mode, INTVAL (operands[3]))); + aarch64_simd_lane_bounds (operands[3], 0, GET_MODE_NUNITS (<VCOND>mode)); + operands[3] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[3]))); emit_insn (gen_aarch64_sqdmulh_lane<mode>_internal (operands[0], operands[1], operands[2], @@ -2769,12 +2861,12 @@ (define_expand "aarch64_sqrdmulh_lane<mode>" [(match_operand:SD_HSI 0 "register_operand" "") (match_operand:SD_HSI 1 "register_operand" "") - (match_operand:<VCONQ> 2 "register_operand" "") + (match_operand:<VCOND> 2 "register_operand" "") (match_operand:SI 3 "immediate_operand" "")] "TARGET_SIMD" { - aarch64_simd_lane_bounds (operands[3], 0, GET_MODE_NUNITS (<VCONQ>mode)); - operands[3] = GEN_INT (ENDIAN_LANE_N (<VCONQ>mode, INTVAL (operands[3]))); + aarch64_simd_lane_bounds (operands[3], 0, GET_MODE_NUNITS (<VCOND>mode)); + operands[3] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[3]))); emit_insn (gen_aarch64_sqrdmulh_lane<mode>_internal (operands[0], operands[1], operands[2], @@ -2788,12 +2880,12 @@ (unspec:SD_HSI [(match_operand:SD_HSI 1 "register_operand" "w") (vec_select:<VEL> - (match_operand:<VCONQ> 2 "register_operand" "<vwx>") + (match_operand:<VCOND> 2 "register_operand" "<vwx>") (parallel [(match_operand:SI 3 "immediate_operand" "i")]))] VQDMULH))] "TARGET_SIMD" "* - operands[3] = GEN_INT (ENDIAN_LANE_N (<VCONQ>mode, INTVAL (operands[3]))); + operands[3] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[3]))); return \"sq<r>dmulh\\t%<v>0, %<v>1, %2.<v>[%3]\";" [(set_attr "type" "neon_sat_mul_<Vetype>_scalar<q>")] ) @@ -2829,7 +2921,31 @@ (sign_extend:<VWIDE> (vec_duplicate:VD_HSI (vec_select:<VEL> - (match_operand:<VCON> 3 "register_operand" "<vwx>") + (match_operand:<VCOND> 3 "register_operand" "<vwx>") + (parallel [(match_operand:SI 4 "immediate_operand" "i")]))) + )) + (const_int 1))))] + "TARGET_SIMD" + { + operands[4] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[4]))); + return + "sqdml<SBINQOPS:as>l\\t%<vw2>0<Vmwtype>, %<v>2<Vmtype>, %3.<Vetype>[%4]"; + } + [(set_attr "type" "neon_sat_mla_<Vetype>_scalar_long")] +) + +(define_insn "aarch64_sqdml<SBINQOPS:as>l_laneq<mode>_internal" + [(set (match_operand:<VWIDE> 0 "register_operand" "=w") + (SBINQOPS:<VWIDE> + (match_operand:<VWIDE> 1 "register_operand" "0") + (ss_ashift:<VWIDE> + (mult:<VWIDE> + (sign_extend:<VWIDE> + (match_operand:VD_HSI 2 "register_operand" "w")) + (sign_extend:<VWIDE> + (vec_duplicate:VD_HSI + (vec_select:<VEL> + (match_operand:<VCONQ> 3 "register_operand" "<vwx>") (parallel [(match_operand:SI 4 "immediate_operand" "i")]))) )) (const_int 1))))] @@ -2852,7 +2968,30 @@ (match_operand:SD_HSI 2 "register_operand" "w")) (sign_extend:<VWIDE> (vec_select:<VEL> - (match_operand:<VCON> 3 "register_operand" "<vwx>") + (match_operand:<VCOND> 3 "register_operand" "<vwx>") + (parallel [(match_operand:SI 4 "immediate_operand" "i")]))) + ) + (const_int 1))))] + "TARGET_SIMD" + { + operands[4] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[4]))); + return + "sqdml<SBINQOPS:as>l\\t%<vw2>0<Vmwtype>, %<v>2<Vmtype>, %3.<Vetype>[%4]"; + } + [(set_attr "type" "neon_sat_mla_<Vetype>_scalar_long")] +) + +(define_insn "aarch64_sqdml<SBINQOPS:as>l_laneq<mode>_internal" + [(set (match_operand:<VWIDE> 0 "register_operand" "=w") + (SBINQOPS:<VWIDE> + (match_operand:<VWIDE> 1 "register_operand" "0") + (ss_ashift:<VWIDE> + (mult:<VWIDE> + (sign_extend:<VWIDE> + (match_operand:SD_HSI 2 "register_operand" "w")) + (sign_extend:<VWIDE> + (vec_select:<VEL> + (match_operand:<VCONQ> 3 "register_operand" "<vwx>") (parallel [(match_operand:SI 4 "immediate_operand" "i")]))) ) (const_int 1))))] @@ -2869,12 +3008,12 @@ [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:<VWIDE> 1 "register_operand" "0") (match_operand:VSD_HSI 2 "register_operand" "w") - (match_operand:<VCON> 3 "register_operand" "<vwx>") + (match_operand:<VCOND> 3 "register_operand" "<vwx>") (match_operand:SI 4 "immediate_operand" "i")] "TARGET_SIMD" { - aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<VCON>mode) / 2); - operands[4] = GEN_INT (ENDIAN_LANE_N (<VCONQ>mode, INTVAL (operands[4]))); + aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<VCOND>mode)); + operands[4] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[4]))); emit_insn (gen_aarch64_sqdmlal_lane<mode>_internal (operands[0], operands[1], operands[2], operands[3], operands[4])); @@ -2885,13 +3024,13 @@ [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:<VWIDE> 1 "register_operand" "0") (match_operand:VSD_HSI 2 "register_operand" "w") - (match_operand:<VCON> 3 "register_operand" "<vwx>") + (match_operand:<VCONQ> 3 "register_operand" "<vwx>") (match_operand:SI 4 "immediate_operand" "i")] "TARGET_SIMD" { - aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<VCON>mode)); - operands[4] = GEN_INT (ENDIAN_LANE_N (<VCON>mode, INTVAL (operands[4]))); - emit_insn (gen_aarch64_sqdmlal_lane<mode>_internal (operands[0], operands[1], + aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<VCONQ>mode)); + operands[4] = GEN_INT (ENDIAN_LANE_N (<VCONQ>mode, INTVAL (operands[4]))); + emit_insn (gen_aarch64_sqdmlal_laneq<mode>_internal (operands[0], operands[1], operands[2], operands[3], operands[4])); DONE; @@ -2901,12 +3040,12 @@ [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:<VWIDE> 1 "register_operand" "0") (match_operand:VSD_HSI 2 "register_operand" "w") - (match_operand:<VCON> 3 "register_operand" "<vwx>") + (match_operand:<VCOND> 3 "register_operand" "<vwx>") (match_operand:SI 4 "immediate_operand" "i")] "TARGET_SIMD" { - aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<VCON>mode) / 2); - operands[4] = GEN_INT (ENDIAN_LANE_N (<VCON>mode, INTVAL (operands[4]))); + aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<VCOND>mode)); + operands[4] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[4]))); emit_insn (gen_aarch64_sqdmlsl_lane<mode>_internal (operands[0], operands[1], operands[2], operands[3], operands[4])); @@ -2917,13 +3056,13 @@ [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:<VWIDE> 1 "register_operand" "0") (match_operand:VSD_HSI 2 "register_operand" "w") - (match_operand:<VCON> 3 "register_operand" "<vwx>") + (match_operand:<VCONQ> 3 "register_operand" "<vwx>") (match_operand:SI 4 "immediate_operand" "i")] "TARGET_SIMD" { - aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<VCON>mode)); - operands[4] = GEN_INT (ENDIAN_LANE_N (<VCON>mode, INTVAL (operands[4]))); - emit_insn (gen_aarch64_sqdmlsl_lane<mode>_internal (operands[0], operands[1], + aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<VCONQ>mode)); + operands[4] = GEN_INT (ENDIAN_LANE_N (<VCONQ>mode, INTVAL (operands[4]))); + emit_insn (gen_aarch64_sqdmlsl_laneq<mode>_internal (operands[0], operands[1], operands[2], operands[3], operands[4])); DONE; @@ -3011,7 +3150,33 @@ (sign_extend:<VWIDE> (vec_duplicate:<VHALF> (vec_select:<VEL> - (match_operand:<VCON> 3 "register_operand" "<vwx>") + (match_operand:<VCOND> 3 "register_operand" "<vwx>") + (parallel [(match_operand:SI 4 "immediate_operand" "i")]) + )))) + (const_int 1))))] + "TARGET_SIMD" + { + operands[4] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[4]))); + return + "sqdml<SBINQOPS:as>l2\\t%<vw2>0<Vmwtype>, %<v>2<Vmtype>, %3.<Vetype>[%4]"; + } + [(set_attr "type" "neon_sat_mla_<Vetype>_scalar_long")] +) + +(define_insn "aarch64_sqdml<SBINQOPS:as>l2_laneq<mode>_internal" + [(set (match_operand:<VWIDE> 0 "register_operand" "=w") + (SBINQOPS:<VWIDE> + (match_operand:<VWIDE> 1 "register_operand" "0") + (ss_ashift:<VWIDE> + (mult:<VWIDE> + (sign_extend:<VWIDE> + (vec_select:<VHALF> + (match_operand:VQ_HSI 2 "register_operand" "w") + (match_operand:VQ_HSI 5 "vect_par_cnst_hi_half" ""))) + (sign_extend:<VWIDE> + (vec_duplicate:<VHALF> + (vec_select:<VEL> + (match_operand:<VCONQ> 3 "register_operand" "<vwx>") (parallel [(match_operand:SI 4 "immediate_operand" "i")]) )))) (const_int 1))))] @@ -3028,13 +3193,13 @@ [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:<VWIDE> 1 "register_operand" "w") (match_operand:VQ_HSI 2 "register_operand" "w") - (match_operand:<VCON> 3 "register_operand" "<vwx>") + (match_operand:<VCOND> 3 "register_operand" "<vwx>") (match_operand:SI 4 "immediate_operand" "i")] "TARGET_SIMD" { rtx p = aarch64_simd_vect_par_cnst_half (<MODE>mode, true); - aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<MODE>mode) / 2); - operands[4] = GEN_INT (ENDIAN_LANE_N (<MODE>mode, INTVAL (operands[4]))); + aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<VCOND>mode)); + operands[4] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[4]))); emit_insn (gen_aarch64_sqdmlal2_lane<mode>_internal (operands[0], operands[1], operands[2], operands[3], operands[4], p)); @@ -3045,14 +3210,14 @@ [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:<VWIDE> 1 "register_operand" "w") (match_operand:VQ_HSI 2 "register_operand" "w") - (match_operand:<VCON> 3 "register_operand" "<vwx>") + (match_operand:<VCONQ> 3 "register_operand" "<vwx>") (match_operand:SI 4 "immediate_operand" "i")] "TARGET_SIMD" { rtx p = aarch64_simd_vect_par_cnst_half (<MODE>mode, true); - aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<MODE>mode)); - operands[4] = GEN_INT (ENDIAN_LANE_N (<MODE>mode, INTVAL (operands[4]))); - emit_insn (gen_aarch64_sqdmlal2_lane<mode>_internal (operands[0], operands[1], + aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<VCONQ>mode)); + operands[4] = GEN_INT (ENDIAN_LANE_N (<VCONQ>mode, INTVAL (operands[4]))); + emit_insn (gen_aarch64_sqdmlal2_laneq<mode>_internal (operands[0], operands[1], operands[2], operands[3], operands[4], p)); DONE; @@ -3062,13 +3227,13 @@ [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:<VWIDE> 1 "register_operand" "w") (match_operand:VQ_HSI 2 "register_operand" "w") - (match_operand:<VCON> 3 "register_operand" "<vwx>") + (match_operand:<VCOND> 3 "register_operand" "<vwx>") (match_operand:SI 4 "immediate_operand" "i")] "TARGET_SIMD" { rtx p = aarch64_simd_vect_par_cnst_half (<MODE>mode, true); - aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<MODE>mode) / 2); - operands[4] = GEN_INT (ENDIAN_LANE_N (<MODE>mode, INTVAL (operands[4]))); + aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<VCOND>mode)); + operands[4] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[4]))); emit_insn (gen_aarch64_sqdmlsl2_lane<mode>_internal (operands[0], operands[1], operands[2], operands[3], operands[4], p)); @@ -3079,14 +3244,14 @@ [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:<VWIDE> 1 "register_operand" "w") (match_operand:VQ_HSI 2 "register_operand" "w") - (match_operand:<VCON> 3 "register_operand" "<vwx>") + (match_operand:<VCONQ> 3 "register_operand" "<vwx>") (match_operand:SI 4 "immediate_operand" "i")] "TARGET_SIMD" { rtx p = aarch64_simd_vect_par_cnst_half (<MODE>mode, true); - aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<MODE>mode)); - operands[4] = GEN_INT (ENDIAN_LANE_N (<MODE>mode, INTVAL (operands[4]))); - emit_insn (gen_aarch64_sqdmlsl2_lane<mode>_internal (operands[0], operands[1], + aarch64_simd_lane_bounds (operands[4], 0, GET_MODE_NUNITS (<VCONQ>mode)); + operands[4] = GEN_INT (ENDIAN_LANE_N (<VCONQ>mode, INTVAL (operands[4]))); + emit_insn (gen_aarch64_sqdmlsl2_laneq<mode>_internal (operands[0], operands[1], operands[2], operands[3], operands[4], p)); DONE; @@ -3166,7 +3331,28 @@ (sign_extend:<VWIDE> (vec_duplicate:VD_HSI (vec_select:<VEL> - (match_operand:<VCON> 2 "register_operand" "<vwx>") + (match_operand:<VCOND> 2 "register_operand" "<vwx>") + (parallel [(match_operand:SI 3 "immediate_operand" "i")]))) + )) + (const_int 1)))] + "TARGET_SIMD" + { + operands[3] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[3]))); + return "sqdmull\\t%<vw2>0<Vmwtype>, %<v>1<Vmtype>, %2.<Vetype>[%3]"; + } + [(set_attr "type" "neon_sat_mul_<Vetype>_scalar_long")] +) + +(define_insn "aarch64_sqdmull_laneq<mode>_internal" + [(set (match_operand:<VWIDE> 0 "register_operand" "=w") + (ss_ashift:<VWIDE> + (mult:<VWIDE> + (sign_extend:<VWIDE> + (match_operand:VD_HSI 1 "register_operand" "w")) + (sign_extend:<VWIDE> + (vec_duplicate:VD_HSI + (vec_select:<VEL> + (match_operand:<VCONQ> 2 "register_operand" "<vwx>") (parallel [(match_operand:SI 3 "immediate_operand" "i")]))) )) (const_int 1)))] @@ -3186,7 +3372,27 @@ (match_operand:SD_HSI 1 "register_operand" "w")) (sign_extend:<VWIDE> (vec_select:<VEL> - (match_operand:<VCON> 2 "register_operand" "<vwx>") + (match_operand:<VCOND> 2 "register_operand" "<vwx>") + (parallel [(match_operand:SI 3 "immediate_operand" "i")])) + )) + (const_int 1)))] + "TARGET_SIMD" + { + operands[3] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[3]))); + return "sqdmull\\t%<vw2>0<Vmwtype>, %<v>1<Vmtype>, %2.<Vetype>[%3]"; + } + [(set_attr "type" "neon_sat_mul_<Vetype>_scalar_long")] +) + +(define_insn "aarch64_sqdmull_laneq<mode>_internal" + [(set (match_operand:<VWIDE> 0 "register_operand" "=w") + (ss_ashift:<VWIDE> + (mult:<VWIDE> + (sign_extend:<VWIDE> + (match_operand:SD_HSI 1 "register_operand" "w")) + (sign_extend:<VWIDE> + (vec_select:<VEL> + (match_operand:<VCONQ> 2 "register_operand" "<vwx>") (parallel [(match_operand:SI 3 "immediate_operand" "i")])) )) (const_int 1)))] @@ -3201,12 +3407,12 @@ (define_expand "aarch64_sqdmull_lane<mode>" [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:VSD_HSI 1 "register_operand" "w") - (match_operand:<VCON> 2 "register_operand" "<vwx>") + (match_operand:<VCOND> 2 "register_operand" "<vwx>") (match_operand:SI 3 "immediate_operand" "i")] "TARGET_SIMD" { - aarch64_simd_lane_bounds (operands[3], 0, GET_MODE_NUNITS (<VCON>mode) / 2); - operands[3] = GEN_INT (ENDIAN_LANE_N (<VCON>mode, INTVAL (operands[3]))); + aarch64_simd_lane_bounds (operands[3], 0, GET_MODE_NUNITS (<VCOND>mode)); + operands[3] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[3]))); emit_insn (gen_aarch64_sqdmull_lane<mode>_internal (operands[0], operands[1], operands[2], operands[3])); DONE; @@ -3215,13 +3421,13 @@ (define_expand "aarch64_sqdmull_laneq<mode>" [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:VD_HSI 1 "register_operand" "w") - (match_operand:<VCON> 2 "register_operand" "<vwx>") + (match_operand:<VCONQ> 2 "register_operand" "<vwx>") (match_operand:SI 3 "immediate_operand" "i")] "TARGET_SIMD" { - aarch64_simd_lane_bounds (operands[3], 0, GET_MODE_NUNITS (<VCON>mode)); + aarch64_simd_lane_bounds (operands[3], 0, GET_MODE_NUNITS (<VCONQ>mode)); operands[3] = GEN_INT (ENDIAN_LANE_N (<VCONQ>mode, INTVAL (operands[3]))); - emit_insn (gen_aarch64_sqdmull_lane<mode>_internal + emit_insn (gen_aarch64_sqdmull_laneq<mode>_internal (operands[0], operands[1], operands[2], operands[3])); DONE; }) @@ -3270,7 +3476,7 @@ (define_expand "aarch64_sqdmull2<mode>" [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:VQ_HSI 1 "register_operand" "w") - (match_operand:<VCON> 2 "register_operand" "w")] + (match_operand:VQ_HSI 2 "register_operand" "w")] "TARGET_SIMD" { rtx p = aarch64_simd_vect_par_cnst_half (<MODE>mode, true); @@ -3292,7 +3498,30 @@ (sign_extend:<VWIDE> (vec_duplicate:<VHALF> (vec_select:<VEL> - (match_operand:<VCON> 2 "register_operand" "<vwx>") + (match_operand:<VCOND> 2 "register_operand" "<vwx>") + (parallel [(match_operand:SI 3 "immediate_operand" "i")]))) + )) + (const_int 1)))] + "TARGET_SIMD" + { + operands[3] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[3]))); + return "sqdmull2\\t%<vw2>0<Vmwtype>, %<v>1<Vmtype>, %2.<Vetype>[%3]"; + } + [(set_attr "type" "neon_sat_mul_<Vetype>_scalar_long")] +) + +(define_insn "aarch64_sqdmull2_laneq<mode>_internal" + [(set (match_operand:<VWIDE> 0 "register_operand" "=w") + (ss_ashift:<VWIDE> + (mult:<VWIDE> + (sign_extend:<VWIDE> + (vec_select:<VHALF> + (match_operand:VQ_HSI 1 "register_operand" "w") + (match_operand:VQ_HSI 4 "vect_par_cnst_hi_half" ""))) + (sign_extend:<VWIDE> + (vec_duplicate:<VHALF> + (vec_select:<VEL> + (match_operand:<VCONQ> 2 "register_operand" "<vwx>") (parallel [(match_operand:SI 3 "immediate_operand" "i")]))) )) (const_int 1)))] @@ -3307,13 +3536,13 @@ (define_expand "aarch64_sqdmull2_lane<mode>" [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:VQ_HSI 1 "register_operand" "w") - (match_operand:<VCON> 2 "register_operand" "<vwx>") + (match_operand:<VCOND> 2 "register_operand" "<vwx>") (match_operand:SI 3 "immediate_operand" "i")] "TARGET_SIMD" { rtx p = aarch64_simd_vect_par_cnst_half (<MODE>mode, true); - aarch64_simd_lane_bounds (operands[3], 0, GET_MODE_NUNITS (<MODE>mode) / 2); - operands[3] = GEN_INT (ENDIAN_LANE_N (<MODE>mode, INTVAL (operands[3]))); + aarch64_simd_lane_bounds (operands[3], 0, GET_MODE_NUNITS (<VCOND>mode)); + operands[3] = GEN_INT (ENDIAN_LANE_N (<VCOND>mode, INTVAL (operands[3]))); emit_insn (gen_aarch64_sqdmull2_lane<mode>_internal (operands[0], operands[1], operands[2], operands[3], p)); @@ -3323,14 +3552,14 @@ (define_expand "aarch64_sqdmull2_laneq<mode>" [(match_operand:<VWIDE> 0 "register_operand" "=w") (match_operand:VQ_HSI 1 "register_operand" "w") - (match_operand:<VCON> 2 "register_operand" "<vwx>") + (match_operand:<VCONQ> 2 "register_operand" "<vwx>") (match_operand:SI 3 "immediate_operand" "i")] "TARGET_SIMD" { rtx p = aarch64_simd_vect_par_cnst_half (<MODE>mode, true); - aarch64_simd_lane_bounds (operands[3], 0, GET_MODE_NUNITS (<MODE>mode)); - operands[3] = GEN_INT (ENDIAN_LANE_N (<MODE>mode, INTVAL (operands[3]))); - emit_insn (gen_aarch64_sqdmull2_lane<mode>_internal (operands[0], operands[1], + aarch64_simd_lane_bounds (operands[3], 0, GET_MODE_NUNITS (<VCONQ>mode)); + operands[3] = GEN_INT (ENDIAN_LANE_N (<VCONQ>mode, INTVAL (operands[3]))); + emit_insn (gen_aarch64_sqdmull2_laneq<mode>_internal (operands[0], operands[1], operands[2], operands[3], p)); DONE; diff --git a/gcc/config/aarch64/aarch64.c b/gcc/config/aarch64/aarch64.c index 4ee773e9d2e..50310c659a7 100644 --- a/gcc/config/aarch64/aarch64.c +++ b/gcc/config/aarch64/aarch64.c @@ -7269,7 +7269,8 @@ aarch64_vector_mode_supported_p (enum machine_mode mode) || mode == V16QImode || mode == V2DImode || mode == V2SImode || mode == V4HImode || mode == V8QImode || mode == V2SFmode - || mode == V4SFmode || mode == V2DFmode)) + || mode == V4SFmode || mode == V2DFmode + || mode == V1DFmode)) return true; return false; diff --git a/gcc/config/aarch64/aarch64.md b/gcc/config/aarch64/aarch64.md index 30f87b5059c..71c8309b043 100644 --- a/gcc/config/aarch64/aarch64.md +++ b/gcc/config/aarch64/aarch64.md @@ -2949,17 +2949,18 @@ ;; Arithmetic right shift using SISD or Integer instruction (define_insn "*aarch64_ashr_sisd_or_int_<mode>3" - [(set (match_operand:GPI 0 "register_operand" "=w,w,r") + [(set (match_operand:GPI 0 "register_operand" "=w,&w,&w,r") (ashiftrt:GPI - (match_operand:GPI 1 "register_operand" "w,w,r") - (match_operand:QI 2 "aarch64_reg_or_shift_imm_di" "Us<cmode>,w,rUs<cmode>")))] + (match_operand:GPI 1 "register_operand" "w,w,w,r") + (match_operand:QI 2 "aarch64_reg_or_shift_imm_di" "Us<cmode>,w,0,rUs<cmode>")))] "" "@ sshr\t%<rtn>0<vas>, %<rtn>1<vas>, %2 # + # asr\t%<w>0, %<w>1, %<w>2" - [(set_attr "simd" "yes,yes,no") - (set_attr "type" "neon_shift_imm<q>,neon_shift_reg<q>,shift_reg")] + [(set_attr "simd" "yes,yes,yes,no") + (set_attr "type" "neon_shift_imm<q>,neon_shift_reg<q>,neon_shift_reg<q>,shift_reg")] ) (define_split @@ -2968,11 +2969,13 @@ (match_operand:DI 1 "aarch64_simd_register") (match_operand:QI 2 "aarch64_simd_register")))] "TARGET_SIMD && reload_completed" - [(set (match_dup 2) + [(set (match_dup 3) (unspec:QI [(match_dup 2)] UNSPEC_SISD_NEG)) (set (match_dup 0) - (unspec:DI [(match_dup 1) (match_dup 2)] UNSPEC_SISD_SSHL))] - "" + (unspec:DI [(match_dup 1) (match_dup 3)] UNSPEC_SISD_SSHL))] +{ + operands[3] = gen_lowpart (QImode, operands[0]); +} ) (define_split @@ -2981,11 +2984,13 @@ (match_operand:SI 1 "aarch64_simd_register") (match_operand:QI 2 "aarch64_simd_register")))] "TARGET_SIMD && reload_completed" - [(set (match_dup 2) + [(set (match_dup 3) (unspec:QI [(match_dup 2)] UNSPEC_SISD_NEG)) (set (match_dup 0) - (unspec:SI [(match_dup 1) (match_dup 2)] UNSPEC_SSHL_2S))] - "" + (unspec:SI [(match_dup 1) (match_dup 3)] UNSPEC_SSHL_2S))] +{ + operands[3] = gen_lowpart (QImode, operands[0]); +} ) (define_insn "*aarch64_sisd_ushl" diff --git a/gcc/config/aarch64/arm_neon.h b/gcc/config/aarch64/arm_neon.h index d4424dfe9ac..e69351c33b9 100644 --- a/gcc/config/aarch64/arm_neon.h +++ b/gcc/config/aarch64/arm_neon.h @@ -20892,7 +20892,7 @@ vqdmlal_high_s16 (int32x4_t __a, int16x8_t __b, int16x8_t __c) } __extension__ static __inline int32x4_t __attribute__ ((__always_inline__)) -vqdmlal_high_lane_s16 (int32x4_t __a, int16x8_t __b, int16x8_t __c, +vqdmlal_high_lane_s16 (int32x4_t __a, int16x8_t __b, int16x4_t __c, int const __d) { return __builtin_aarch64_sqdmlal2_lanev8hi (__a, __b, __c, __d); @@ -20914,8 +20914,7 @@ vqdmlal_high_n_s16 (int32x4_t __a, int16x8_t __b, int16_t __c) __extension__ static __inline int32x4_t __attribute__ ((__always_inline__)) vqdmlal_lane_s16 (int32x4_t __a, int16x4_t __b, int16x4_t __c, int const __d) { - int16x8_t __tmp = vcombine_s16 (__c, vcreate_s16 (__AARCH64_INT64_C (0))); - return __builtin_aarch64_sqdmlal_lanev4hi (__a, __b, __tmp, __d); + return __builtin_aarch64_sqdmlal_lanev4hi (__a, __b, __c, __d); } __extension__ static __inline int32x4_t __attribute__ ((__always_inline__)) @@ -20943,7 +20942,7 @@ vqdmlal_high_s32 (int64x2_t __a, int32x4_t __b, int32x4_t __c) } __extension__ static __inline int64x2_t __attribute__ ((__always_inline__)) -vqdmlal_high_lane_s32 (int64x2_t __a, int32x4_t __b, int32x4_t __c, +vqdmlal_high_lane_s32 (int64x2_t __a, int32x4_t __b, int32x2_t __c, int const __d) { return __builtin_aarch64_sqdmlal2_lanev4si (__a, __b, __c, __d); @@ -20965,8 +20964,7 @@ vqdmlal_high_n_s32 (int64x2_t __a, int32x4_t __b, int32_t __c) __extension__ static __inline int64x2_t __attribute__ ((__always_inline__)) vqdmlal_lane_s32 (int64x2_t __a, int32x2_t __b, int32x2_t __c, int const __d) { - int32x4_t __tmp = vcombine_s32 (__c, vcreate_s32 (__AARCH64_INT64_C (0))); - return __builtin_aarch64_sqdmlal_lanev2si (__a, __b, __tmp, __d); + return __builtin_aarch64_sqdmlal_lanev2si (__a, __b, __c, __d); } __extension__ static __inline int64x2_t __attribute__ ((__always_inline__)) @@ -20988,7 +20986,7 @@ vqdmlalh_s16 (int32x1_t __a, int16x1_t __b, int16x1_t __c) } __extension__ static __inline int32x1_t __attribute__ ((__always_inline__)) -vqdmlalh_lane_s16 (int32x1_t __a, int16x1_t __b, int16x8_t __c, const int __d) +vqdmlalh_lane_s16 (int32x1_t __a, int16x1_t __b, int16x4_t __c, const int __d) { return __builtin_aarch64_sqdmlal_lanehi (__a, __b, __c, __d); } @@ -21000,7 +20998,7 @@ vqdmlals_s32 (int64x1_t __a, int32x1_t __b, int32x1_t __c) } __extension__ static __inline int64x1_t __attribute__ ((__always_inline__)) -vqdmlals_lane_s32 (int64x1_t __a, int32x1_t __b, int32x4_t __c, const int __d) +vqdmlals_lane_s32 (int64x1_t __a, int32x1_t __b, int32x2_t __c, const int __d) { return __builtin_aarch64_sqdmlal_lanesi (__a, __b, __c, __d); } @@ -21020,7 +21018,7 @@ vqdmlsl_high_s16 (int32x4_t __a, int16x8_t __b, int16x8_t __c) } __extension__ static __inline int32x4_t __attribute__ ((__always_inline__)) -vqdmlsl_high_lane_s16 (int32x4_t __a, int16x8_t __b, int16x8_t __c, +vqdmlsl_high_lane_s16 (int32x4_t __a, int16x8_t __b, int16x4_t __c, int const __d) { return __builtin_aarch64_sqdmlsl2_lanev8hi (__a, __b, __c, __d); @@ -21042,8 +21040,7 @@ vqdmlsl_high_n_s16 (int32x4_t __a, int16x8_t __b, int16_t __c) __extension__ static __inline int32x4_t __attribute__ ((__always_inline__)) vqdmlsl_lane_s16 (int32x4_t __a, int16x4_t __b, int16x4_t __c, int const __d) { - int16x8_t __tmp = vcombine_s16 (__c, vcreate_s16 (__AARCH64_INT64_C (0))); - return __builtin_aarch64_sqdmlsl_lanev4hi (__a, __b, __tmp, __d); + return __builtin_aarch64_sqdmlsl_lanev4hi (__a, __b, __c, __d); } __extension__ static __inline int32x4_t __attribute__ ((__always_inline__)) @@ -21071,7 +21068,7 @@ vqdmlsl_high_s32 (int64x2_t __a, int32x4_t __b, int32x4_t __c) } __extension__ static __inline int64x2_t __attribute__ ((__always_inline__)) -vqdmlsl_high_lane_s32 (int64x2_t __a, int32x4_t __b, int32x4_t __c, +vqdmlsl_high_lane_s32 (int64x2_t __a, int32x4_t __b, int32x2_t __c, int const __d) { return __builtin_aarch64_sqdmlsl2_lanev4si (__a, __b, __c, __d); @@ -21093,8 +21090,7 @@ vqdmlsl_high_n_s32 (int64x2_t __a, int32x4_t __b, int32_t __c) __extension__ static __inline int64x2_t __attribute__ ((__always_inline__)) vqdmlsl_lane_s32 (int64x2_t __a, int32x2_t __b, int32x2_t __c, int const __d) { - int32x4_t __tmp = vcombine_s32 (__c, vcreate_s32 (__AARCH64_INT64_C (0))); - return __builtin_aarch64_sqdmlsl_lanev2si (__a, __b, __tmp, __d); + return __builtin_aarch64_sqdmlsl_lanev2si (__a, __b, __c, __d); } __extension__ static __inline int64x2_t __attribute__ ((__always_inline__)) @@ -21116,7 +21112,7 @@ vqdmlslh_s16 (int32x1_t __a, int16x1_t __b, int16x1_t __c) } __extension__ static __inline int32x1_t __attribute__ ((__always_inline__)) -vqdmlslh_lane_s16 (int32x1_t __a, int16x1_t __b, int16x8_t __c, const int __d) +vqdmlslh_lane_s16 (int32x1_t __a, int16x1_t __b, int16x4_t __c, const int __d) { return __builtin_aarch64_sqdmlsl_lanehi (__a, __b, __c, __d); } @@ -21128,7 +21124,7 @@ vqdmlsls_s32 (int64x1_t __a, int32x1_t __b, int32x1_t __c) } __extension__ static __inline int64x1_t __attribute__ ((__always_inline__)) -vqdmlsls_lane_s32 (int64x1_t __a, int32x1_t __b, int32x4_t __c, const int __d) +vqdmlsls_lane_s32 (int64x1_t __a, int32x1_t __b, int32x2_t __c, const int __d) { return __builtin_aarch64_sqdmlsl_lanesi (__a, __b, __c, __d); } @@ -21166,7 +21162,7 @@ vqdmulhh_s16 (int16x1_t __a, int16x1_t __b) } __extension__ static __inline int16x1_t __attribute__ ((__always_inline__)) -vqdmulhh_lane_s16 (int16x1_t __a, int16x8_t __b, const int __c) +vqdmulhh_lane_s16 (int16x1_t __a, int16x4_t __b, const int __c) { return __builtin_aarch64_sqdmulh_lanehi (__a, __b, __c); } @@ -21178,7 +21174,7 @@ vqdmulhs_s32 (int32x1_t __a, int32x1_t __b) } __extension__ static __inline int32x1_t __attribute__ ((__always_inline__)) -vqdmulhs_lane_s32 (int32x1_t __a, int32x4_t __b, const int __c) +vqdmulhs_lane_s32 (int32x1_t __a, int32x2_t __b, const int __c) { return __builtin_aarch64_sqdmulh_lanesi (__a, __b, __c); } @@ -21198,7 +21194,7 @@ vqdmull_high_s16 (int16x8_t __a, int16x8_t __b) } __extension__ static __inline int32x4_t __attribute__ ((__always_inline__)) -vqdmull_high_lane_s16 (int16x8_t __a, int16x8_t __b, int const __c) +vqdmull_high_lane_s16 (int16x8_t __a, int16x4_t __b, int const __c) { return __builtin_aarch64_sqdmull2_lanev8hi (__a, __b,__c); } @@ -21218,8 +21214,7 @@ vqdmull_high_n_s16 (int16x8_t __a, int16_t __b) __extension__ static __inline int32x4_t __attribute__ ((__always_inline__)) vqdmull_lane_s16 (int16x4_t __a, int16x4_t __b, int const __c) { - int16x8_t __tmp = vcombine_s16 (__b, vcreate_s16 (__AARCH64_INT64_C (0))); - return __builtin_aarch64_sqdmull_lanev4hi (__a, __tmp, __c); + return __builtin_aarch64_sqdmull_lanev4hi (__a, __b, __c); } __extension__ static __inline int32x4_t __attribute__ ((__always_inline__)) @@ -21247,7 +21242,7 @@ vqdmull_high_s32 (int32x4_t __a, int32x4_t __b) } __extension__ static __inline int64x2_t __attribute__ ((__always_inline__)) -vqdmull_high_lane_s32 (int32x4_t __a, int32x4_t __b, int const __c) +vqdmull_high_lane_s32 (int32x4_t __a, int32x2_t __b, int const __c) { return __builtin_aarch64_sqdmull2_lanev4si (__a, __b, __c); } @@ -21267,8 +21262,7 @@ vqdmull_high_n_s32 (int32x4_t __a, int32_t __b) __extension__ static __inline int64x2_t __attribute__ ((__always_inline__)) vqdmull_lane_s32 (int32x2_t __a, int32x2_t __b, int const __c) { - int32x4_t __tmp = vcombine_s32 (__b, vcreate_s32 (__AARCH64_INT64_C (0))); - return __builtin_aarch64_sqdmull_lanev2si (__a, __tmp, __c); + return __builtin_aarch64_sqdmull_lanev2si (__a, __b, __c); } __extension__ static __inline int64x2_t __attribute__ ((__always_inline__)) @@ -21290,7 +21284,7 @@ vqdmullh_s16 (int16x1_t __a, int16x1_t __b) } __extension__ static __inline int32x1_t __attribute__ ((__always_inline__)) -vqdmullh_lane_s16 (int16x1_t __a, int16x8_t __b, const int __c) +vqdmullh_lane_s16 (int16x1_t __a, int16x4_t __b, const int __c) { return __builtin_aarch64_sqdmull_lanehi (__a, __b, __c); } @@ -21302,7 +21296,7 @@ vqdmulls_s32 (int32x1_t __a, int32x1_t __b) } __extension__ static __inline int64x1_t __attribute__ ((__always_inline__)) -vqdmulls_lane_s32 (int32x1_t __a, int32x4_t __b, const int __c) +vqdmulls_lane_s32 (int32x1_t __a, int32x2_t __b, const int __c) { return __builtin_aarch64_sqdmull_lanesi (__a, __b, __c); } @@ -21484,7 +21478,7 @@ vqrdmulhh_s16 (int16x1_t __a, int16x1_t __b) } __extension__ static __inline int16x1_t __attribute__ ((__always_inline__)) -vqrdmulhh_lane_s16 (int16x1_t __a, int16x8_t __b, const int __c) +vqrdmulhh_lane_s16 (int16x1_t __a, int16x4_t __b, const int __c) { return __builtin_aarch64_sqrdmulh_lanehi (__a, __b, __c); } @@ -21496,7 +21490,7 @@ vqrdmulhs_s32 (int32x1_t __a, int32x1_t __b) } __extension__ static __inline int32x1_t __attribute__ ((__always_inline__)) -vqrdmulhs_lane_s32 (int32x1_t __a, int32x4_t __b, const int __c) +vqrdmulhs_lane_s32 (int32x1_t __a, int32x2_t __b, const int __c) { return __builtin_aarch64_sqrdmulh_lanesi (__a, __b, __c); } diff --git a/gcc/config/aarch64/iterators.md b/gcc/config/aarch64/iterators.md index 41044224749..d7ac267c415 100644 --- a/gcc/config/aarch64/iterators.md +++ b/gcc/config/aarch64/iterators.md @@ -402,14 +402,15 @@ (SI "SI") (HI "HI") (QI "QI")]) -;; Define container mode for lane selection. -(define_mode_attr VCOND [(V4HI "V4HI") (V8HI "V4HI") +;; 64-bit container modes the inner or scalar source mode. +(define_mode_attr VCOND [(HI "V4HI") (SI "V2SI") + (V4HI "V4HI") (V8HI "V4HI") (V2SI "V2SI") (V4SI "V2SI") (DI "DI") (V2DI "DI") (V2SF "V2SF") (V4SF "V2SF") (V2DF "DF")]) -;; Define container mode for lane selection. +;; 128-bit container modes the inner or scalar source mode. (define_mode_attr VCONQ [(V8QI "V16QI") (V16QI "V16QI") (V4HI "V8HI") (V8HI "V8HI") (V2SI "V4SI") (V4SI "V4SI") @@ -418,15 +419,6 @@ (V2DF "V2DF") (SI "V4SI") (HI "V8HI") (QI "V16QI")]) -;; Define container mode for lane selection. -(define_mode_attr VCON [(V8QI "V16QI") (V16QI "V16QI") - (V4HI "V8HI") (V8HI "V8HI") - (V2SI "V4SI") (V4SI "V4SI") - (DI "V2DI") (V2DI "V2DI") - (V2SF "V4SF") (V4SF "V4SF") - (V2DF "V2DF") (SI "V4SI") - (HI "V8HI") (QI "V16QI")]) - ;; Half modes of all vector modes. (define_mode_attr VHALF [(V8QI "V4QI") (V16QI "V8QI") (V4HI "V2HI") (V8HI "V4HI") diff --git a/gcc/config/alpha/alpha.c b/gcc/config/alpha/alpha.c index dc07a02c0cf..d5c7908beb0 100644 --- a/gcc/config/alpha/alpha.c +++ b/gcc/config/alpha/alpha.c @@ -8715,6 +8715,11 @@ alpha_handle_trap_shadows (void) } break; + case BARRIER: + /* __builtin_unreachable can expand to no code at all, + leaving (barrier) RTXes in the instruction stream. */ + goto close_shadow_notrapb; + case JUMP_INSN: case CALL_INSN: case CODE_LABEL: @@ -8730,6 +8735,7 @@ alpha_handle_trap_shadows (void) n = emit_insn_before (gen_trapb (), i); PUT_MODE (n, TImode); PUT_MODE (i, TImode); + close_shadow_notrapb: trap_pending = 0; shadow.used.i = 0; shadow.used.fp = 0; diff --git a/gcc/config/arm/arm.c b/gcc/config/arm/arm.c index 58a128e1ca6..55780d4bd23 100644 --- a/gcc/config/arm/arm.c +++ b/gcc/config/arm/arm.c @@ -16942,7 +16942,8 @@ thumb1_reorg (void) insn = PREV_INSN (insn); /* Find the last cbranchsi4_insn in basic block BB. */ - if (INSN_CODE (insn) != CODE_FOR_cbranchsi4_insn) + if (insn == BB_HEAD (bb) + || INSN_CODE (insn) != CODE_FOR_cbranchsi4_insn) continue; /* Get the register with which we are comparing. */ diff --git a/gcc/config/arm/arm_neon.h b/gcc/config/arm/arm_neon.h index 37a6e611b48..95735433df7 100644 --- a/gcc/config/arm/arm_neon.h +++ b/gcc/config/arm/arm_neon.h @@ -1,5 +1,4 @@ -/* ARM NEON intrinsics include file. This file is generated automatically - using neon-gen.ml. Please do not edit manually. +/* ARM NEON intrinsics include file. Copyright (C) 2006-2014 Free Software Foundation, Inc. Contributed by CodeSourcery. @@ -7707,12 +7706,32 @@ vbslq_p16 (uint16x8_t __a, poly16x8_t __b, poly16x8_t __c) return (poly16x8_t)__builtin_neon_vbslv8hi ((int16x8_t) __a, (int16x8_t) __b, (int16x8_t) __c); } +/* For big-endian, the shuffle masks for ZIP, UZP and TRN must be changed as + follows. (nelt = the number of elements within a vector.) + + Firstly, a value of N within a mask, becomes (N ^ (nelt - 1)), as gcc vector + extension's indexing scheme is reversed *within each vector* (relative to the + neon intrinsics view), but without changing which of the two vectors. + + Secondly, the elements within each mask are reversed, as the mask is itself a + vector, and will itself be loaded in reverse order (again, relative to the + neon intrinsics view, i.e. that would result from a "vld1" instruction). */ + __extension__ static __inline int8x8x2_t __attribute__ ((__always_inline__)) vtrn_s8 (int8x8_t __a, int8x8_t __b) { int8x8x2_t __rv; - __rv.val[0] = (int8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 0, 8, 2, 10, 4, 12, 6, 14 }); - __rv.val[1] = (int8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 1, 9, 3, 11, 5, 13, 7, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 9, 1, 11, 3, 13, 5, 15, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 8, 0, 10, 2, 12, 4, 14, 6 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 0, 8, 2, 10, 4, 12, 6, 14 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 1, 9, 3, 11, 5, 13, 7, 15 }); +#endif return __rv; } @@ -7720,8 +7739,13 @@ __extension__ static __inline int16x4x2_t __attribute__ ((__always_inline__)) vtrn_s16 (int16x4_t __a, int16x4_t __b) { int16x4x2_t __rv; - __rv.val[0] = (int16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 4, 2, 6 }); - __rv.val[1] = (int16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 1, 5, 3, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 5, 1, 7, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 4, 0, 6, 2 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 4, 2, 6 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 1, 5, 3, 7 }); +#endif return __rv; } @@ -7729,8 +7753,17 @@ __extension__ static __inline uint8x8x2_t __attribute__ ((__always_inline__)) vtrn_u8 (uint8x8_t __a, uint8x8_t __b) { uint8x8x2_t __rv; - __rv.val[0] = (uint8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 0, 8, 2, 10, 4, 12, 6, 14 }); - __rv.val[1] = (uint8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 1, 9, 3, 11, 5, 13, 7, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 9, 1, 11, 3, 13, 5, 15, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 8, 0, 10, 2, 12, 4, 14, 6 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 0, 8, 2, 10, 4, 12, 6, 14 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 1, 9, 3, 11, 5, 13, 7, 15 }); +#endif return __rv; } @@ -7738,8 +7771,13 @@ __extension__ static __inline uint16x4x2_t __attribute__ ((__always_inline__)) vtrn_u16 (uint16x4_t __a, uint16x4_t __b) { uint16x4x2_t __rv; - __rv.val[0] = (uint16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 4, 2, 6 }); - __rv.val[1] = (uint16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 1, 5, 3, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 5, 1, 7, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 4, 0, 6, 2 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 4, 2, 6 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 1, 5, 3, 7 }); +#endif return __rv; } @@ -7747,8 +7785,17 @@ __extension__ static __inline poly8x8x2_t __attribute__ ((__always_inline__)) vtrn_p8 (poly8x8_t __a, poly8x8_t __b) { poly8x8x2_t __rv; - __rv.val[0] = (poly8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 0, 8, 2, 10, 4, 12, 6, 14 }); - __rv.val[1] = (poly8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 1, 9, 3, 11, 5, 13, 7, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 9, 1, 11, 3, 13, 5, 15, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 8, 0, 10, 2, 12, 4, 14, 6 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 0, 8, 2, 10, 4, 12, 6, 14 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 1, 9, 3, 11, 5, 13, 7, 15 }); +#endif return __rv; } @@ -7756,8 +7803,13 @@ __extension__ static __inline poly16x4x2_t __attribute__ ((__always_inline__)) vtrn_p16 (poly16x4_t __a, poly16x4_t __b) { poly16x4x2_t __rv; - __rv.val[0] = (poly16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 4, 2, 6 }); - __rv.val[1] = (poly16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 1, 5, 3, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 5, 1, 7, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 4, 0, 6, 2 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 4, 2, 6 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 1, 5, 3, 7 }); +#endif return __rv; } @@ -7765,8 +7817,13 @@ __extension__ static __inline int32x2x2_t __attribute__ ((__always_inline__)) vtrn_s32 (int32x2_t __a, int32x2_t __b) { int32x2x2_t __rv; - __rv.val[0] = (int32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); - __rv.val[1] = (int32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 3, 1 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 2, 0 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#endif return __rv; } @@ -7774,8 +7831,13 @@ __extension__ static __inline float32x2x2_t __attribute__ ((__always_inline__)) vtrn_f32 (float32x2_t __a, float32x2_t __b) { float32x2x2_t __rv; - __rv.val[0] = (float32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); - __rv.val[1] = (float32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 3, 1 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 2, 0 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#endif return __rv; } @@ -7783,8 +7845,13 @@ __extension__ static __inline uint32x2x2_t __attribute__ ((__always_inline__)) vtrn_u32 (uint32x2_t __a, uint32x2_t __b) { uint32x2x2_t __rv; - __rv.val[0] = (uint32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); - __rv.val[1] = (uint32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 3, 1 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 2, 0 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#endif return __rv; } @@ -7792,8 +7859,17 @@ __extension__ static __inline int8x16x2_t __attribute__ ((__always_inline__)) vtrnq_s8 (int8x16_t __a, int8x16_t __b) { int8x16x2_t __rv; - __rv.val[0] = (int8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 0, 16, 2, 18, 4, 20, 6, 22, 8, 24, 10, 26, 12, 28, 14, 30 }); - __rv.val[1] = (int8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 1, 17, 3, 19, 5, 21, 7, 23, 9, 25, 11, 27, 13, 29, 15, 31 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 17, 1, 19, 3, 21, 5, 23, 7, 25, 9, 27, 11, 29, 13, 31, 15 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 16, 0, 18, 2, 20, 4, 22, 6, 24, 8, 26, 10, 28, 12, 30, 14 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 0, 16, 2, 18, 4, 20, 6, 22, 8, 24, 10, 26, 12, 28, 14, 30 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 1, 17, 3, 19, 5, 21, 7, 23, 9, 25, 11, 27, 13, 29, 15, 31 }); +#endif return __rv; } @@ -7801,8 +7877,17 @@ __extension__ static __inline int16x8x2_t __attribute__ ((__always_inline__)) vtrnq_s16 (int16x8_t __a, int16x8_t __b) { int16x8x2_t __rv; - __rv.val[0] = (int16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 0, 8, 2, 10, 4, 12, 6, 14 }); - __rv.val[1] = (int16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 1, 9, 3, 11, 5, 13, 7, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 9, 1, 11, 3, 13, 5, 15, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 8, 0, 10, 2, 12, 4, 14, 6 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 0, 8, 2, 10, 4, 12, 6, 14 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 1, 9, 3, 11, 5, 13, 7, 15 }); +#endif return __rv; } @@ -7810,8 +7895,13 @@ __extension__ static __inline int32x4x2_t __attribute__ ((__always_inline__)) vtrnq_s32 (int32x4_t __a, int32x4_t __b) { int32x4x2_t __rv; - __rv.val[0] = (int32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 4, 2, 6 }); - __rv.val[1] = (int32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 1, 5, 3, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 5, 1, 7, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 4, 0, 6, 2 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 4, 2, 6 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 1, 5, 3, 7 }); +#endif return __rv; } @@ -7819,8 +7909,13 @@ __extension__ static __inline float32x4x2_t __attribute__ ((__always_inline__)) vtrnq_f32 (float32x4_t __a, float32x4_t __b) { float32x4x2_t __rv; - __rv.val[0] = (float32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 4, 2, 6 }); - __rv.val[1] = (float32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 1, 5, 3, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 5, 1, 7, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 4, 0, 6, 2 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 4, 2, 6 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 1, 5, 3, 7 }); +#endif return __rv; } @@ -7828,8 +7923,17 @@ __extension__ static __inline uint8x16x2_t __attribute__ ((__always_inline__)) vtrnq_u8 (uint8x16_t __a, uint8x16_t __b) { uint8x16x2_t __rv; - __rv.val[0] = (uint8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 0, 16, 2, 18, 4, 20, 6, 22, 8, 24, 10, 26, 12, 28, 14, 30 }); - __rv.val[1] = (uint8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 1, 17, 3, 19, 5, 21, 7, 23, 9, 25, 11, 27, 13, 29, 15, 31 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 17, 1, 19, 3, 21, 5, 23, 7, 25, 9, 27, 11, 29, 13, 31, 15 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 16, 0, 18, 2, 20, 4, 22, 6, 24, 8, 26, 10, 28, 12, 30, 14 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 0, 16, 2, 18, 4, 20, 6, 22, 8, 24, 10, 26, 12, 28, 14, 30 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 1, 17, 3, 19, 5, 21, 7, 23, 9, 25, 11, 27, 13, 29, 15, 31 }); +#endif return __rv; } @@ -7837,8 +7941,17 @@ __extension__ static __inline uint16x8x2_t __attribute__ ((__always_inline__)) vtrnq_u16 (uint16x8_t __a, uint16x8_t __b) { uint16x8x2_t __rv; - __rv.val[0] = (uint16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 0, 8, 2, 10, 4, 12, 6, 14 }); - __rv.val[1] = (uint16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 1, 9, 3, 11, 5, 13, 7, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 9, 1, 11, 3, 13, 5, 15, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 8, 0, 10, 2, 12, 4, 14, 6 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 0, 8, 2, 10, 4, 12, 6, 14 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 1, 9, 3, 11, 5, 13, 7, 15 }); +#endif return __rv; } @@ -7846,8 +7959,13 @@ __extension__ static __inline uint32x4x2_t __attribute__ ((__always_inline__)) vtrnq_u32 (uint32x4_t __a, uint32x4_t __b) { uint32x4x2_t __rv; - __rv.val[0] = (uint32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 4, 2, 6 }); - __rv.val[1] = (uint32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 1, 5, 3, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 5, 1, 7, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 4, 0, 6, 2 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 4, 2, 6 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 1, 5, 3, 7 }); +#endif return __rv; } @@ -7855,8 +7973,17 @@ __extension__ static __inline poly8x16x2_t __attribute__ ((__always_inline__)) vtrnq_p8 (poly8x16_t __a, poly8x16_t __b) { poly8x16x2_t __rv; - __rv.val[0] = (poly8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 0, 16, 2, 18, 4, 20, 6, 22, 8, 24, 10, 26, 12, 28, 14, 30 }); - __rv.val[1] = (poly8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 1, 17, 3, 19, 5, 21, 7, 23, 9, 25, 11, 27, 13, 29, 15, 31 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 17, 1, 19, 3, 21, 5, 23, 7, 25, 9, 27, 11, 29, 13, 31, 15 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 16, 0, 18, 2, 20, 4, 22, 6, 24, 8, 26, 10, 28, 12, 30, 14 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 0, 16, 2, 18, 4, 20, 6, 22, 8, 24, 10, 26, 12, 28, 14, 30 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 1, 17, 3, 19, 5, 21, 7, 23, 9, 25, 11, 27, 13, 29, 15, 31 }); +#endif return __rv; } @@ -7864,8 +7991,17 @@ __extension__ static __inline poly16x8x2_t __attribute__ ((__always_inline__)) vtrnq_p16 (poly16x8_t __a, poly16x8_t __b) { poly16x8x2_t __rv; - __rv.val[0] = (poly16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 0, 8, 2, 10, 4, 12, 6, 14 }); - __rv.val[1] = (poly16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 1, 9, 3, 11, 5, 13, 7, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 9, 1, 11, 3, 13, 5, 15, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 8, 0, 10, 2, 12, 4, 14, 6 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 0, 8, 2, 10, 4, 12, 6, 14 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 1, 9, 3, 11, 5, 13, 7, 15 }); +#endif return __rv; } @@ -7873,8 +8009,17 @@ __extension__ static __inline int8x8x2_t __attribute__ ((__always_inline__)) vzip_s8 (int8x8_t __a, int8x8_t __b) { int8x8x2_t __rv; - __rv.val[0] = (int8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 0, 8, 1, 9, 2, 10, 3, 11 }); - __rv.val[1] = (int8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 4, 12, 5, 13, 6, 14, 7, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 12, 4, 13, 5, 14, 6, 15, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 8, 0, 9, 1, 10, 2, 11, 3 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 0, 8, 1, 9, 2, 10, 3, 11 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 4, 12, 5, 13, 6, 14, 7, 15 }); +#endif return __rv; } @@ -7882,8 +8027,13 @@ __extension__ static __inline int16x4x2_t __attribute__ ((__always_inline__)) vzip_s16 (int16x4_t __a, int16x4_t __b) { int16x4x2_t __rv; - __rv.val[0] = (int16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 4, 1, 5 }); - __rv.val[1] = (int16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 2, 6, 3, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 6, 2, 7, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 4, 0, 5, 1 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 4, 1, 5 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 2, 6, 3, 7 }); +#endif return __rv; } @@ -7891,8 +8041,17 @@ __extension__ static __inline uint8x8x2_t __attribute__ ((__always_inline__)) vzip_u8 (uint8x8_t __a, uint8x8_t __b) { uint8x8x2_t __rv; - __rv.val[0] = (uint8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 0, 8, 1, 9, 2, 10, 3, 11 }); - __rv.val[1] = (uint8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 4, 12, 5, 13, 6, 14, 7, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 12, 4, 13, 5, 14, 6, 15, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 8, 0, 9, 1, 10, 2, 11, 3 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 0, 8, 1, 9, 2, 10, 3, 11 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 4, 12, 5, 13, 6, 14, 7, 15 }); +#endif return __rv; } @@ -7900,8 +8059,13 @@ __extension__ static __inline uint16x4x2_t __attribute__ ((__always_inline__)) vzip_u16 (uint16x4_t __a, uint16x4_t __b) { uint16x4x2_t __rv; - __rv.val[0] = (uint16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 4, 1, 5 }); - __rv.val[1] = (uint16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 2, 6, 3, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 6, 2, 7, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 4, 0, 5, 1 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 4, 1, 5 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 2, 6, 3, 7 }); +#endif return __rv; } @@ -7909,8 +8073,17 @@ __extension__ static __inline poly8x8x2_t __attribute__ ((__always_inline__)) vzip_p8 (poly8x8_t __a, poly8x8_t __b) { poly8x8x2_t __rv; - __rv.val[0] = (poly8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 0, 8, 1, 9, 2, 10, 3, 11 }); - __rv.val[1] = (poly8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 4, 12, 5, 13, 6, 14, 7, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 12, 4, 13, 5, 14, 6, 15, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 8, 0, 9, 1, 10, 2, 11, 3 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 0, 8, 1, 9, 2, 10, 3, 11 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 4, 12, 5, 13, 6, 14, 7, 15 }); +#endif return __rv; } @@ -7918,8 +8091,13 @@ __extension__ static __inline poly16x4x2_t __attribute__ ((__always_inline__)) vzip_p16 (poly16x4_t __a, poly16x4_t __b) { poly16x4x2_t __rv; - __rv.val[0] = (poly16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 4, 1, 5 }); - __rv.val[1] = (poly16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 2, 6, 3, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 6, 2, 7, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 4, 0, 5, 1 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 4, 1, 5 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 2, 6, 3, 7 }); +#endif return __rv; } @@ -7927,8 +8105,13 @@ __extension__ static __inline int32x2x2_t __attribute__ ((__always_inline__)) vzip_s32 (int32x2_t __a, int32x2_t __b) { int32x2x2_t __rv; - __rv.val[0] = (int32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); - __rv.val[1] = (int32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 3, 1 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 2, 0 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#endif return __rv; } @@ -7936,8 +8119,13 @@ __extension__ static __inline float32x2x2_t __attribute__ ((__always_inline__)) vzip_f32 (float32x2_t __a, float32x2_t __b) { float32x2x2_t __rv; - __rv.val[0] = (float32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); - __rv.val[1] = (float32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 3, 1 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 2, 0 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#endif return __rv; } @@ -7945,8 +8133,13 @@ __extension__ static __inline uint32x2x2_t __attribute__ ((__always_inline__)) vzip_u32 (uint32x2_t __a, uint32x2_t __b) { uint32x2x2_t __rv; - __rv.val[0] = (uint32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); - __rv.val[1] = (uint32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 3, 1 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 2, 0 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#endif return __rv; } @@ -7954,8 +8147,17 @@ __extension__ static __inline int8x16x2_t __attribute__ ((__always_inline__)) vzipq_s8 (int8x16_t __a, int8x16_t __b) { int8x16x2_t __rv; - __rv.val[0] = (int8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 0, 16, 1, 17, 2, 18, 3, 19, 4, 20, 5, 21, 6, 22, 7, 23 }); - __rv.val[1] = (int8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 8, 24, 9, 25, 10, 26, 11, 27, 12, 28, 13, 29, 14, 30, 15, 31 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 24, 8, 25, 9, 26, 10, 27, 11, 28, 12, 29, 13, 30, 14, 31, 15 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 16, 0, 17, 1, 18, 2, 19, 3, 20, 4, 21, 5, 22, 6, 23, 7 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 0, 16, 1, 17, 2, 18, 3, 19, 4, 20, 5, 21, 6, 22, 7, 23 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 8, 24, 9, 25, 10, 26, 11, 27, 12, 28, 13, 29, 14, 30, 15, 31 }); +#endif return __rv; } @@ -7963,8 +8165,17 @@ __extension__ static __inline int16x8x2_t __attribute__ ((__always_inline__)) vzipq_s16 (int16x8_t __a, int16x8_t __b) { int16x8x2_t __rv; - __rv.val[0] = (int16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 0, 8, 1, 9, 2, 10, 3, 11 }); - __rv.val[1] = (int16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 4, 12, 5, 13, 6, 14, 7, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 12, 4, 13, 5, 14, 6, 15, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 8, 0, 9, 1, 10, 2, 11, 3 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 0, 8, 1, 9, 2, 10, 3, 11 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 4, 12, 5, 13, 6, 14, 7, 15 }); +#endif return __rv; } @@ -7972,8 +8183,13 @@ __extension__ static __inline int32x4x2_t __attribute__ ((__always_inline__)) vzipq_s32 (int32x4_t __a, int32x4_t __b) { int32x4x2_t __rv; - __rv.val[0] = (int32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 4, 1, 5 }); - __rv.val[1] = (int32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 2, 6, 3, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 6, 2, 7, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 4, 0, 5, 1 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 4, 1, 5 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 2, 6, 3, 7 }); +#endif return __rv; } @@ -7981,8 +8197,13 @@ __extension__ static __inline float32x4x2_t __attribute__ ((__always_inline__)) vzipq_f32 (float32x4_t __a, float32x4_t __b) { float32x4x2_t __rv; - __rv.val[0] = (float32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 4, 1, 5 }); - __rv.val[1] = (float32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 2, 6, 3, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 6, 2, 7, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 4, 0, 5, 1 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 4, 1, 5 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 2, 6, 3, 7 }); +#endif return __rv; } @@ -7990,8 +8211,17 @@ __extension__ static __inline uint8x16x2_t __attribute__ ((__always_inline__)) vzipq_u8 (uint8x16_t __a, uint8x16_t __b) { uint8x16x2_t __rv; - __rv.val[0] = (uint8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 0, 16, 1, 17, 2, 18, 3, 19, 4, 20, 5, 21, 6, 22, 7, 23 }); - __rv.val[1] = (uint8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 8, 24, 9, 25, 10, 26, 11, 27, 12, 28, 13, 29, 14, 30, 15, 31 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 24, 8, 25, 9, 26, 10, 27, 11, 28, 12, 29, 13, 30, 14, 31, 15 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 16, 0, 17, 1, 18, 2, 19, 3, 20, 4, 21, 5, 22, 6, 23, 7 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 0, 16, 1, 17, 2, 18, 3, 19, 4, 20, 5, 21, 6, 22, 7, 23 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 8, 24, 9, 25, 10, 26, 11, 27, 12, 28, 13, 29, 14, 30, 15, 31 }); +#endif return __rv; } @@ -7999,8 +8229,17 @@ __extension__ static __inline uint16x8x2_t __attribute__ ((__always_inline__)) vzipq_u16 (uint16x8_t __a, uint16x8_t __b) { uint16x8x2_t __rv; - __rv.val[0] = (uint16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 0, 8, 1, 9, 2, 10, 3, 11 }); - __rv.val[1] = (uint16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 4, 12, 5, 13, 6, 14, 7, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 12, 4, 13, 5, 14, 6, 15, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 8, 0, 9, 1, 10, 2, 11, 3 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 0, 8, 1, 9, 2, 10, 3, 11 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 4, 12, 5, 13, 6, 14, 7, 15 }); +#endif return __rv; } @@ -8008,8 +8247,13 @@ __extension__ static __inline uint32x4x2_t __attribute__ ((__always_inline__)) vzipq_u32 (uint32x4_t __a, uint32x4_t __b) { uint32x4x2_t __rv; - __rv.val[0] = (uint32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 4, 1, 5 }); - __rv.val[1] = (uint32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 2, 6, 3, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 6, 2, 7, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 4, 0, 5, 1 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 4, 1, 5 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 2, 6, 3, 7 }); +#endif return __rv; } @@ -8017,8 +8261,17 @@ __extension__ static __inline poly8x16x2_t __attribute__ ((__always_inline__)) vzipq_p8 (poly8x16_t __a, poly8x16_t __b) { poly8x16x2_t __rv; - __rv.val[0] = (poly8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 0, 16, 1, 17, 2, 18, 3, 19, 4, 20, 5, 21, 6, 22, 7, 23 }); - __rv.val[1] = (poly8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 8, 24, 9, 25, 10, 26, 11, 27, 12, 28, 13, 29, 14, 30, 15, 31 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 24, 8, 25, 9, 26, 10, 27, 11, 28, 12, 29, 13, 30, 14, 31, 15 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 16, 0, 17, 1, 18, 2, 19, 3, 20, 4, 21, 5, 22, 6, 23, 7 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 0, 16, 1, 17, 2, 18, 3, 19, 4, 20, 5, 21, 6, 22, 7, 23 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 8, 24, 9, 25, 10, 26, 11, 27, 12, 28, 13, 29, 14, 30, 15, 31 }); +#endif return __rv; } @@ -8026,8 +8279,17 @@ __extension__ static __inline poly16x8x2_t __attribute__ ((__always_inline__)) vzipq_p16 (poly16x8_t __a, poly16x8_t __b) { poly16x8x2_t __rv; - __rv.val[0] = (poly16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 0, 8, 1, 9, 2, 10, 3, 11 }); - __rv.val[1] = (poly16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 4, 12, 5, 13, 6, 14, 7, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 12, 4, 13, 5, 14, 6, 15, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 8, 0, 9, 1, 10, 2, 11, 3 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 0, 8, 1, 9, 2, 10, 3, 11 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 4, 12, 5, 13, 6, 14, 7, 15 }); +#endif return __rv; } @@ -8035,8 +8297,17 @@ __extension__ static __inline int8x8x2_t __attribute__ ((__always_inline__)) vuzp_s8 (int8x8_t __a, int8x8_t __b) { int8x8x2_t __rv; - __rv.val[0] = (int8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 0, 2, 4, 6, 8, 10, 12, 14 }); - __rv.val[1] = (int8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 1, 3, 5, 7, 9, 11, 13, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 9, 11, 13, 15, 1, 3, 5, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 8, 10, 12, 14, 0, 2, 4, 6 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 0, 2, 4, 6, 8, 10, 12, 14 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 1, 3, 5, 7, 9, 11, 13, 15 }); +#endif return __rv; } @@ -8044,8 +8315,13 @@ __extension__ static __inline int16x4x2_t __attribute__ ((__always_inline__)) vuzp_s16 (int16x4_t __a, int16x4_t __b) { int16x4x2_t __rv; - __rv.val[0] = (int16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 2, 4, 6 }); - __rv.val[1] = (int16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 1, 3, 5, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 5, 7, 1, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 4, 6, 0, 2 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 2, 4, 6 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 1, 3, 5, 7 }); +#endif return __rv; } @@ -8053,8 +8329,13 @@ __extension__ static __inline int32x2x2_t __attribute__ ((__always_inline__)) vuzp_s32 (int32x2_t __a, int32x2_t __b) { int32x2x2_t __rv; - __rv.val[0] = (int32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); - __rv.val[1] = (int32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 3, 1 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 2, 0 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#endif return __rv; } @@ -8062,8 +8343,13 @@ __extension__ static __inline float32x2x2_t __attribute__ ((__always_inline__)) vuzp_f32 (float32x2_t __a, float32x2_t __b) { float32x2x2_t __rv; - __rv.val[0] = (float32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); - __rv.val[1] = (float32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 3, 1 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 2, 0 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#endif return __rv; } @@ -8071,8 +8357,17 @@ __extension__ static __inline uint8x8x2_t __attribute__ ((__always_inline__)) vuzp_u8 (uint8x8_t __a, uint8x8_t __b) { uint8x8x2_t __rv; - __rv.val[0] = (uint8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 0, 2, 4, 6, 8, 10, 12, 14 }); - __rv.val[1] = (uint8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 1, 3, 5, 7, 9, 11, 13, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 9, 11, 13, 15, 1, 3, 5, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 8, 10, 12, 14, 0, 2, 4, 6 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 0, 2, 4, 6, 8, 10, 12, 14 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 1, 3, 5, 7, 9, 11, 13, 15 }); +#endif return __rv; } @@ -8080,8 +8375,13 @@ __extension__ static __inline uint16x4x2_t __attribute__ ((__always_inline__)) vuzp_u16 (uint16x4_t __a, uint16x4_t __b) { uint16x4x2_t __rv; - __rv.val[0] = (uint16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 2, 4, 6 }); - __rv.val[1] = (uint16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 1, 3, 5, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 5, 7, 1, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 4, 6, 0, 2 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 2, 4, 6 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 1, 3, 5, 7 }); +#endif return __rv; } @@ -8089,8 +8389,13 @@ __extension__ static __inline uint32x2x2_t __attribute__ ((__always_inline__)) vuzp_u32 (uint32x2_t __a, uint32x2_t __b) { uint32x2x2_t __rv; - __rv.val[0] = (uint32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); - __rv.val[1] = (uint32x2_t) __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 3, 1 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 2, 0 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x2_t) { 0, 2 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x2_t) { 1, 3 }); +#endif return __rv; } @@ -8098,8 +8403,17 @@ __extension__ static __inline poly8x8x2_t __attribute__ ((__always_inline__)) vuzp_p8 (poly8x8_t __a, poly8x8_t __b) { poly8x8x2_t __rv; - __rv.val[0] = (poly8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 0, 2, 4, 6, 8, 10, 12, 14 }); - __rv.val[1] = (poly8x8_t) __builtin_shuffle (__a, __b, (uint8x8_t) { 1, 3, 5, 7, 9, 11, 13, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 9, 11, 13, 15, 1, 3, 5, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 8, 10, 12, 14, 0, 2, 4, 6 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 0, 2, 4, 6, 8, 10, 12, 14 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x8_t) + { 1, 3, 5, 7, 9, 11, 13, 15 }); +#endif return __rv; } @@ -8107,8 +8421,13 @@ __extension__ static __inline poly16x4x2_t __attribute__ ((__always_inline__)) vuzp_p16 (poly16x4_t __a, poly16x4_t __b) { poly16x4x2_t __rv; - __rv.val[0] = (poly16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 2, 4, 6 }); - __rv.val[1] = (poly16x4_t) __builtin_shuffle (__a, __b, (uint16x4_t) { 1, 3, 5, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 5, 7, 1, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 4, 6, 0, 2 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x4_t) { 0, 2, 4, 6 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x4_t) { 1, 3, 5, 7 }); +#endif return __rv; } @@ -8116,8 +8435,17 @@ __extension__ static __inline int8x16x2_t __attribute__ ((__always_inline__)) vuzpq_s8 (int8x16_t __a, int8x16_t __b) { int8x16x2_t __rv; - __rv.val[0] = (int8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30 }); - __rv.val[1] = (int8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 17, 19, 21, 23, 25, 27, 29, 31, 1, 3, 5, 7, 9, 11, 13, 15 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 16, 18, 20, 22, 24, 26, 28, 30, 0, 2, 4, 6, 8, 10, 12, 14 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31 }); +#endif return __rv; } @@ -8125,8 +8453,17 @@ __extension__ static __inline int16x8x2_t __attribute__ ((__always_inline__)) vuzpq_s16 (int16x8_t __a, int16x8_t __b) { int16x8x2_t __rv; - __rv.val[0] = (int16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 0, 2, 4, 6, 8, 10, 12, 14 }); - __rv.val[1] = (int16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 1, 3, 5, 7, 9, 11, 13, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 9, 11, 13, 15, 1, 3, 5, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 8, 10, 12, 14, 0, 2, 4, 6 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 0, 2, 4, 6, 8, 10, 12, 14 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 1, 3, 5, 7, 9, 11, 13, 15 }); +#endif return __rv; } @@ -8134,8 +8471,13 @@ __extension__ static __inline int32x4x2_t __attribute__ ((__always_inline__)) vuzpq_s32 (int32x4_t __a, int32x4_t __b) { int32x4x2_t __rv; - __rv.val[0] = (int32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 2, 4, 6 }); - __rv.val[1] = (int32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 1, 3, 5, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 5, 7, 1, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 4, 6, 0, 2 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 2, 4, 6 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 1, 3, 5, 7 }); +#endif return __rv; } @@ -8143,8 +8485,13 @@ __extension__ static __inline float32x4x2_t __attribute__ ((__always_inline__)) vuzpq_f32 (float32x4_t __a, float32x4_t __b) { float32x4x2_t __rv; - __rv.val[0] = (float32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 2, 4, 6 }); - __rv.val[1] = (float32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 1, 3, 5, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 5, 7, 1, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 4, 6, 0, 2 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 2, 4, 6 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 1, 3, 5, 7 }); +#endif return __rv; } @@ -8152,8 +8499,17 @@ __extension__ static __inline uint8x16x2_t __attribute__ ((__always_inline__)) vuzpq_u8 (uint8x16_t __a, uint8x16_t __b) { uint8x16x2_t __rv; - __rv.val[0] = (uint8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30 }); - __rv.val[1] = (uint8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 17, 19, 21, 23, 25, 27, 29, 31, 1, 3, 5, 7, 9, 11, 13, 15 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 16, 18, 20, 22, 24, 26, 28, 30, 0, 2, 4, 6, 8, 10, 12, 14 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31 }); +#endif return __rv; } @@ -8161,8 +8517,17 @@ __extension__ static __inline uint16x8x2_t __attribute__ ((__always_inline__)) vuzpq_u16 (uint16x8_t __a, uint16x8_t __b) { uint16x8x2_t __rv; - __rv.val[0] = (uint16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 0, 2, 4, 6, 8, 10, 12, 14 }); - __rv.val[1] = (uint16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 1, 3, 5, 7, 9, 11, 13, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 9, 11, 13, 15, 1, 3, 5, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 8, 10, 12, 14, 0, 2, 4, 6 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 0, 2, 4, 6, 8, 10, 12, 14 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 1, 3, 5, 7, 9, 11, 13, 15 }); +#endif return __rv; } @@ -8170,8 +8535,13 @@ __extension__ static __inline uint32x4x2_t __attribute__ ((__always_inline__)) vuzpq_u32 (uint32x4_t __a, uint32x4_t __b) { uint32x4x2_t __rv; - __rv.val[0] = (uint32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 2, 4, 6 }); - __rv.val[1] = (uint32x4_t) __builtin_shuffle (__a, __b, (uint32x4_t) { 1, 3, 5, 7 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 5, 7, 1, 3 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 4, 6, 0, 2 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint32x4_t) { 0, 2, 4, 6 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint32x4_t) { 1, 3, 5, 7 }); +#endif return __rv; } @@ -8179,8 +8549,17 @@ __extension__ static __inline poly8x16x2_t __attribute__ ((__always_inline__)) vuzpq_p8 (poly8x16_t __a, poly8x16_t __b) { poly8x16x2_t __rv; - __rv.val[0] = (poly8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30 }); - __rv.val[1] = (poly8x16_t) __builtin_shuffle (__a, __b, (uint8x16_t) { 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 17, 19, 21, 23, 25, 27, 29, 31, 1, 3, 5, 7, 9, 11, 13, 15 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 16, 18, 20, 22, 24, 26, 28, 30, 0, 2, 4, 6, 8, 10, 12, 14 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint8x16_t) + { 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31 }); +#endif return __rv; } @@ -8188,8 +8567,17 @@ __extension__ static __inline poly16x8x2_t __attribute__ ((__always_inline__)) vuzpq_p16 (poly16x8_t __a, poly16x8_t __b) { poly16x8x2_t __rv; - __rv.val[0] = (poly16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 0, 2, 4, 6, 8, 10, 12, 14 }); - __rv.val[1] = (poly16x8_t) __builtin_shuffle (__a, __b, (uint16x8_t) { 1, 3, 5, 7, 9, 11, 13, 15 }); +#ifdef __ARM_BIG_ENDIAN + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 9, 11, 13, 15, 1, 3, 5, 7 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 8, 10, 12, 14, 0, 2, 4, 6 }); +#else + __rv.val[0] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 0, 2, 4, 6, 8, 10, 12, 14 }); + __rv.val[1] = __builtin_shuffle (__a, __b, (uint16x8_t) + { 1, 3, 5, 7, 9, 11, 13, 15 }); +#endif return __rv; } diff --git a/gcc/config/arm/neon-docgen.ml b/gcc/config/arm/neon-docgen.ml deleted file mode 100644 index 5788a533e19..00000000000 --- a/gcc/config/arm/neon-docgen.ml +++ /dev/null @@ -1,424 +0,0 @@ -(* ARM NEON documentation generator. - - Copyright (C) 2006-2014 Free Software Foundation, Inc. - Contributed by CodeSourcery. - - This file is part of GCC. - - GCC 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, or (at your option) any later - version. - - GCC 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. - - You should have received a copy of the GNU General Public License - along with GCC; see the file COPYING3. If not see - <http://www.gnu.org/licenses/>. - - This is an O'Caml program. The O'Caml compiler is available from: - - http://caml.inria.fr/ - - Or from your favourite OS's friendly packaging system. Tested with version - 3.09.2, though other versions will probably work too. - - Compile with: - ocamlc -c neon.ml - ocamlc -o neon-docgen neon.cmo neon-docgen.ml - - Run with: - /path/to/neon-docgen /path/to/gcc/doc/arm-neon-intrinsics.texi -*) - -open Neon - -(* The combined "ops" and "reinterp" table. *) -let ops_reinterp = reinterp @ ops - -(* Helper functions for extracting things from the "ops" table. *) -let single_opcode desired_opcode () = - List.fold_left (fun got_so_far -> - fun row -> - match row with - (opcode, _, _, _, _, _) -> - if opcode = desired_opcode then row :: got_so_far - else got_so_far - ) [] ops_reinterp - -let multiple_opcodes desired_opcodes () = - List.fold_left (fun got_so_far -> - fun desired_opcode -> - (single_opcode desired_opcode ()) @ got_so_far) - [] desired_opcodes - -let ldx_opcode number () = - List.fold_left (fun got_so_far -> - fun row -> - match row with - (opcode, _, _, _, _, _) -> - match opcode with - Vldx n | Vldx_lane n | Vldx_dup n when n = number -> - row :: got_so_far - | _ -> got_so_far - ) [] ops_reinterp - -let stx_opcode number () = - List.fold_left (fun got_so_far -> - fun row -> - match row with - (opcode, _, _, _, _, _) -> - match opcode with - Vstx n | Vstx_lane n when n = number -> - row :: got_so_far - | _ -> got_so_far - ) [] ops_reinterp - -let tbl_opcode () = - List.fold_left (fun got_so_far -> - fun row -> - match row with - (opcode, _, _, _, _, _) -> - match opcode with - Vtbl _ -> row :: got_so_far - | _ -> got_so_far - ) [] ops_reinterp - -let tbx_opcode () = - List.fold_left (fun got_so_far -> - fun row -> - match row with - (opcode, _, _, _, _, _) -> - match opcode with - Vtbx _ -> row :: got_so_far - | _ -> got_so_far - ) [] ops_reinterp - -(* The groups of intrinsics. *) -let intrinsic_groups = - [ "Addition", single_opcode Vadd; - "Multiplication", single_opcode Vmul; - "Multiply-accumulate", single_opcode Vmla; - "Multiply-subtract", single_opcode Vmls; - "Fused-multiply-accumulate", single_opcode Vfma; - "Fused-multiply-subtract", single_opcode Vfms; - "Round to integral (to nearest, ties to even)", single_opcode Vrintn; - "Round to integral (to nearest, ties away from zero)", single_opcode Vrinta; - "Round to integral (towards +Inf)", single_opcode Vrintp; - "Round to integral (towards -Inf)", single_opcode Vrintm; - "Round to integral (towards 0)", single_opcode Vrintz; - "Subtraction", single_opcode Vsub; - "Comparison (equal-to)", single_opcode Vceq; - "Comparison (greater-than-or-equal-to)", single_opcode Vcge; - "Comparison (less-than-or-equal-to)", single_opcode Vcle; - "Comparison (greater-than)", single_opcode Vcgt; - "Comparison (less-than)", single_opcode Vclt; - "Comparison (absolute greater-than-or-equal-to)", single_opcode Vcage; - "Comparison (absolute less-than-or-equal-to)", single_opcode Vcale; - "Comparison (absolute greater-than)", single_opcode Vcagt; - "Comparison (absolute less-than)", single_opcode Vcalt; - "Test bits", single_opcode Vtst; - "Absolute difference", single_opcode Vabd; - "Absolute difference and accumulate", single_opcode Vaba; - "Maximum", single_opcode Vmax; - "Minimum", single_opcode Vmin; - "Pairwise add", single_opcode Vpadd; - "Pairwise add, single_opcode widen and accumulate", single_opcode Vpada; - "Folding maximum", single_opcode Vpmax; - "Folding minimum", single_opcode Vpmin; - "Reciprocal step", multiple_opcodes [Vrecps; Vrsqrts]; - "Vector shift left", single_opcode Vshl; - "Vector shift left by constant", single_opcode Vshl_n; - "Vector shift right by constant", single_opcode Vshr_n; - "Vector shift right by constant and accumulate", single_opcode Vsra_n; - "Vector shift right and insert", single_opcode Vsri; - "Vector shift left and insert", single_opcode Vsli; - "Absolute value", single_opcode Vabs; - "Negation", single_opcode Vneg; - "Bitwise not", single_opcode Vmvn; - "Count leading sign bits", single_opcode Vcls; - "Count leading zeros", single_opcode Vclz; - "Count number of set bits", single_opcode Vcnt; - "Reciprocal estimate", single_opcode Vrecpe; - "Reciprocal square-root estimate", single_opcode Vrsqrte; - "Get lanes from a vector", single_opcode Vget_lane; - "Set lanes in a vector", single_opcode Vset_lane; - "Create vector from literal bit pattern", single_opcode Vcreate; - "Set all lanes to the same value", - multiple_opcodes [Vdup_n; Vmov_n; Vdup_lane]; - "Combining vectors", single_opcode Vcombine; - "Splitting vectors", multiple_opcodes [Vget_high; Vget_low]; - "Conversions", multiple_opcodes [Vcvt; Vcvt_n]; - "Move, single_opcode narrowing", single_opcode Vmovn; - "Move, single_opcode long", single_opcode Vmovl; - "Table lookup", tbl_opcode; - "Extended table lookup", tbx_opcode; - "Multiply, lane", single_opcode Vmul_lane; - "Long multiply, lane", single_opcode Vmull_lane; - "Saturating doubling long multiply, lane", single_opcode Vqdmull_lane; - "Saturating doubling multiply high, lane", single_opcode Vqdmulh_lane; - "Multiply-accumulate, lane", single_opcode Vmla_lane; - "Multiply-subtract, lane", single_opcode Vmls_lane; - "Vector multiply by scalar", single_opcode Vmul_n; - "Vector long multiply by scalar", single_opcode Vmull_n; - "Vector saturating doubling long multiply by scalar", - single_opcode Vqdmull_n; - "Vector saturating doubling multiply high by scalar", - single_opcode Vqdmulh_n; - "Vector multiply-accumulate by scalar", single_opcode Vmla_n; - "Vector multiply-subtract by scalar", single_opcode Vmls_n; - "Vector extract", single_opcode Vext; - "Reverse elements", multiple_opcodes [Vrev64; Vrev32; Vrev16]; - "Bit selection", single_opcode Vbsl; - "Transpose elements", single_opcode Vtrn; - "Zip elements", single_opcode Vzip; - "Unzip elements", single_opcode Vuzp; - "Element/structure loads, VLD1 variants", ldx_opcode 1; - "Element/structure stores, VST1 variants", stx_opcode 1; - "Element/structure loads, VLD2 variants", ldx_opcode 2; - "Element/structure stores, VST2 variants", stx_opcode 2; - "Element/structure loads, VLD3 variants", ldx_opcode 3; - "Element/structure stores, VST3 variants", stx_opcode 3; - "Element/structure loads, VLD4 variants", ldx_opcode 4; - "Element/structure stores, VST4 variants", stx_opcode 4; - "Logical operations (AND)", single_opcode Vand; - "Logical operations (OR)", single_opcode Vorr; - "Logical operations (exclusive OR)", single_opcode Veor; - "Logical operations (AND-NOT)", single_opcode Vbic; - "Logical operations (OR-NOT)", single_opcode Vorn; - "Reinterpret casts", single_opcode Vreinterp ] - -(* Given an intrinsic shape, produce a string to document the corresponding - operand shapes. *) -let rec analyze_shape shape = - let rec n_things n thing = - match n with - 0 -> [] - | n -> thing :: (n_things (n - 1) thing) - in - let rec analyze_shape_elt reg_no elt = - match elt with - Dreg -> "@var{d" ^ (string_of_int reg_no) ^ "}" - | Qreg -> "@var{q" ^ (string_of_int reg_no) ^ "}" - | Corereg -> "@var{r" ^ (string_of_int reg_no) ^ "}" - | Immed -> "#@var{0}" - | VecArray (1, elt) -> - let elt_regexp = analyze_shape_elt 0 elt in - "@{" ^ elt_regexp ^ "@}" - | VecArray (n, elt) -> - let rec f m = - match m with - 0 -> [] - | m -> (analyze_shape_elt (m - 1) elt) :: (f (m - 1)) - in - let ops = List.rev (f n) in - "@{" ^ (commas (fun x -> x) ops "") ^ "@}" - | (PtrTo elt | CstPtrTo elt) -> - "[" ^ (analyze_shape_elt reg_no elt) ^ "]" - | Element_of_dreg -> (analyze_shape_elt reg_no Dreg) ^ "[@var{0}]" - | Element_of_qreg -> (analyze_shape_elt reg_no Qreg) ^ "[@var{0}]" - | All_elements_of_dreg -> (analyze_shape_elt reg_no Dreg) ^ "[]" - | Alternatives alts -> (analyze_shape_elt reg_no (List.hd alts)) - in - match shape with - All (n, elt) -> commas (analyze_shape_elt 0) (n_things n elt) "" - | Long -> (analyze_shape_elt 0 Qreg) ^ ", " ^ (analyze_shape_elt 0 Dreg) ^ - ", " ^ (analyze_shape_elt 0 Dreg) - | Long_noreg elt -> (analyze_shape_elt 0 elt) ^ ", " ^ - (analyze_shape_elt 0 elt) - | Wide -> (analyze_shape_elt 0 Qreg) ^ ", " ^ (analyze_shape_elt 0 Qreg) ^ - ", " ^ (analyze_shape_elt 0 Dreg) - | Wide_noreg elt -> analyze_shape (Long_noreg elt) - | Narrow -> (analyze_shape_elt 0 Dreg) ^ ", " ^ (analyze_shape_elt 0 Qreg) ^ - ", " ^ (analyze_shape_elt 0 Qreg) - | Use_operands elts -> commas (analyze_shape_elt 0) (Array.to_list elts) "" - | By_scalar Dreg -> - analyze_shape (Use_operands [| Dreg; Dreg; Element_of_dreg |]) - | By_scalar Qreg -> - analyze_shape (Use_operands [| Qreg; Qreg; Element_of_dreg |]) - | By_scalar _ -> assert false - | Wide_lane -> - analyze_shape (Use_operands [| Qreg; Dreg; Element_of_dreg |]) - | Wide_scalar -> - analyze_shape (Use_operands [| Qreg; Dreg; Element_of_dreg |]) - | Pair_result elt -> - let elt_regexp = analyze_shape_elt 0 elt in - let elt_regexp' = analyze_shape_elt 1 elt in - elt_regexp ^ ", " ^ elt_regexp' - | Unary_scalar _ -> "FIXME Unary_scalar" - | Binary_imm elt -> analyze_shape (Use_operands [| elt; elt; Immed |]) - | Narrow_imm -> analyze_shape (Use_operands [| Dreg; Qreg; Immed |]) - | Long_imm -> analyze_shape (Use_operands [| Qreg; Dreg; Immed |]) - -(* Document a single intrinsic. *) -let describe_intrinsic first chan - (elt_ty, (_, features, shape, name, munge, _)) = - let c_arity, new_elt_ty = munge shape elt_ty in - let c_types = strings_of_arity c_arity in - Printf.fprintf chan "@itemize @bullet\n"; - let item_code = if first then "@item" else "@itemx" in - Printf.fprintf chan "%s %s %s_%s (" item_code (List.hd c_types) - (intrinsic_name name) (string_of_elt elt_ty); - Printf.fprintf chan "%s)\n" (commas (fun ty -> ty) (List.tl c_types) ""); - if not (List.exists (fun feature -> feature = No_op) features) then - begin - let print_one_insn name = - Printf.fprintf chan "@code{"; - let no_suffix = (new_elt_ty = NoElts) in - let name_with_suffix = - if no_suffix then name - else name ^ "." ^ (string_of_elt_dots new_elt_ty) - in - let possible_operands = analyze_all_shapes features shape - analyze_shape - in - let rec print_one_possible_operand op = - Printf.fprintf chan "%s %s}" name_with_suffix op - in - (* If the intrinsic expands to multiple instructions, we assume - they are all of the same form. *) - print_one_possible_operand (List.hd possible_operands) - in - let rec print_insns names = - match names with - [] -> () - | [name] -> print_one_insn name - | name::names -> (print_one_insn name; - Printf.fprintf chan " @emph{or} "; - print_insns names) - in - let insn_names = get_insn_names features name in - Printf.fprintf chan "@*@emph{Form of expected instruction(s):} "; - print_insns insn_names; - Printf.fprintf chan "\n" - end; - Printf.fprintf chan "@end itemize\n"; - Printf.fprintf chan "\n\n" - -(* Document a group of intrinsics. *) -let document_group chan (group_title, group_extractor) = - (* Extract the rows in question from the ops table and then turn them - into a list of intrinsics. *) - let intrinsics = - List.fold_left (fun got_so_far -> - fun row -> - match row with - (_, _, _, _, _, elt_tys) -> - List.fold_left (fun got_so_far' -> - fun elt_ty -> - (elt_ty, row) :: got_so_far') - got_so_far elt_tys - ) [] (group_extractor ()) - in - (* Emit the title for this group. *) - Printf.fprintf chan "@subsubsection %s\n\n" group_title; - (* Emit a description of each intrinsic. *) - List.iter (describe_intrinsic true chan) intrinsics; - (* Close this group. *) - Printf.fprintf chan "\n\n" - -let gnu_header chan = - List.iter (fun s -> Printf.fprintf chan "%s\n" s) [ - "@c Copyright (C) 2006-2014 Free Software Foundation, Inc."; - "@c This is part of the GCC manual."; - "@c For copying conditions, see the file gcc.texi."; - ""; - "@c This file is generated automatically using gcc/config/arm/neon-docgen.ml"; - "@c Please do not edit manually."] - -let crypto_doc = -" -@itemize @bullet -@item poly128_t vldrq_p128(poly128_t const *) -@end itemize - -@itemize @bullet -@item void vstrq_p128(poly128_t *, poly128_t) -@end itemize - -@itemize @bullet -@item uint64x1_t vceq_p64 (poly64x1_t, poly64x1_t) -@end itemize - -@itemize @bullet -@item uint64x1_t vtst_p64 (poly64x1_t, poly64x1_t) -@end itemize - -@itemize @bullet -@item uint32_t vsha1h_u32 (uint32_t) -@*@emph{Form of expected instruction(s):} @code{sha1h.32 @var{q0}, @var{q1}} -@end itemize - -@itemize @bullet -@item uint32x4_t vsha1cq_u32 (uint32x4_t, uint32_t, uint32x4_t) -@*@emph{Form of expected instruction(s):} @code{sha1c.32 @var{q0}, @var{q1}, @var{q2}} -@end itemize - -@itemize @bullet -@item uint32x4_t vsha1pq_u32 (uint32x4_t, uint32_t, uint32x4_t) -@*@emph{Form of expected instruction(s):} @code{sha1p.32 @var{q0}, @var{q1}, @var{q2}} -@end itemize - -@itemize @bullet -@item uint32x4_t vsha1mq_u32 (uint32x4_t, uint32_t, uint32x4_t) -@*@emph{Form of expected instruction(s):} @code{sha1m.32 @var{q0}, @var{q1}, @var{q2}} -@end itemize - -@itemize @bullet -@item uint32x4_t vsha1su0q_u32 (uint32x4_t, uint32x4_t, uint32x4_t) -@*@emph{Form of expected instruction(s):} @code{sha1su0.32 @var{q0}, @var{q1}, @var{q2}} -@end itemize - -@itemize @bullet -@item uint32x4_t vsha1su1q_u32 (uint32x4_t, uint32x4_t) -@*@emph{Form of expected instruction(s):} @code{sha1su1.32 @var{q0}, @var{q1}, @var{q2}} -@end itemize - -@itemize @bullet -@item uint32x4_t vsha256hq_u32 (uint32x4_t, uint32x4_t, uint32x4_t) -@*@emph{Form of expected instruction(s):} @code{sha256h.32 @var{q0}, @var{q1}, @var{q2}} -@end itemize - -@itemize @bullet -@item uint32x4_t vsha256h2q_u32 (uint32x4_t, uint32x4_t, uint32x4_t) -@*@emph{Form of expected instruction(s):} @code{sha256h2.32 @var{q0}, @var{q1}, @var{q2}} -@end itemize - -@itemize @bullet -@item uint32x4_t vsha256su0q_u32 (uint32x4_t, uint32x4_t) -@*@emph{Form of expected instruction(s):} @code{sha256su0.32 @var{q0}, @var{q1}} -@end itemize - -@itemize @bullet -@item uint32x4_t vsha256su1q_u32 (uint32x4_t, uint32x4_t, uint32x4_t) -@*@emph{Form of expected instruction(s):} @code{sha256su1.32 @var{q0}, @var{q1}, @var{q2}} -@end itemize - -@itemize @bullet -@item poly128_t vmull_p64 (poly64_t a, poly64_t b) -@*@emph{Form of expected instruction(s):} @code{vmull.p64 @var{q0}, @var{d1}, @var{d2}} -@end itemize - -@itemize @bullet -@item poly128_t vmull_high_p64 (poly64x2_t a, poly64x2_t b) -@*@emph{Form of expected instruction(s):} @code{vmull.p64 @var{q0}, @var{d1}, @var{d2}} -@end itemize -" - -(* Program entry point. *) -let _ = - if Array.length Sys.argv <> 2 then - failwith "Usage: neon-docgen <output filename>" - else - let file = Sys.argv.(1) in - try - let chan = open_out file in - gnu_header chan; - List.iter (document_group chan) intrinsic_groups; - Printf.fprintf chan "%s\n" crypto_doc; - close_out chan - with Sys_error sys -> - failwith ("Could not create output file " ^ file ^ ": " ^ sys) diff --git a/gcc/config/arm/neon-gen.ml b/gcc/config/arm/neon-gen.ml deleted file mode 100644 index f3dd86b0ace..00000000000 --- a/gcc/config/arm/neon-gen.ml +++ /dev/null @@ -1,520 +0,0 @@ -(* Auto-generate ARM Neon intrinsics header file. - Copyright (C) 2006-2014 Free Software Foundation, Inc. - Contributed by CodeSourcery. - - This file is part of GCC. - - GCC 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, or (at your option) any later - version. - - GCC 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. - - You should have received a copy of the GNU General Public License - along with GCC; see the file COPYING3. If not see - <http://www.gnu.org/licenses/>. - - This is an O'Caml program. The O'Caml compiler is available from: - - http://caml.inria.fr/ - - Or from your favourite OS's friendly packaging system. Tested with version - 3.09.2, though other versions will probably work too. - - Compile with: - ocamlc -c neon.ml - ocamlc -o neon-gen neon.cmo neon-gen.ml - - Run with: - ./neon-gen > arm_neon.h -*) - -open Neon - -(* The format codes used in the following functions are documented at: - http://caml.inria.fr/pub/docs/manual-ocaml/libref/Format.html\ - #6_printflikefunctionsforprettyprinting - (one line, remove the backslash.) -*) - -(* Following functions can be used to approximate GNU indentation style. *) -let start_function () = - Format.printf "@[<v 0>"; - ref 0 - -let end_function nesting = - match !nesting with - 0 -> Format.printf "@;@;@]" - | _ -> failwith ("Bad nesting (ending function at level " - ^ (string_of_int !nesting) ^ ")") - -let open_braceblock nesting = - begin match !nesting with - 0 -> Format.printf "@,@<0>{@[<v 2>@," - | _ -> Format.printf "@,@[<v 2> @<0>{@[<v 2>@," - end; - incr nesting - -let close_braceblock nesting = - decr nesting; - match !nesting with - 0 -> Format.printf "@]@,@<0>}" - | _ -> Format.printf "@]@,@<0>}@]" - -let print_function arity fnname body = - let ffmt = start_function () in - Format.printf "__extension__ static __inline "; - let inl = "__attribute__ ((__always_inline__))" in - begin match arity with - Arity0 ret -> - Format.printf "%s %s@,%s (void)" (string_of_vectype ret) inl fnname - | Arity1 (ret, arg0) -> - Format.printf "%s %s@,%s (%s __a)" (string_of_vectype ret) inl fnname - (string_of_vectype arg0) - | Arity2 (ret, arg0, arg1) -> - Format.printf "%s %s@,%s (%s __a, %s __b)" - (string_of_vectype ret) inl fnname (string_of_vectype arg0) - (string_of_vectype arg1) - | Arity3 (ret, arg0, arg1, arg2) -> - Format.printf "%s %s@,%s (%s __a, %s __b, %s __c)" - (string_of_vectype ret) inl fnname (string_of_vectype arg0) - (string_of_vectype arg1) (string_of_vectype arg2) - | Arity4 (ret, arg0, arg1, arg2, arg3) -> - Format.printf "%s %s@,%s (%s __a, %s __b, %s __c, %s __d)" - (string_of_vectype ret) inl fnname (string_of_vectype arg0) - (string_of_vectype arg1) (string_of_vectype arg2) - (string_of_vectype arg3) - end; - open_braceblock ffmt; - let rec print_lines = function - [] -> () - | "" :: lines -> print_lines lines - | [line] -> Format.printf "%s" line - | line::lines -> Format.printf "%s@," line ; print_lines lines in - print_lines body; - close_braceblock ffmt; - end_function ffmt - -let union_string num elts base = - let itype = inttype_for_array num elts in - let iname = string_of_inttype itype - and sname = string_of_vectype (T_arrayof (num, elts)) in - Printf.sprintf "union { %s __i; %s __o; } %s" sname iname base - -let rec signed_ctype = function - T_uint8x8 | T_poly8x8 -> T_int8x8 - | T_uint8x16 | T_poly8x16 -> T_int8x16 - | T_uint16x4 | T_poly16x4 -> T_int16x4 - | T_uint16x8 | T_poly16x8 -> T_int16x8 - | T_uint32x2 -> T_int32x2 - | T_uint32x4 -> T_int32x4 - | T_uint64x1 -> T_int64x1 - | T_uint64x2 -> T_int64x2 - | T_poly64x2 -> T_int64x2 - (* Cast to types defined by mode in arm.c, not random types pulled in from - the <stdint.h> header in use. This fixes incompatible pointer errors when - compiling with C++. *) - | T_uint8 | T_int8 -> T_intQI - | T_uint16 | T_int16 -> T_intHI - | T_uint32 | T_int32 -> T_intSI - | T_uint64 | T_int64 -> T_intDI - | T_float16 -> T_floatHF - | T_float32 -> T_floatSF - | T_poly8 -> T_intQI - | T_poly16 -> T_intHI - | T_poly64 -> T_intDI - | T_poly128 -> T_intTI - | T_arrayof (n, elt) -> T_arrayof (n, signed_ctype elt) - | T_ptrto elt -> T_ptrto (signed_ctype elt) - | T_const elt -> T_const (signed_ctype elt) - | x -> x - -let add_cast ctype cval = - let stype = signed_ctype ctype in - if ctype <> stype then - Printf.sprintf "(%s) %s" (string_of_vectype stype) cval - else - cval - -let cast_for_return to_ty = "(" ^ (string_of_vectype to_ty) ^ ")" - -(* Return a tuple of a list of declarations to go at the start of the function, - and a list of statements needed to return THING. *) -let return arity thing = - match arity with - Arity0 (ret) | Arity1 (ret, _) | Arity2 (ret, _, _) | Arity3 (ret, _, _, _) - | Arity4 (ret, _, _, _, _) -> - begin match ret with - T_arrayof (num, vec) -> - let uname = union_string num vec "__rv" in - [uname ^ ";"], ["__rv.__o = " ^ thing ^ ";"; "return __rv.__i;"] - | T_void -> - [], [thing ^ ";"] - | _ -> - [], ["return " ^ (cast_for_return ret) ^ thing ^ ";"] - end - -let mask_shape_for_shuffle = function - All (num, reg) -> All (num, reg) - | Pair_result reg -> All (2, reg) - | _ -> failwith "mask_for_shuffle" - -let mask_elems shuffle shape elttype part = - let elem_size = elt_width elttype in - let num_elems = - match regmap shape 0 with - Dreg -> 64 / elem_size - | Qreg -> 128 / elem_size - | _ -> failwith "mask_elems" in - shuffle elem_size num_elems part - -(* Return a tuple of a list of declarations 0and a list of statements needed - to implement an intrinsic using __builtin_shuffle. SHUFFLE is a function - which returns a list of elements suitable for using as a mask. *) - -let shuffle_fn shuffle shape arity elttype = - let mshape = mask_shape_for_shuffle shape in - let masktype = type_for_elt mshape (unsigned_of_elt elttype) 0 in - let masktype_str = string_of_vectype masktype in - let shuffle_res = type_for_elt mshape elttype 0 in - let shuffle_res_str = string_of_vectype shuffle_res in - match arity with - Arity0 (ret) | Arity1 (ret, _) | Arity2 (ret, _, _) | Arity3 (ret, _, _, _) - | Arity4 (ret, _, _, _, _) -> - begin match ret with - T_arrayof (num, vec) -> - let elems1 = mask_elems shuffle mshape elttype `lo - and elems2 = mask_elems shuffle mshape elttype `hi in - let mask1 = (String.concat ", " (List.map string_of_int elems1)) - and mask2 = (String.concat ", " (List.map string_of_int elems2)) in - let shuf1 = Printf.sprintf - "__rv.val[0] = (%s) __builtin_shuffle (__a, __b, (%s) { %s });" - shuffle_res_str masktype_str mask1 - and shuf2 = Printf.sprintf - "__rv.val[1] = (%s) __builtin_shuffle (__a, __b, (%s) { %s });" - shuffle_res_str masktype_str mask2 in - [Printf.sprintf "%s __rv;" (string_of_vectype ret);], - [shuf1; shuf2; "return __rv;"] - | _ -> - let elems = mask_elems shuffle mshape elttype `lo in - let mask = (String.concat ", " (List.map string_of_int elems)) in - let shuf = Printf.sprintf - "return (%s) __builtin_shuffle (__a, (%s) { %s });" shuffle_res_str masktype_str mask in - [""], - [shuf] - end - -let rec element_type ctype = - match ctype with - T_arrayof (_, v) -> element_type v - | _ -> ctype - -let params ps = - let pdecls = ref [] in - let ptype t p = - match t with - T_arrayof (num, elts) -> - let uname = union_string num elts (p ^ "u") in - let decl = Printf.sprintf "%s = { %s };" uname p in - pdecls := decl :: !pdecls; - p ^ "u.__o" - | _ -> add_cast t p in - let plist = match ps with - Arity0 _ -> [] - | Arity1 (_, t1) -> [ptype t1 "__a"] - | Arity2 (_, t1, t2) -> [ptype t1 "__a"; ptype t2 "__b"] - | Arity3 (_, t1, t2, t3) -> [ptype t1 "__a"; ptype t2 "__b"; ptype t3 "__c"] - | Arity4 (_, t1, t2, t3, t4) -> - [ptype t1 "__a"; ptype t2 "__b"; ptype t3 "__c"; ptype t4 "__d"] in - !pdecls, plist - -let modify_params features plist = - let is_flipped = - List.exists (function Flipped _ -> true | _ -> false) features in - if is_flipped then - match plist with - [ a; b ] -> [ b; a ] - | _ -> - failwith ("Don't know how to flip args " ^ (String.concat ", " plist)) - else - plist - -(* !!! Decide whether to add an extra information word based on the shape - form. *) -let extra_word shape features paramlist bits = - let use_word = - match shape with - All _ | Long | Long_noreg _ | Wide | Wide_noreg _ | Narrow - | By_scalar _ | Wide_scalar | Wide_lane | Binary_imm _ | Long_imm - | Narrow_imm -> true - | _ -> List.mem InfoWord features - in - if use_word then - paramlist @ [string_of_int bits] - else - paramlist - -(* Bit 0 represents signed (1) vs unsigned (0), or float (1) vs poly (0). - Bit 1 represents floats & polynomials (1), or ordinary integers (0). - Bit 2 represents rounding (1) vs none (0). *) -let infoword_value elttype features = - let bits01 = - match elt_class elttype with - Signed | ConvClass (Signed, _) | ConvClass (_, Signed) -> 0b001 - | Poly -> 0b010 - | Float -> 0b011 - | _ -> 0b000 - and rounding_bit = if List.mem Rounding features then 0b100 else 0b000 in - bits01 lor rounding_bit - -(* "Cast" type operations will throw an exception in mode_of_elt (actually in - elt_width, called from there). Deal with that here, and generate a suffix - with multiple modes (<to><from>). *) -let rec mode_suffix elttype shape = - try - let mode = mode_of_elt elttype shape in - string_of_mode mode - with MixedMode (dst, src) -> - let dstmode = mode_of_elt ~argpos:0 dst shape - and srcmode = mode_of_elt ~argpos:1 src shape in - string_of_mode dstmode ^ string_of_mode srcmode - -let get_shuffle features = - try - match List.find (function Use_shuffle _ -> true | _ -> false) features with - Use_shuffle fn -> Some fn - | _ -> None - with Not_found -> None - -let print_feature_test_start features = - try - match List.find (fun feature -> - match feature with Requires_feature _ -> true - | Requires_arch _ -> true - | Requires_FP_bit _ -> true - | _ -> false) - features with - Requires_feature feature -> - Format.printf "#ifdef __ARM_FEATURE_%s@\n" feature - | Requires_arch arch -> - Format.printf "#if __ARM_ARCH >= %d@\n" arch - | Requires_FP_bit bit -> - Format.printf "#if ((__ARM_FP & 0x%X) != 0)@\n" - (1 lsl bit) - | _ -> assert false - with Not_found -> assert true - -let print_feature_test_end features = - let feature = - List.exists (function Requires_feature _ -> true - | Requires_arch _ -> true - | Requires_FP_bit _ -> true - | _ -> false) features in - if feature then Format.printf "#endif@\n" - - -let print_variant opcode features shape name (ctype, asmtype, elttype) = - let bits = infoword_value elttype features in - let modesuf = mode_suffix elttype shape in - let pdecls, paramlist = params ctype in - let rdecls, stmts = - match get_shuffle features with - Some shuffle -> shuffle_fn shuffle shape ctype elttype - | None -> - let paramlist' = modify_params features paramlist in - let paramlist'' = extra_word shape features paramlist' bits in - let parstr = String.concat ", " paramlist'' in - let builtin = Printf.sprintf "__builtin_neon_%s%s (%s)" - (builtin_name features name) modesuf parstr in - return ctype builtin in - let body = pdecls @ rdecls @ stmts - and fnname = (intrinsic_name name) ^ "_" ^ (string_of_elt elttype) in - begin - print_feature_test_start features; - print_function ctype fnname body; - print_feature_test_end features; - end - -(* When this function processes the element types in the ops table, it rewrites - them in a list of tuples (a,b,c): - a : C type as an "arity", e.g. Arity1 (T_poly8x8, T_poly8x8) - b : Asm type : a single, processed element type, e.g. P16. This is the - type which should be attached to the asm opcode. - c : Variant type : the unprocessed type for this variant (e.g. in add - instructions which don't care about the sign, b might be i16 and c - might be s16.) -*) - -let print_op (opcode, features, shape, name, munge, types) = - let sorted_types = List.sort compare types in - let munged_types = List.map - (fun elt -> let c, asm = munge shape elt in c, asm, elt) sorted_types in - List.iter - (fun variant -> print_variant opcode features shape name variant) - munged_types - -let print_ops ops = - List.iter print_op ops - -(* Output type definitions. Table entries are: - cbase : "C" name for the type. - abase : "ARM" base name for the type (i.e. int in int8x8_t). - esize : element size. - enum : element count. - alevel: architecture level at which available. -*) - -type fpulevel = CRYPTO | ALL - -let deftypes () = - let typeinfo = [ - (* Doubleword vector types. *) - "__builtin_neon_qi", "int", 8, 8, ALL; - "__builtin_neon_hi", "int", 16, 4, ALL; - "__builtin_neon_si", "int", 32, 2, ALL; - "__builtin_neon_di", "int", 64, 1, ALL; - "__builtin_neon_hf", "float", 16, 4, ALL; - "__builtin_neon_sf", "float", 32, 2, ALL; - "__builtin_neon_poly8", "poly", 8, 8, ALL; - "__builtin_neon_poly16", "poly", 16, 4, ALL; - "__builtin_neon_poly64", "poly", 64, 1, CRYPTO; - "__builtin_neon_uqi", "uint", 8, 8, ALL; - "__builtin_neon_uhi", "uint", 16, 4, ALL; - "__builtin_neon_usi", "uint", 32, 2, ALL; - "__builtin_neon_udi", "uint", 64, 1, ALL; - - (* Quadword vector types. *) - "__builtin_neon_qi", "int", 8, 16, ALL; - "__builtin_neon_hi", "int", 16, 8, ALL; - "__builtin_neon_si", "int", 32, 4, ALL; - "__builtin_neon_di", "int", 64, 2, ALL; - "__builtin_neon_sf", "float", 32, 4, ALL; - "__builtin_neon_poly8", "poly", 8, 16, ALL; - "__builtin_neon_poly16", "poly", 16, 8, ALL; - "__builtin_neon_poly64", "poly", 64, 2, CRYPTO; - "__builtin_neon_uqi", "uint", 8, 16, ALL; - "__builtin_neon_uhi", "uint", 16, 8, ALL; - "__builtin_neon_usi", "uint", 32, 4, ALL; - "__builtin_neon_udi", "uint", 64, 2, ALL - ] in - List.iter - (fun (cbase, abase, esize, enum, fpulevel) -> - let attr = - match enum with - 1 -> "" - | _ -> Printf.sprintf "\t__attribute__ ((__vector_size__ (%d)))" - (esize * enum / 8) in - if fpulevel == CRYPTO then - Format.printf "#ifdef __ARM_FEATURE_CRYPTO\n"; - Format.printf "typedef %s %s%dx%d_t%s;@\n" cbase abase esize enum attr; - if fpulevel == CRYPTO then - Format.printf "#endif\n";) - typeinfo; - Format.print_newline (); - (* Extra types not in <stdint.h>. *) - Format.printf "typedef float float32_t;\n"; - Format.printf "typedef __builtin_neon_poly8 poly8_t;\n"; - Format.printf "typedef __builtin_neon_poly16 poly16_t;\n"; - Format.printf "#ifdef __ARM_FEATURE_CRYPTO\n"; - Format.printf "typedef __builtin_neon_poly64 poly64_t;\n"; - Format.printf "typedef __builtin_neon_poly128 poly128_t;\n"; - Format.printf "#endif\n" - -(* Output structs containing arrays, for load & store instructions etc. - poly128_t is deliberately not included here because it has no array types - defined for it. *) - -let arrtypes () = - let typeinfo = [ - "int", 8, ALL; "int", 16, ALL; - "int", 32, ALL; "int", 64, ALL; - "uint", 8, ALL; "uint", 16, ALL; - "uint", 32, ALL; "uint", 64, ALL; - "float", 32, ALL; "poly", 8, ALL; - "poly", 16, ALL; "poly", 64, CRYPTO - ] in - let writestruct elname elsize regsize arrsize fpulevel = - let elnum = regsize / elsize in - let structname = - Printf.sprintf "%s%dx%dx%d_t" elname elsize elnum arrsize in - let sfmt = start_function () in - Format.printf "%stypedef struct %s" - (if fpulevel == CRYPTO then "#ifdef __ARM_FEATURE_CRYPTO\n" else "") structname; - open_braceblock sfmt; - Format.printf "%s%dx%d_t val[%d];" elname elsize elnum arrsize; - close_braceblock sfmt; - Format.printf " %s;%s" structname (if fpulevel == CRYPTO then "\n#endif\n" else ""); - end_function sfmt; - in - for n = 2 to 4 do - List.iter - (fun (elname, elsize, alevel) -> - writestruct elname elsize 64 n alevel; - writestruct elname elsize 128 n alevel) - typeinfo - done - -let print_lines = List.iter (fun s -> Format.printf "%s@\n" s) - -(* Do it. *) - -let _ = - print_lines [ -"/* ARM NEON intrinsics include file. This file is generated automatically"; -" using neon-gen.ml. Please do not edit manually."; -""; -" Copyright (C) 2006-2014 Free Software Foundation, Inc."; -" Contributed by CodeSourcery."; -""; -" This file is part of GCC."; -""; -" GCC 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, or (at your"; -" option) any later version."; -""; -" GCC 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/>. */"; -""; -"#ifndef _GCC_ARM_NEON_H"; -"#define _GCC_ARM_NEON_H 1"; -""; -"#ifndef __ARM_NEON__"; -"#error You must enable NEON instructions (e.g. -mfloat-abi=softfp -mfpu=neon) to use arm_neon.h"; -"#else"; -""; -"#ifdef __cplusplus"; -"extern \"C\" {"; -"#endif"; -""; -"#include <stdint.h>"; -""]; - deftypes (); - arrtypes (); - Format.print_newline (); - print_ops ops; - Format.print_newline (); - print_ops reinterp; - print_ops reinterpq; - Format.printf "%s" crypto_intrinsics; - print_lines [ -"#ifdef __cplusplus"; -"}"; -"#endif"; -"#endif"; -"#endif"] diff --git a/gcc/config/i386/i386.md b/gcc/config/i386/i386.md index e6bf58f0b08..f677a7ef05a 100644 --- a/gcc/config/i386/i386.md +++ b/gcc/config/i386/i386.md @@ -9598,7 +9598,7 @@ (define_insn "x86_64_shrd" [(set (match_operand:DI 0 "nonimmediate_operand" "+r*m") - (ior:DI (ashiftrt:DI (match_dup 0) + (ior:DI (lshiftrt:DI (match_dup 0) (match_operand:QI 2 "nonmemory_operand" "Jc")) (ashift:DI (match_operand:DI 1 "register_operand" "r") (minus:QI (const_int 64) (match_dup 2))))) @@ -9614,7 +9614,7 @@ (define_insn "x86_shrd" [(set (match_operand:SI 0 "nonimmediate_operand" "+r*m") - (ior:SI (ashiftrt:SI (match_dup 0) + (ior:SI (lshiftrt:SI (match_dup 0) (match_operand:QI 2 "nonmemory_operand" "Ic")) (ashift:SI (match_operand:SI 1 "register_operand" "r") (minus:QI (const_int 32) (match_dup 2))))) @@ -10066,13 +10066,13 @@ [(set (match_dup 3) (match_dup 4)) (parallel [(set (match_dup 4) - (ior:DWIH (ashiftrt:DWIH (match_dup 4) (match_dup 2)) + (ior:DWIH (lshiftrt:DWIH (match_dup 4) (match_dup 2)) (ashift:DWIH (match_dup 5) (minus:QI (match_dup 6) (match_dup 2))))) (clobber (reg:CC FLAGS_REG))]) (parallel [(set (match_dup 5) - (ior:DWIH (ashiftrt:DWIH (match_dup 5) (match_dup 2)) + (ior:DWIH (lshiftrt:DWIH (match_dup 5) (match_dup 2)) (ashift:DWIH (match_dup 3) (minus:QI (match_dup 6) (match_dup 2))))) (clobber (reg:CC FLAGS_REG))])] diff --git a/gcc/config/rs6000/vsx.md b/gcc/config/rs6000/vsx.md index 61ed99cea41..6d20eab111b 100644 --- a/gcc/config/rs6000/vsx.md +++ b/gcc/config/rs6000/vsx.md @@ -1690,7 +1690,7 @@ { if (GET_CODE (op3) == SCRATCH) op3 = gen_reg_rtx (V4SFmode); - emit_insn (gen_vsx_xxsldwi_v4sf (op3, op1, op1, op2)); + emit_insn (gen_vsx_xxsldwi_v4sf (op3, op1, op1, GEN_INT (ele))); tmp = op3; } emit_insn (gen_vsx_xscvspdp_scalar2 (op0, tmp)); diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 6e523c859df..a41f1718e0b 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,102 @@ +2014-07-01 Paul Pluzhnikov <ppluzhnikov@google.com> + + PR c++/58753 + PR c++/58930 + PR c++/58704 + + Backported from mainline + 2014-05-20 Paolo Carlini <paolo.carlini@oracle.com> + + * typeck2.c (digest_nsdmi_init): New. + * parser.c (cp_parser_late_parse_one_default_arg): Use it. + * init.c (get_nsdmi): Likewise. + * cp-tree.h (digest_nsdmi_init): Declare. + +2014-06-30 Edward Smith-Rowland <3dw4rd@verizon.net> + + PR c++/58781 + PR c++/60249 + PR c++/59867 + * parser.c (cp_parser_userdef_string_literal()): Take a tree + not a cp_token*. (cp_parser_string_literal(): Don't hack + the token stream! + +2014-06-30 Jason Merrill <jason@redhat.com> + + PR c++/61647 + * pt.c (type_dependent_expression_p): Check BASELINK_OPTYPE. + + PR c++/61566 + * mangle.c (decl_mangling_context): Look through a TEMPLATE_DECL. + +2014-06-30 Jakub Jelinek <jakub@redhat.com> + + Backported from mainline + 2014-06-25 Jakub Jelinek <jakub@redhat.com> + + * semantics.c (finish_omp_clauses): Make sure + OMP_CLAUSE_LINEAR_STEP has correct type. + + 2014-06-18 Jakub Jelinek <jakub@redhat.com> + + * cp-gimplify.c (cxx_omp_finish_clause): Add a gimple_seq * + argument. + * cp-tree.h (cxx_omp_finish_clause): Adjust prototype. + +2014-06-30 Jason Merrill <jason@redhat.com> + + PR c++/61539 + * pt.c (unify_one_argument): Type/expression mismatch just causes + deduction failure. + + DR 1030 + PR c++/51253 + PR c++/61382 + * cp-tree.h (CALL_EXPR_LIST_INIT_P): New. + * call.c (struct z_candidate): Add flags field. + (add_candidate): Add flags parm. + (add_function_candidate, add_conv_candidate, build_builtin_candidate) + (add_template_candidate_real): Pass it. + (build_over_call): Set CALL_EXPR_LIST_INIT_P. + * tree.c (build_aggr_init_expr): Copy it. + * semantics.c (simplify_aggr_init_expr): Copy it. + * cp-gimplify.c (cp_gimplify_expr): Handle it. + + PR c++/61488 + * pt.c (check_valid_ptrmem_cst_expr): Fix for template context. + + PR c++/61500 + * tree.c (lvalue_kind): Handle MEMBER_REF and DOTSTAR_EXPR. + +2014-06-30 Igor Zamyatin <igor.zamyatin@intel.com> + + PR middle-end/57541 + * cp-array-notation.c (expand_sec_reduce_builtin): + Check that bultin argument is correct. + * call.c (build_cxx_call): Check for 0 arguments in builtin call. + +2014-06-27 Jason Merrill <jason@redhat.com> + + PR c++/61433 + * error.c (dump_template_bindings): Don't tsubst in a clone. + +2014-06-27 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/61614 + * semantics.c (finish_compound_literal): Revert r204228. + +2014-06-26 Adam Butcher <adam@jessamine.co.uk> + + PR c++/61537 + * parser.c (cp_parser_elaborated_type_specifier): Only consider template + parameter lists outside of function parameter scope. + +2014-06-25 Jason Merrill <jason@redhat.com> + + PR c++/61242 + * call.c (build_aggr_conv): Ignore passed in flags. + (build_array_conv, build_complex_conv): Likewise. + 2014-06-24 Jakub Jelinek <jakub@redhat.com> * parser.c (cp_parser_omp_for_loop): For diff --git a/gcc/cp/call.c b/gcc/cp/call.c index ae955ef3bfd..eea6a5db409 100644 --- a/gcc/cp/call.c +++ b/gcc/cp/call.c @@ -206,7 +206,7 @@ static conversion *maybe_handle_ref_bind (conversion **); static void maybe_handle_implicit_object (conversion **); static struct z_candidate *add_candidate (struct z_candidate **, tree, tree, const vec<tree, va_gc> *, size_t, - conversion **, tree, tree, int, struct rejection_reason *); + conversion **, tree, tree, int, struct rejection_reason *, int); static tree source_type (conversion *); static void add_warning (struct z_candidate *, struct z_candidate *); static bool reference_compatible_p (tree, tree); @@ -520,7 +520,6 @@ struct z_candidate { sequence from the type returned by FN to the desired destination type. */ conversion *second_conv; - int viable; struct rejection_reason *reason; /* If FN is a member function, the binfo indicating the path used to qualify the name of FN at the call site. This path is used to @@ -538,6 +537,10 @@ struct z_candidate { tree explicit_targs; candidate_warning *warnings; z_candidate *next; + int viable; + + /* The flags active in add_candidate. */ + int flags; }; /* Returns true iff T is a null pointer constant in the sense of @@ -886,7 +889,9 @@ build_aggr_conv (tree type, tree ctor, int flags, tsubst_flags_t complain) if (ctor == error_mark_node) return NULL; - flags |= LOOKUP_NO_NARROWING; + /* The conversions within the init-list aren't affected by the enclosing + context; they're always simple copy-initialization. */ + flags = LOOKUP_IMPLICIT|LOOKUP_NO_NARROWING; for (; field; field = next_initializable_field (DECL_CHAIN (field))) { @@ -959,6 +964,8 @@ build_array_conv (tree type, tree ctor, int flags, tsubst_flags_t complain) return NULL; } + flags = LOOKUP_IMPLICIT|LOOKUP_NO_NARROWING; + FOR_EACH_CONSTRUCTOR_VALUE (CONSTRUCTOR_ELTS (ctor), i, val) { conversion *sub @@ -1003,6 +1010,8 @@ build_complex_conv (tree type, tree ctor, int flags, if (len != 2) return NULL; + flags = LOOKUP_IMPLICIT|LOOKUP_NO_NARROWING; + FOR_EACH_CONSTRUCTOR_VALUE (CONSTRUCTOR_ELTS (ctor), i, val) { conversion *sub @@ -1810,7 +1819,8 @@ add_candidate (struct z_candidate **candidates, tree fn, tree first_arg, const vec<tree, va_gc> *args, size_t num_convs, conversion **convs, tree access_path, tree conversion_path, - int viable, struct rejection_reason *reason) + int viable, struct rejection_reason *reason, + int flags) { struct z_candidate *cand = (struct z_candidate *) conversion_obstack_alloc (sizeof (struct z_candidate)); @@ -1825,6 +1835,7 @@ add_candidate (struct z_candidate **candidates, cand->viable = viable; cand->reason = reason; cand->next = *candidates; + cand->flags = flags; *candidates = cand; return cand; @@ -2064,7 +2075,7 @@ add_function_candidate (struct z_candidate **candidates, out: return add_candidate (candidates, fn, orig_first_arg, args, len, convs, - access_path, conversion_path, viable, reason); + access_path, conversion_path, viable, reason, flags); } /* Create an overload candidate for the conversion function FN which will @@ -2166,7 +2177,7 @@ add_conv_candidate (struct z_candidate **candidates, tree fn, tree obj, } return add_candidate (candidates, totype, first_arg, arglist, len, convs, - access_path, conversion_path, viable, reason); + access_path, conversion_path, viable, reason, flags); } static void @@ -2241,7 +2252,7 @@ build_builtin_candidate (struct z_candidate **candidates, tree fnname, num_convs, convs, /*access_path=*/NULL_TREE, /*conversion_path=*/NULL_TREE, - viable, reason); + viable, reason, flags); } static bool @@ -3059,7 +3070,7 @@ add_template_candidate_real (struct z_candidate **candidates, tree tmpl, return cand; fail: return add_candidate (candidates, tmpl, first_arg, arglist, nargs, NULL, - access_path, conversion_path, 0, reason); + access_path, conversion_path, 0, reason, flags); } @@ -7231,7 +7242,11 @@ build_over_call (struct z_candidate *cand, int flags, tsubst_flags_t complain) return error_mark_node; } - return build_cxx_call (fn, nargs, argarray, complain|decltype_flag); + tree call = build_cxx_call (fn, nargs, argarray, complain|decltype_flag); + if (TREE_CODE (call) == CALL_EXPR + && (cand->flags & LOOKUP_LIST_INIT_CTOR)) + CALL_EXPR_LIST_INIT_P (call) = true; + return call; } /* Build and return a call to FN, using NARGS arguments in ARGARRAY. @@ -7273,6 +7288,11 @@ build_cxx_call (tree fn, int nargs, tree *argarray, || bif == BUILT_IN_CILKPLUS_SEC_REDUCE || bif == BUILT_IN_CILKPLUS_SEC_REDUCE_MUTATING) { + if (call_expr_nargs (fn) == 0) + { + error_at (EXPR_LOCATION (fn), "Invalid builtin arguments"); + return error_mark_node; + } /* for bif == BUILT_IN_CILKPLUS_SEC_REDUCE_ALL_ZERO or BUILT_IN_CILKPLUS_SEC_REDUCE_ANY_ZERO or BUILT_IN_CILKPLUS_SEC_REDUCE_ANY_NONZERO or diff --git a/gcc/cp/cp-array-notation.c b/gcc/cp/cp-array-notation.c index 71312db80bf..fed60c95352 100644 --- a/gcc/cp/cp-array-notation.c +++ b/gcc/cp/cp-array-notation.c @@ -250,7 +250,10 @@ expand_sec_reduce_builtin (tree an_builtin_fn, tree *new_var) if (!find_rank (location, an_builtin_fn, an_builtin_fn, true, &rank)) return error_mark_node; if (rank == 0) - return an_builtin_fn; + { + error_at (location, "Invalid builtin arguments"); + return error_mark_node; + } else if (rank > 1 && (an_type == BUILT_IN_CILKPLUS_SEC_REDUCE_MAX_IND || an_type == BUILT_IN_CILKPLUS_SEC_REDUCE_MIN_IND)) diff --git a/gcc/cp/cp-gimplify.c b/gcc/cp/cp-gimplify.c index ef4b04372bc..3dc32e6cfe7 100644 --- a/gcc/cp/cp-gimplify.c +++ b/gcc/cp/cp-gimplify.c @@ -723,6 +723,27 @@ cp_gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p) && !seen_error ()) return (enum gimplify_status) gimplify_cilk_spawn (expr_p); + /* DR 1030 says that we need to evaluate the elements of an + initializer-list in forward order even when it's used as arguments to + a constructor. So if the target wants to evaluate them in reverse + order and there's more than one argument other than 'this', gimplify + them in order. */ + ret = GS_OK; + if (PUSH_ARGS_REVERSED && CALL_EXPR_LIST_INIT_P (*expr_p) + && call_expr_nargs (*expr_p) > 2) + { + int nargs = call_expr_nargs (*expr_p); + location_t loc = EXPR_LOC_OR_LOC (*expr_p, input_location); + for (int i = 1; i < nargs; ++i) + { + enum gimplify_status t + = gimplify_arg (&CALL_EXPR_ARG (*expr_p, i), pre_p, loc); + if (t == GS_ERROR) + ret = GS_ERROR; + } + } + break; + default: ret = (enum gimplify_status) c_gimplify_expr (expr_p, pre_p, post_p); break; @@ -1578,7 +1599,7 @@ cxx_omp_predetermined_sharing (tree decl) /* Finalize an implicitly determined clause. */ void -cxx_omp_finish_clause (tree c) +cxx_omp_finish_clause (tree c, gimple_seq *) { tree decl, inner_type; bool make_shared = false; diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h index e9fe86ee4cd..26a63d0b270 100644 --- a/gcc/cp/cp-tree.h +++ b/gcc/cp/cp-tree.h @@ -101,12 +101,14 @@ c-common.h, not after. FNDECL_USED_AUTO (in FUNCTION_DECL) DECLTYPE_FOR_LAMBDA_PROXY (in DECLTYPE_TYPE) REF_PARENTHESIZED_P (in COMPONENT_REF, SCOPE_REF) + AGGR_INIT_ZERO_FIRST (in AGGR_INIT_EXPR) 3: (TREE_REFERENCE_EXPR) (in NON_LVALUE_EXPR) (commented-out). ICS_BAD_FLAG (in _CONV) FN_TRY_BLOCK_P (in TRY_BLOCK) IDENTIFIER_CTOR_OR_DTOR_P (in IDENTIFIER_NODE) BIND_EXPR_BODY_BLOCK (in BIND_EXPR) DECL_NON_TRIVIALLY_INITIALIZED_P (in VAR_DECL) + CALL_EXPR_LIST_INIT_P (in CALL_EXPR, AGGR_INIT_EXPR) 4: TREE_HAS_CONSTRUCTOR (in INDIRECT_REF, SAVE_EXPR, CONSTRUCTOR, or FIELD_DECL). IDENTIFIER_TYPENAME_P (in IDENTIFIER_NODE) @@ -3026,6 +3028,10 @@ extern void decl_shadowed_for_var_insert (tree, tree); should be performed at instantiation time. */ #define KOENIG_LOOKUP_P(NODE) TREE_LANG_FLAG_0 (CALL_EXPR_CHECK (NODE)) +/* True if CALL_EXPR expresses list-initialization of an object. */ +#define CALL_EXPR_LIST_INIT_P(NODE) \ + TREE_LANG_FLAG_3 (TREE_CHECK2 ((NODE),CALL_EXPR,AGGR_INIT_EXPR)) + /* Indicates whether a string literal has been parenthesized. Such usages are disallowed in certain circumstances. */ @@ -3430,6 +3436,9 @@ more_aggr_init_expr_args_p (const aggr_init_expr_arg_iterator *iter) B b{1,2}, not B b({1,2}) or B b = {1,2}. */ #define CONSTRUCTOR_IS_DIRECT_INIT(NODE) (TREE_LANG_FLAG_0 (CONSTRUCTOR_CHECK (NODE))) +#define DIRECT_LIST_INIT_P(NODE) \ + (BRACE_ENCLOSED_INITIALIZER_P (NODE) && CONSTRUCTOR_IS_DIRECT_INIT (NODE)) + /* True if NODE represents a conversion for direct-initialization in a template. Set by perform_implicit_conversion_flags. */ #define IMPLICIT_CONV_EXPR_DIRECT_INIT(NODE) \ @@ -4347,6 +4356,11 @@ extern int function_depth; PARM_DECLs in cp_tree_equal. */ extern int comparing_specializations; +/* A type-qualifier, or bitmask therefore, using the TYPE_QUAL + constants. */ + +typedef int cp_cv_quals; + /* In parser.c. */ /* Nonzero if we are parsing an unevaluated operand: an operand to @@ -4356,6 +4370,7 @@ extern int comparing_specializations; extern int cp_unevaluated_operand; extern tree cp_convert_range_for (tree, tree, tree, bool); extern bool parsing_nsdmi (void); +extern void inject_this_parameter (tree, cp_cv_quals); /* in pt.c */ @@ -4735,11 +4750,6 @@ extern GTY(()) operator_name_info_t operator_name_info extern GTY(()) operator_name_info_t assignment_operator_name_info [(int) MAX_TREE_CODES]; -/* A type-qualifier, or bitmask therefore, using the TYPE_QUAL - constants. */ - -typedef int cp_cv_quals; - /* Non-static member functions have an optional virt-specifier-seq. There is a VIRT_SPEC value for each virt-specifier. They can be combined by bitwise-or to form the complete set of @@ -5415,6 +5425,7 @@ extern tree get_type_value (tree); extern tree build_zero_init (tree, tree, bool); extern tree build_value_init (tree, tsubst_flags_t); extern tree build_value_init_noctor (tree, tsubst_flags_t); +extern tree get_nsdmi (tree, bool); extern tree build_offset_ref (tree, tree, bool, tsubst_flags_t); extern tree throw_bad_array_new_length (void); @@ -6151,6 +6162,7 @@ extern tree store_init_value (tree, tree, vec<tree, va_gc>**, int); extern void check_narrowing (tree, tree); extern tree digest_init (tree, tree, tsubst_flags_t); extern tree digest_init_flags (tree, tree, int); +extern tree digest_nsdmi_init (tree, tree); extern tree build_scoped_ref (tree, tree, tree *); extern tree build_x_arrow (location_t, tree, tsubst_flags_t); @@ -6201,7 +6213,7 @@ extern tree cxx_omp_clause_default_ctor (tree, tree, tree); extern tree cxx_omp_clause_copy_ctor (tree, tree, tree); extern tree cxx_omp_clause_assign_op (tree, tree, tree); extern tree cxx_omp_clause_dtor (tree, tree); -extern void cxx_omp_finish_clause (tree); +extern void cxx_omp_finish_clause (tree, gimple_seq *); extern bool cxx_omp_privatize_by_reference (const_tree); /* in name-lookup.c */ diff --git a/gcc/cp/error.c b/gcc/cp/error.c index 699d5458a40..87ca4e2a306 100644 --- a/gcc/cp/error.c +++ b/gcc/cp/error.c @@ -318,6 +318,11 @@ dump_template_bindings (cxx_pretty_printer *pp, tree parms, tree args, if (vec_safe_is_empty (typenames) || uses_template_parms (args)) return; + /* Don't try to print typenames when we're processing a clone. */ + if (current_function_decl + && !DECL_LANG_SPECIFIC (current_function_decl)) + return; + FOR_EACH_VEC_SAFE_ELT (typenames, i, t) { if (need_semicolon) diff --git a/gcc/cp/init.c b/gcc/cp/init.c index 0fd165ca4bb..960c39c140f 100644 --- a/gcc/cp/init.c +++ b/gcc/cp/init.c @@ -522,6 +522,49 @@ perform_target_ctor (tree init) } } +/* Return the non-static data initializer for FIELD_DECL MEMBER. */ + +tree +get_nsdmi (tree member, bool in_ctor) +{ + tree init; + tree save_ccp = current_class_ptr; + tree save_ccr = current_class_ref; + if (!in_ctor) + inject_this_parameter (DECL_CONTEXT (member), TYPE_UNQUALIFIED); + if (DECL_LANG_SPECIFIC (member) && DECL_TEMPLATE_INFO (member)) + { + /* Do deferred instantiation of the NSDMI. */ + init = (tsubst_copy_and_build + (DECL_INITIAL (DECL_TI_TEMPLATE (member)), + DECL_TI_ARGS (member), + tf_warning_or_error, member, /*function_p=*/false, + /*integral_constant_expression_p=*/false)); + + init = digest_nsdmi_init (member, init); + } + else + { + init = DECL_INITIAL (member); + if (init && TREE_CODE (init) == DEFAULT_ARG) + { + error ("constructor required before non-static data member " + "for %qD has been parsed", member); + DECL_INITIAL (member) = error_mark_node; + init = NULL_TREE; + } + /* Strip redundant TARGET_EXPR so we don't need to remap it, and + so the aggregate init code below will see a CONSTRUCTOR. */ + if (init && TREE_CODE (init) == TARGET_EXPR + && !VOID_TYPE_P (TREE_TYPE (TARGET_EXPR_INITIAL (init)))) + init = TARGET_EXPR_INITIAL (init); + init = break_out_target_exprs (init); + } + current_class_ptr = save_ccp; + current_class_ref = save_ccr; + return init; +} + /* Initialize MEMBER, a FIELD_DECL, with INIT, a TREE_LIST of arguments. If TREE_LIST is void_type_node, an empty initializer list was given; if NULL_TREE no initializer was given. */ @@ -535,31 +578,7 @@ perform_member_init (tree member, tree init) /* Use the non-static data member initializer if there was no mem-initializer for this field. */ if (init == NULL_TREE) - { - if (DECL_LANG_SPECIFIC (member) && DECL_TEMPLATE_INFO (member)) - /* Do deferred instantiation of the NSDMI. */ - init = (tsubst_copy_and_build - (DECL_INITIAL (DECL_TI_TEMPLATE (member)), - DECL_TI_ARGS (member), - tf_warning_or_error, member, /*function_p=*/false, - /*integral_constant_expression_p=*/false)); - else - { - init = DECL_INITIAL (member); - if (init && TREE_CODE (init) == DEFAULT_ARG) - { - error ("constructor required before non-static data member " - "for %qD has been parsed", member); - init = NULL_TREE; - } - /* Strip redundant TARGET_EXPR so we don't need to remap it, and - so the aggregate init code below will see a CONSTRUCTOR. */ - if (init && TREE_CODE (init) == TARGET_EXPR - && !VOID_TYPE_P (TREE_TYPE (TARGET_EXPR_INITIAL (init)))) - init = TARGET_EXPR_INITIAL (init); - init = break_out_target_exprs (init); - } - } + init = get_nsdmi (member, /*ctor*/true); if (init == error_mark_node) return; diff --git a/gcc/cp/mangle.c b/gcc/cp/mangle.c index da82dd6acda..c8f57d3912c 100644 --- a/gcc/cp/mangle.c +++ b/gcc/cp/mangle.c @@ -752,6 +752,10 @@ decl_mangling_context (tree decl) if (tcontext != NULL_TREE) return tcontext; + if (TREE_CODE (decl) == TEMPLATE_DECL + && DECL_TEMPLATE_RESULT (decl)) + decl = DECL_TEMPLATE_RESULT (decl); + if (TREE_CODE (decl) == TYPE_DECL && LAMBDA_TYPE_P (TREE_TYPE (decl))) { diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c index 30c924db910..054f1603784 100644 --- a/gcc/cp/parser.c +++ b/gcc/cp/parser.c @@ -1891,7 +1891,7 @@ static tree cp_parser_string_literal static tree cp_parser_userdef_char_literal (cp_parser *); static tree cp_parser_userdef_string_literal - (cp_token *); + (tree); static tree cp_parser_userdef_numeric_literal (cp_parser *); @@ -3696,8 +3696,7 @@ cp_parser_string_literal (cp_parser *parser, bool translate, bool wide_ok) { tree literal = build_userdef_literal (suffix_id, value, OT_NONE, NULL_TREE); - tok->u.value = literal; - return cp_parser_userdef_string_literal (tok); + value = cp_parser_userdef_string_literal (literal); } } else @@ -3945,9 +3944,8 @@ cp_parser_userdef_numeric_literal (cp_parser *parser) as arguments. */ static tree -cp_parser_userdef_string_literal (cp_token *token) +cp_parser_userdef_string_literal (tree literal) { - tree literal = token->u.value; tree suffix_id = USERDEF_LITERAL_SUFFIX_ID (literal); tree name = cp_literal_operator_id (IDENTIFIER_POINTER (suffix_id)); tree value = USERDEF_LITERAL_VALUE (literal); @@ -15049,6 +15047,18 @@ cp_parser_elaborated_type_specifier (cp_parser* parser, return cp_parser_make_typename_type (parser, parser->scope, identifier, token->location); + + /* Template parameter lists apply only if we are not within a + function parameter list. */ + bool template_parm_lists_apply + = parser->num_template_parameter_lists; + if (template_parm_lists_apply) + for (cp_binding_level *s = current_binding_level; + s && s->kind != sk_template_parms; + s = s->level_chain) + if (s->kind == sk_function_parms) + template_parm_lists_apply = false; + /* Look up a qualified name in the usual way. */ if (parser->scope) { @@ -15091,7 +15101,7 @@ cp_parser_elaborated_type_specifier (cp_parser* parser, decl = (cp_parser_maybe_treat_template_as_class (decl, /*tag_name_p=*/is_friend - && parser->num_template_parameter_lists)); + && template_parm_lists_apply)); if (TREE_CODE (decl) != TYPE_DECL) { @@ -15104,9 +15114,9 @@ cp_parser_elaborated_type_specifier (cp_parser* parser, if (TREE_CODE (TREE_TYPE (decl)) != TYPENAME_TYPE) { - bool allow_template = (parser->num_template_parameter_lists - || DECL_SELF_REFERENCE_P (decl)); - type = check_elaborated_type_specifier (tag_type, decl, + bool allow_template = (template_parm_lists_apply + || DECL_SELF_REFERENCE_P (decl)); + type = check_elaborated_type_specifier (tag_type, decl, allow_template); if (type == error_mark_node) @@ -15192,15 +15202,16 @@ cp_parser_elaborated_type_specifier (cp_parser* parser, ts = ts_global; template_p = - (parser->num_template_parameter_lists + (template_parm_lists_apply && (cp_parser_next_token_starts_class_definition_p (parser) || cp_lexer_next_token_is (parser->lexer, CPP_SEMICOLON))); /* An unqualified name was used to reference this type, so there were no qualifying templates. */ - if (!cp_parser_check_template_parameters (parser, - /*num_templates=*/0, - token->location, - /*declarator=*/NULL)) + if (template_parm_lists_apply + && !cp_parser_check_template_parameters (parser, + /*num_templates=*/0, + token->location, + /*declarator=*/NULL)) return error_mark_node; type = xref_tag (tag_type, identifier, ts, template_p); } @@ -17841,7 +17852,7 @@ cp_parser_virt_specifier_seq_opt (cp_parser* parser) /* Used by handling of trailing-return-types and NSDMI, in which 'this' is in scope even though it isn't real. */ -static void +void inject_this_parameter (tree ctype, cp_cv_quals quals) { tree this_parm; @@ -23094,10 +23105,17 @@ cp_parser_template_declaration_after_export (cp_parser* parser, bool member_p) ok = false; } if (!ok) - error ("literal operator template %qD has invalid parameter list." - " Expected non-type template argument pack <char...>" - " or <typename CharT, CharT...>", - decl); + { + if (cxx_dialect >= cxx1y) + error ("literal operator template %qD has invalid parameter list." + " Expected non-type template argument pack <char...>" + " or <typename CharT, CharT...>", + decl); + else + error ("literal operator template %qD has invalid parameter list." + " Expected non-type template argument pack <char...>", + decl); + } } /* Register member declarations. */ if (member_p && !friend_p && decl && !DECL_CLASS_TEMPLATE_P (decl)) @@ -23668,16 +23686,7 @@ cp_parser_late_parse_one_default_arg (cp_parser *parser, tree decl, parsed_arg = check_default_argument (parmtype, parsed_arg, tf_warning_or_error); else - { - int flags = LOOKUP_IMPLICIT; - if (BRACE_ENCLOSED_INITIALIZER_P (parsed_arg) - && CONSTRUCTOR_IS_DIRECT_INIT (parsed_arg)) - flags = LOOKUP_NORMAL; - parsed_arg = digest_init_flags (TREE_TYPE (decl), parsed_arg, flags); - if (TREE_CODE (parsed_arg) == TARGET_EXPR) - /* This represents the whole initialization. */ - TARGET_EXPR_DIRECT_INIT_P (parsed_arg) = true; - } + parsed_arg = digest_nsdmi_init (decl, parsed_arg); } /* If the token stream has not been completely used up, then diff --git a/gcc/cp/pt.c b/gcc/cp/pt.c index b20a79d3614..05ae382e093 100644 --- a/gcc/cp/pt.c +++ b/gcc/cp/pt.c @@ -5346,6 +5346,10 @@ check_valid_ptrmem_cst_expr (tree type, tree expr, return true; if (cxx_dialect >= cxx11 && null_member_pointer_value_p (expr)) return true; + if (processing_template_decl + && TREE_CODE (expr) == ADDR_EXPR + && TREE_CODE (TREE_OPERAND (expr, 0)) == OFFSET_REF) + return true; if (complain & tf_error) { error ("%qE is not a valid template argument for type %qT", @@ -16361,8 +16365,9 @@ unify_one_argument (tree tparms, tree targs, tree parm, tree arg, maybe_adjust_types_for_deduction (strict, &parm, &arg, arg_expr); } else - gcc_assert ((TYPE_P (parm) || TREE_CODE (parm) == TEMPLATE_DECL) - == (TYPE_P (arg) || TREE_CODE (arg) == TEMPLATE_DECL)); + if ((TYPE_P (parm) || TREE_CODE (parm) == TEMPLATE_DECL) + != (TYPE_P (arg) || TREE_CODE (arg) == TEMPLATE_DECL)) + return unify_template_argument_mismatch (explain_p, parm, arg); /* For deduction from an init-list we need the actual list. */ if (arg_expr && BRACE_ENCLOSED_INITIALIZER_P (arg_expr)) @@ -20946,7 +20951,12 @@ type_dependent_expression_p (tree expression) return true; if (BASELINK_P (expression)) - expression = BASELINK_FUNCTIONS (expression); + { + if (BASELINK_OPTYPE (expression) + && dependent_type_p (BASELINK_OPTYPE (expression))) + return true; + expression = BASELINK_FUNCTIONS (expression); + } if (TREE_CODE (expression) == TEMPLATE_ID_EXPR) { diff --git a/gcc/cp/semantics.c b/gcc/cp/semantics.c index 3619e271df0..292d9fd6302 100644 --- a/gcc/cp/semantics.c +++ b/gcc/cp/semantics.c @@ -2600,7 +2600,6 @@ finish_compound_literal (tree type, tree compound_literal, if ((!at_function_scope_p () || CP_TYPE_CONST_P (type)) && TREE_CODE (type) == ARRAY_TYPE && !TYPE_HAS_NONTRIVIAL_DESTRUCTOR (type) - && !cp_unevaluated_operand && initializer_constant_valid_p (compound_literal, type)) { tree decl = create_temporary_var (type); @@ -3867,6 +3866,7 @@ simplify_aggr_init_expr (tree *tp) aggr_init_expr_nargs (aggr_init_expr), AGGR_INIT_EXPR_ARGP (aggr_init_expr)); TREE_NOTHROW (call_expr) = TREE_NOTHROW (aggr_init_expr); + CALL_EXPR_LIST_INIT_P (call_expr) = CALL_EXPR_LIST_INIT_P (aggr_init_expr); if (style == ctor) { @@ -5283,6 +5283,8 @@ finish_omp_clauses (tree clauses) break; } } + else + t = fold_convert (TREE_TYPE (OMP_CLAUSE_DECL (c)), t); } OMP_CLAUSE_LINEAR_STEP (c) = t; } diff --git a/gcc/cp/tree.c b/gcc/cp/tree.c index 3429d2396f2..622ba99f77a 100644 --- a/gcc/cp/tree.c +++ b/gcc/cp/tree.c @@ -101,6 +101,16 @@ lvalue_kind (const_tree ref) case IMAGPART_EXPR: return lvalue_kind (TREE_OPERAND (ref, 0)); + case MEMBER_REF: + case DOTSTAR_EXPR: + if (TREE_CODE (ref) == MEMBER_REF) + op1_lvalue_kind = clk_ordinary; + else + op1_lvalue_kind = lvalue_kind (TREE_OPERAND (ref, 0)); + if (TYPE_PTRMEMFUNC_P (TREE_TYPE (TREE_OPERAND (ref, 1)))) + op1_lvalue_kind = clk_none; + return op1_lvalue_kind; + case COMPONENT_REF: op1_lvalue_kind = lvalue_kind (TREE_OPERAND (ref, 0)); /* Look at the member designator. */ @@ -453,6 +463,7 @@ build_aggr_init_expr (tree type, tree init) TREE_SIDE_EFFECTS (rval) = 1; AGGR_INIT_VIA_CTOR_P (rval) = is_ctor; TREE_NOTHROW (rval) = TREE_NOTHROW (init); + CALL_EXPR_LIST_INIT_P (rval) = CALL_EXPR_LIST_INIT_P (init); } else rval = init; diff --git a/gcc/cp/typeck2.c b/gcc/cp/typeck2.c index 85696f6e097..0bdad2a51f0 100644 --- a/gcc/cp/typeck2.c +++ b/gcc/cp/typeck2.c @@ -1097,6 +1097,22 @@ digest_init_flags (tree type, tree init, int flags) { return digest_init_r (type, init, false, flags, tf_warning_or_error); } + +/* Process the initializer INIT for an NSDMI DECL (a FIELD_DECL). */ +tree +digest_nsdmi_init (tree decl, tree init) +{ + gcc_assert (TREE_CODE (decl) == FIELD_DECL); + + int flags = LOOKUP_IMPLICIT; + if (DIRECT_LIST_INIT_P (init)) + flags = LOOKUP_NORMAL; + init = digest_init_flags (TREE_TYPE (decl), init, flags); + if (TREE_CODE (init) == TARGET_EXPR) + /* This represents the whole initialization. */ + TARGET_EXPR_DIRECT_INIT_P (init) = true; + return init; +} /* Set of flags used within process_init_constructor to describe the initializers. */ diff --git a/gcc/doc/arm-neon-intrinsics.texi b/gcc/doc/arm-neon-intrinsics.texi index 67f84e096a7..56987e4a686 100644 --- a/gcc/doc/arm-neon-intrinsics.texi +++ b/gcc/doc/arm-neon-intrinsics.texi @@ -2,8 +2,6 @@ @c This is part of the GCC manual. @c For copying conditions, see the file gcc.texi. -@c This file is generated automatically using gcc/config/arm/neon-docgen.ml -@c Please do not edit manually. @subsubsection Addition @itemize @bullet diff --git a/gcc/doc/install.texi b/gcc/doc/install.texi index 6b45e9d0d42..7de5291a432 100644 --- a/gcc/doc/install.texi +++ b/gcc/doc/install.texi @@ -3764,9 +3764,9 @@ removed and the system libunwind library will always be used. @end html @anchor{aarch64-x-x} @heading aarch64*-*-* -Pre 2.24 binutils does not have support for selecting -mabi and does not -support ILP32. If GCC 4.9 or later is built with pre 2.24, GCC will not -support option -mabi=ilp32. +Binutils pre 2.24 does not have support for selecting @option{-mabi} and +does not support ILP32. If it is used to build GCC 4.9 or later, GCC will +not support option @option{-mabi=ilp32}. @html <hr /> diff --git a/gcc/expmed.c b/gcc/expmed.c index 7c1c979f774..6e9975df307 100644 --- a/gcc/expmed.c +++ b/gcc/expmed.c @@ -2141,9 +2141,12 @@ expand_shift_1 (enum tree_code code, enum machine_mode mode, rtx shifted, optab lrotate_optab = rotl_optab; optab rrotate_optab = rotr_optab; enum machine_mode op1_mode; + enum machine_mode scalar_mode = mode; int attempt; bool speed = optimize_insn_for_speed_p (); + if (VECTOR_MODE_P (mode)) + scalar_mode = GET_MODE_INNER (mode); op1 = amount; op1_mode = GET_MODE (op1); @@ -2166,9 +2169,9 @@ expand_shift_1 (enum tree_code code, enum machine_mode mode, rtx shifted, { if (CONST_INT_P (op1) && ((unsigned HOST_WIDE_INT) INTVAL (op1) >= - (unsigned HOST_WIDE_INT) GET_MODE_BITSIZE (mode))) + (unsigned HOST_WIDE_INT) GET_MODE_BITSIZE (scalar_mode))) op1 = GEN_INT ((unsigned HOST_WIDE_INT) INTVAL (op1) - % GET_MODE_BITSIZE (mode)); + % GET_MODE_BITSIZE (scalar_mode)); else if (GET_CODE (op1) == SUBREG && subreg_lowpart_p (op1) && SCALAR_INT_MODE_P (GET_MODE (SUBREG_REG (op1))) @@ -2182,10 +2185,10 @@ expand_shift_1 (enum tree_code code, enum machine_mode mode, rtx shifted, amount instead. */ if (rotate && CONST_INT_P (op1) - && IN_RANGE (INTVAL (op1), GET_MODE_BITSIZE (mode) / 2 + left, - GET_MODE_BITSIZE (mode) - 1)) + && IN_RANGE (INTVAL (op1), GET_MODE_BITSIZE (scalar_mode) / 2 + left, + GET_MODE_BITSIZE (scalar_mode) - 1)) { - op1 = GEN_INT (GET_MODE_BITSIZE (mode) - INTVAL (op1)); + op1 = GEN_INT (GET_MODE_BITSIZE (scalar_mode) - INTVAL (op1)); left = !left; code = left ? LROTATE_EXPR : RROTATE_EXPR; } @@ -2198,7 +2201,7 @@ expand_shift_1 (enum tree_code code, enum machine_mode mode, rtx shifted, if (code == LSHIFT_EXPR && CONST_INT_P (op1) && INTVAL (op1) > 0 - && INTVAL (op1) < GET_MODE_PRECISION (mode) + && INTVAL (op1) < GET_MODE_PRECISION (scalar_mode) && INTVAL (op1) < MAX_BITS_PER_WORD && (shift_cost (speed, mode, INTVAL (op1)) > INTVAL (op1) * add_cost (speed, mode)) @@ -2253,14 +2256,14 @@ expand_shift_1 (enum tree_code code, enum machine_mode mode, rtx shifted, if (op1 == const0_rtx) return shifted; else if (CONST_INT_P (op1)) - other_amount = GEN_INT (GET_MODE_BITSIZE (mode) + other_amount = GEN_INT (GET_MODE_BITSIZE (scalar_mode) - INTVAL (op1)); else { other_amount = simplify_gen_unary (NEG, GET_MODE (op1), op1, GET_MODE (op1)); - HOST_WIDE_INT mask = GET_MODE_PRECISION (mode) - 1; + HOST_WIDE_INT mask = GET_MODE_PRECISION (scalar_mode) - 1; other_amount = simplify_gen_binary (AND, GET_MODE (op1), other_amount, gen_int_mode (mask, GET_MODE (op1))); diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ff08edc3cbf..b96c61224d7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,567 @@ +2014-07-07 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/61459 + PR fortran/58883 + * trans-expr.c (fcncall_realloc_result): Use the natural type + for the address expression of 'res_desc'. + +2014-07-07 Dominique d'Humieres <dominiq@lps.ens.fr> + Mikael Morin <mikael@gcc.gnu.org> + + PR fortran/41936 + * trans-expr.c (gfc_conv_expr_reference): Deallocate array + components. + +2014-07-02 Jakub Jelinek <jakub@redhat.com> + Fritz Reese <Reese-Fritz@zai.com> + + * decl.c (variable_decl): Reject old style initialization + for derived type components. + +2014-06-30 Jakub Jelinek <jakub@redhat.com> + + * module.c (MOD_VERSION): Revert back to 12. + (MOD_VERSION_OMP4): Define. + (module_omp4): New variable. + (mio_symbol): Call mio_omp_declare_simd only if module_omp4. + (read_module): Load omp udrs only if module_omp4. + (write_module): Write omp udrs only if module_omp4. + (find_omp_declare_simd): New function. + (gfc_dump_module): Compute module_omp4. Use MOD_VERSION_OMP4 + if module_omp4. + (gfc_use_module): Handle MOD_VERSION_OMP4, set module_omp4. + + Backported from mainline + 2014-06-25 Jakub Jelinek <jakub@redhat.com> + + * trans.h (gfc_omp_clause_linear_ctor): New prototype. + * trans-openmp.c (gfc_omp_linear_clause_add_loop, + gfc_omp_clause_linear_ctor): New functions. + (gfc_trans_omp_clauses): Make sure OMP_CLAUSE_LINEAR_STEP has + correct type. Set OMP_CLAUSE_LINEAR_ARRAY flag if needed. + * f95-lang.c (LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR): Redefine. + + 2014-06-24 Jakub Jelinek <jakub@redhat.com> + + * dump-parse-tree.c (show_omp_namelist): Use n->udr->udr instead + of n->udr. + * f95-lang.c (gfc_init_builtin_functions): Initialize + BUILT_IN_ASSUME_ALIGNED. + * gfortran.h (gfc_omp_namelist): Change udr field type to + struct gfc_omp_namelist_udr. + (gfc_omp_namelist_udr): New type. + (gfc_get_omp_namelist_udr): Define. + (gfc_resolve_code): New prototype. + * match.c (gfc_free_omp_namelist): Free name->udr. + * module.c (intrinsics): Add INTRINSIC_USER. + (fix_mio_expr): Likewise. + (mio_expr): Handle INSTRINSIC_USER and non-resolved EXPR_FUNCTION. + * openmp.c (gfc_match_omp_clauses): Adjust initialization of n->udr. + (gfc_match_omp_declare_reduction): Treat len=: the same as len=*. + Set attr.flavor on omp_{out,in,priv,orig} artificial variables. + (struct resolve_omp_udr_callback_data): New type. + (resolve_omp_udr_callback, resolve_omp_udr_callback2, + resolve_omp_udr_clause): New functions. + (resolve_omp_clauses): Adjust for n->udr changes, resolve UDR clauses + here. + (omp_udr_callback): Don't check for implicitly declared functions + here. + (gfc_resolve_omp_udr): Don't call gfc_resolve. Don't check for + implicitly declared subroutines here. + * resolve.c (resolve_function): If value.function.isym is non-NULL, + consider it already resolved. + (resolve_code): Renamed to ... + (gfc_resolve_code): ... this. No longer static. + (gfc_resolve_blocks, generate_component_assignments, resolve_codes): + Adjust callers. + * trans-openmp.c (gfc_omp_privatize_by_reference): Don't privatize + by reference type (C_PTR) variables. + (gfc_omp_finish_clause): Make sure OMP_CLAUSE_SIZE is non-NULL. + (gfc_trans_omp_udr_expr): Remove. + (gfc_trans_omp_array_reduction_or_udr): Adjust for n->udr changes. + Don't call gfc_trans_omp_udr_expr, even for sym->attr.dimension + expand it as assignment or subroutine call. Don't initialize + value.function.isym. + + 2014-06-18 Tobias Burnus <burnus@net-b.de> + + * gfortran.texi (OpenMP): Update refs to OpenMP 4.0. + * intrinsic.texi (OpenMP Modules): Ditto. + + 2014-06-18 Jakub Jelinek <jakub@redhat.com> + + * cpp.c (cpp_define_builtins): Change _OPENMP macro to + 201307. + * dump-parse-tree.c (show_omp_namelist): Add list_type + argument. Adjust for rop being u.reduction_op now, + handle depend_op or map_op. + (show_omp_node): Adjust callers. Print some new + OpenMP 4.0 clauses, adjust for OMP_LIST_DEPEND_{IN,OUT} + becoming a single OMP_LIST_DEPEND. + * f95-lang.c (gfc_handle_omp_declare_target_attribute): New + function. + (gfc_attribute_table): New variable. + (LANG_HOOKS_OMP_FINISH_CLAUSE, LANG_HOOKS_ATTRIBUTE_TABLE): Redefine. + * frontend-passes.c (gfc_code_walker): Handle new OpenMP target + EXEC_OMP_* codes and new clauses. + * gfortran.h (gfc_statement): Add ST_OMP_TARGET, ST_OMP_END_TARGET, + ST_OMP_TARGET_DATA, ST_OMP_END_TARGET_DATA, ST_OMP_TARGET_UPDATE, + ST_OMP_DECLARE_TARGET, ST_OMP_TEAMS, ST_OMP_END_TEAMS, + ST_OMP_DISTRIBUTE, ST_OMP_END_DISTRIBUTE, ST_OMP_DISTRIBUTE_SIMD, + ST_OMP_END_DISTRIBUTE_SIMD, ST_OMP_DISTRIBUTE_PARALLEL_DO, + ST_OMP_END_DISTRIBUTE_PARALLEL_DO, ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD, ST_OMP_TARGET_TEAMS, + ST_OMP_END_TARGET_TEAMS, ST_OMP_TEAMS_DISTRIBUTE, + ST_OMP_END_TEAMS_DISTRIBUTE, ST_OMP_TEAMS_DISTRIBUTE_SIMD, + ST_OMP_END_TEAMS_DISTRIBUTE_SIMD, ST_OMP_TARGET_TEAMS_DISTRIBUTE, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD, + ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD and + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD. + (symbol_attribute): Add omp_declare_target field. + (gfc_omp_depend_op, gfc_omp_map_op): New enums. + (gfc_omp_namelist): Replace rop field with union + containing reduction_op, depend_op and map_op. + (OMP_LIST_DEPEND_IN, OMP_LIST_DEPEND_OUT): Remove. + (OMP_LIST_DEPEND, OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM): New. + (gfc_omp_clauses): Add num_teams, device, thread_limit, + dist_sched_kind, dist_chunk_size fields. + (gfc_common_head): Add omp_declare_target field. + (gfc_exec_op): Add EXEC_OMP_TARGET, EXEC_OMP_TARGET_DATA, + EXEC_OMP_TEAMS, EXEC_OMP_DISTRIBUTE, EXEC_OMP_DISTRIBUTE_SIMD, + EXEC_OMP_DISTRIBUTE_PARALLEL_DO, EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, + EXEC_OMP_TARGET_TEAMS, EXEC_OMP_TEAMS_DISTRIBUTE, + EXEC_OMP_TEAMS_DISTRIBUTE_SIMD, EXEC_OMP_TARGET_TEAMS_DISTRIBUTE, + EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD, + EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO, + EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD and + EXEC_OMP_TARGET_UPDATE. + (gfc_add_omp_declare_target): New prototype. + * match.h (gfc_match_omp_declare_target, gfc_match_omp_distribute, + gfc_match_omp_distribute_parallel_do, + gfc_match_omp_distribute_parallel_do_simd, + gfc_match_omp_distribute_simd, gfc_match_omp_target, + gfc_match_omp_target_data, gfc_match_omp_target_teams, + gfc_match_omp_target_teams_distribute, + gfc_match_omp_target_teams_distribute_parallel_do, + gfc_match_omp_target_teams_distribute_parallel_do_simd, + gfc_match_omp_target_teams_distribute_simd, + gfc_match_omp_target_update, gfc_match_omp_teams, + gfc_match_omp_teams_distribute, + gfc_match_omp_teams_distribute_parallel_do, + gfc_match_omp_teams_distribute_parallel_do_simd, + gfc_match_omp_teams_distribute_simd): New prototypes. + * module.c (ab_attribute): Add AB_OMP_DECLARE_TARGET. + (attr_bits): Likewise. + (mio_symbol_attribute): Handle omp_declare_target attribute. + (gfc_free_omp_clauses): Free num_teams, device, thread_limit + and dist_chunk_size expressions. + (OMP_CLAUSE_PRIVATE, OMP_CLAUSE_FIRSTPRIVATE, OMP_CLAUSE_LASTPRIVATE, + OMP_CLAUSE_COPYPRIVATE, OMP_CLAUSE_SHARED, OMP_CLAUSE_COPYIN, + OMP_CLAUSE_REDUCTION, OMP_CLAUSE_IF, OMP_CLAUSE_NUM_THREADS, + OMP_CLAUSE_SCHEDULE, OMP_CLAUSE_DEFAULT, OMP_CLAUSE_ORDERED, + OMP_CLAUSE_COLLAPSE, OMP_CLAUSE_UNTIED, OMP_CLAUSE_FINAL, + OMP_CLAUSE_MERGEABLE, OMP_CLAUSE_ALIGNED, OMP_CLAUSE_DEPEND, + OMP_CLAUSE_INBRANCH, OMP_CLAUSE_LINEAR, OMP_CLAUSE_NOTINBRANCH, + OMP_CLAUSE_PROC_BIND, OMP_CLAUSE_SAFELEN, OMP_CLAUSE_SIMDLEN, + OMP_CLAUSE_UNIFORM): Use 1U instead of 1. + (OMP_CLAUSE_DEVICE, OMP_CLAUSE_MAP, OMP_CLAUSE_TO, OMP_CLAUSE_FROM, + OMP_CLAUSE_NUM_TEAMS, OMP_CLAUSE_THREAD_LIMIT, + OMP_CLAUSE_DIST_SCHEDULE): Define. + (gfc_match_omp_clauses): Change mask parameter to unsigned int. + Adjust for rop becoming u.reduction_op. Disallow inbranch with + notinbranch. For depend clause, always create OMP_LIST_DEPEND + and fill in u.depend_op. Handle num_teams, device, map, + to, from, thread_limit and dist_schedule clauses. + (OMP_DECLARE_SIMD_CLAUSES): Or in OMP_CLAUSE_INBRANCH and + OMP_CLAUSE_NOTINBRANCH. + (OMP_TARGET_CLAUSES, OMP_TARGET_DATA_CLAUSES, + OMP_TARGET_UPDATE_CLAUSES, OMP_TEAMS_CLAUSES, + OMP_DISTRIBUTE_CLAUSES): Define. + (match_omp): New function. + (gfc_match_omp_do, gfc_match_omp_do_simd, gfc_match_omp_parallel, + gfc_match_omp_parallel_do, gfc_match_omp_parallel_do_simd, + gfc_match_omp_parallel_sections, gfc_match_omp_parallel_workshare, + gfc_match_omp_sections, gfc_match_omp_simd, gfc_match_omp_single, + gfc_match_omp_task): Rewritten using match_omp. + (gfc_match_omp_threadprivate, gfc_match_omp_declare_reduction): + Diagnose if the directives are followed by unexpected junk. + (gfc_match_omp_distribute, gfc_match_omp_distribute_parallel_do, + gfc_match_omp_distribute_parallel_do_simd, + gfc_match_omp_distrbute_simd, gfc_match_omp_declare_target, + gfc_match_omp_target, gfc_match_omp_target_data, + gfc_match_omp_target_teams, gfc_match_omp_target_teams_distribute, + gfc_match_omp_target_teams_distribute_parallel_do, + gfc_match_omp_target_teams_distribute_parallel_do_simd, + gfc_match_omp_target_teams_distrbute_simd, gfc_match_omp_target_update, + gfc_match_omp_teams, gfc_match_omp_teams_distribute, + gfc_match_omp_teams_distribute_parallel_do, + gfc_match_omp_teams_distribute_parallel_do_simd, + gfc_match_omp_teams_distrbute_simd): New functions. + * openmp.c (resolve_omp_clauses): Adjust for + OMP_LIST_DEPEND_{IN,OUT} being changed to OMP_LIST_DEPEND. Handle + OMP_LIST_MAP, OMP_LIST_FROM, OMP_LIST_TO, num_teams, device, + dist_chunk_size and thread_limit. + (gfc_resolve_omp_parallel_blocks): Only put sharing clauses into + ctx.sharing_clauses. Call gfc_resolve_omp_do_blocks for various + new EXEC_OMP_* codes. + (resolve_omp_do): Handle various new EXEC_OMP_* codes. + (gfc_resolve_omp_directive): Likewise. + (gfc_resolve_omp_declare_simd): Add missing space to diagnostics. + * parse.c (decode_omp_directive): Handle parsing of OpenMP 4.0 + offloading related directives. + (case_executable): Add ST_OMP_TARGET_UPDATE. + (case_exec_markers): Add ST_OMP_TARGET*, ST_OMP_TEAMS*, + ST_OMP_DISTRIBUTE*. + (case_decl): Add ST_OMP_DECLARE_TARGET. + (gfc_ascii_statement): Handle new ST_OMP_* codes. + (parse_omp_do): Handle various new ST_OMP_* codes. + (parse_executable): Likewise. + * resolve.c (gfc_resolve_blocks): Handle various new EXEC_OMP_* + codes. + (resolve_code): Likewise. + (resolve_symbol): Change that !$OMP DECLARE TARGET variables + are saved. + * st.c (gfc_free_statement): Handle various new EXEC_OMP_* codes. + * symbol.c (check_conflict): Check omp_declare_target conflicts. + (gfc_add_omp_declare_target): New function. + (gfc_copy_attr): Copy omp_declare_target. + * trans.c (trans_code): Handle various new EXEC_OMP_* codes. + * trans-common.c (build_common_decl): Add "omp declare target" + attribute if needed. + * trans-decl.c (add_attributes_to_decl): Likewise. + * trans.h (gfc_omp_finish_clause): New prototype. + * trans-openmp.c (gfc_omp_finish_clause): New function. + (gfc_trans_omp_reduction_list): Adjust for rop being renamed + to u.reduction_op. + (gfc_trans_omp_clauses): Adjust for OMP_LIST_DEPEND_{IN,OUT} + change to OMP_LIST_DEPEND and fix up depend handling. + Handle OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM, num_teams, + thread_limit, device, dist_chunk_size and dist_sched_kind. + (gfc_trans_omp_do): Handle EXEC_OMP_DISTRIBUTE. + (GFC_OMP_SPLIT_DISTRIBUTE, GFC_OMP_SPLIT_TEAMS, + GFC_OMP_SPLIT_TARGET, GFC_OMP_SPLIT_NUM, GFC_OMP_MASK_DISTRIBUTE, + GFC_OMP_MASK_TEAMS, GFC_OMP_MASK_TARGET, GFC_OMP_MASK_NUM): New. + (gfc_split_omp_clauses): Handle splitting of clauses for new + EXEC_OMP_* codes. + (gfc_trans_omp_do_simd): Add pblock argument, adjust for being + callable for combined constructs. + (gfc_trans_omp_parallel_do, gfc_trans_omp_parallel_do_simd): Likewise. + (gfc_trans_omp_distribute, gfc_trans_omp_teams, + gfc_trans_omp_target, gfc_trans_omp_target_data, + gfc_trans_omp_target_update): New functions. + (gfc_trans_omp_directive): Adjust gfc_trans_omp_* callers, handle + new EXEC_OMP_* codes. + + 2014-06-10 Jakub Jelinek <jakub@redhat.com> + + PR fortran/60928 + * f95-lang.c (gfc_init_builtin_functions): Handle -fopenmp-simd + like -fopenmp. + * openmp.c (resolve_omp_clauses): Remove allocatable components + diagnostics. Add associate-name and intent(in) pointer + diagnostics for various clauses, diagnose procedure pointers in + reduction clause. + * parse.c (match_word_omp_simd): New function. + (matchs, matcho): New macros. + (decode_omp_directive): Change match macros to either matchs + or matcho. Handle -fopenmp-simd. + (next_free, next_fixed): Handle -fopenmp-simd like -fopenmp. + * scanner.c (skip_free_comments, skip_fixed_comments, include_line): + Likewise. + * trans-array.c (get_full_array_size): Rename to... + (gfc_full_array_size): ... this. No longer static. + (duplicate_allocatable): Adjust caller. Add NO_MEMCPY argument + and handle it. + (gfc_duplicate_allocatable, gfc_copy_allocatable_data): Adjust + duplicate_allocatable callers. + (gfc_duplicate_allocatable_nocopy): New function. + (structure_alloc_comps): Adjust g*_full_array_size and + duplicate_allocatable caller. + * trans-array.h (gfc_full_array_size, + gfc_duplicate_allocatable_nocopy): New prototypes. + * trans-common.c (create_common): Call gfc_finish_decl_attrs. + * trans-decl.c (gfc_finish_decl_attrs): New function. + (gfc_finish_var_decl, create_function_arglist, + gfc_get_fake_result_decl): Call it. + (gfc_allocate_lang_decl): If DECL_LANG_SPECIFIC is already allocated, + don't allocate it again. + (gfc_get_symbol_decl): Set GFC_DECL_ASSOCIATE_VAR_P on + associate-names. + * trans.h (gfc_finish_decl_attrs): New prototype. + (struct lang_decl): Add scalar_allocatable and scalar_pointer + bitfields. + (GFC_DECL_SCALAR_ALLOCATABLE, GFC_DECL_SCALAR_POINTER, + GFC_DECL_GET_SCALAR_ALLOCATABLE, GFC_DECL_GET_SCALAR_POINTER, + GFC_DECL_ASSOCIATE_VAR_P): Define. + (GFC_POINTER_TYPE_P): Remove. + * trans-openmp.c (gfc_omp_privatize_by_reference): Don't check + GFC_POINTER_TYPE_P, instead test GFC_DECL_GET_SCALAR_ALLOCATABLE, + GFC_DECL_GET_SCALAR_POINTER or GFC_DECL_CRAY_POINTEE on decl. + (gfc_omp_predetermined_sharing): Associate-names are predetermined. + (enum walk_alloc_comps): New. + (gfc_has_alloc_comps, gfc_omp_unshare_expr_r, gfc_omp_unshare_expr, + gfc_walk_alloc_comps): New functions. + (gfc_omp_private_outer_ref): Return true for scalar allocatables or + decls with allocatable components. + (gfc_omp_clause_default_ctor, gfc_omp_clause_copy_ctor, + gfc_omp_clause_assign_op, gfc_omp_clause_dtor): Fix up handling of + allocatables, handle also OMP_CLAUSE_REDUCTION, handle scalar + allocatables and decls with allocatable components. + (gfc_trans_omp_array_reduction_or_udr): Don't handle allocatable + arrays here. + (gfc_trans_omp_reduction_list): Call + gfc_trans_omp_array_reduction_or_udr even for allocatable scalars. + (gfc_trans_omp_do_simd): If -fno-openmp, just expand it as OMP_SIMD. + (gfc_trans_omp_parallel_do_simd): Likewise. + * trans-types.c (gfc_sym_type): Don't set GFC_POINTER_TYPE_P. + (gfc_get_derived_type): Call gfc_finish_decl_attrs. + + 2014-06-06 Jakub Jelinek <jakub@redhat.com> + + * dump-parse-tree.c (show_omp_namelist): Dump reduction + id in each list item. + (show_omp_node): Only handle OMP_LIST_REDUCTION, not + OMP_LIST_REDUCTION_FIRST .. OMP_LIST_REDUCTION_LAST. Don't + dump reduction id here. + * frontend-passes.c (dummy_code_callback): Renamed to... + (gfc_dummy_code_callback): ... this. No longer static. + (optimize_reduction): Use gfc_dummy_code_callback instead of + dummy_code_callback. + * gfortran.h (gfc_statement): Add ST_OMP_DECLARE_REDUCTION. + (symbol_attribute): Add omp_udr_artificial_var bitfield. + (gfc_omp_reduction_op): New enum. + (gfc_omp_namelist): Add rop and udr fields. + (OMP_LIST_PLUS, OMP_LIST_REDUCTION_FIRST, OMP_LIST_MULT, + OMP_LIST_SUB, OMP_LIST_AND, OMP_LIST_OR, OMP_LIST_EQV, + OMP_LIST_NEQV, OMP_LIST_MAX, OMP_LIST_MIN, OMP_LIST_IAND, + OMP_LIST_IOR, OMP_LIST_IEOR, OMP_LIST_REDUCTION_LAST): Removed. + (OMP_LIST_REDUCTION): New. + (gfc_omp_udr): New type. + (gfc_get_omp_udr): Define. + (gfc_symtree): Add n.omp_udr field. + (gfc_namespace): Add omp_udr_root field, add omp_udr_ns bitfield. + (gfc_free_omp_udr, gfc_omp_udr_find, gfc_resolve_omp_udrs, + gfc_dummy_code_callback): New prototypes. + * match.h (gfc_match_omp_declare_reduction): New prototype. + * module.c (MOD_VERSION): Increase to 13. + (omp_declare_reduction_stmt): New array. + (mio_omp_udr_expr, write_omp_udr, write_omp_udrs, load_omp_udrs): + New functions. + (read_module): Read OpenMP user defined reductions. + (write_module): Write OpenMP user defined reductions. + * openmp.c: Include arith.h. + (gfc_free_omp_udr, gfc_find_omp_udr): New functions. + (gfc_match_omp_clauses): Handle user defined reductions. + Store reduction kind into gfc_omp_namelist instead of using + several OMP_LIST_* entries. + (match_udr_expr, gfc_omp_udr_predef, gfc_omp_udr_find, + gfc_match_omp_declare_reduction): New functions. + (resolve_omp_clauses): Adjust for reduction clauses being only + in OMP_LIST_REDUCTION list. Diagnose missing UDRs. + (struct omp_udr_callback_data): New type. + (omp_udr_callback, gfc_resolve_omp_udr, gfc_resolve_omp_udrs): New + functions. + * parse.c (decode_omp_directive): Handle !$omp declare reduction. + (case_decl): Add ST_OMP_DECLARE_REDUCTION. + (gfc_ascii_statement): Print ST_OMP_DECLARE_REDUCTION. + * resolve.c (resolve_fl_variable): Allow len=: or len=* on + sym->attr.omp_udr_artificial_var symbols. + (resolve_types): Call gfc_resolve_omp_udrs. + * symbol.c (gfc_get_uop): If gfc_current_ns->omp_udr_ns, + use parent ns instead of gfc_current_ns. + (gfc_get_sym_tree): Don't insert symbols into + namespaces with omp_udr_ns set. + (free_omp_udr_tree): New function. + (gfc_free_namespace): Call it. + * trans-openmp.c (struct omp_udr_find_orig_data): New type. + (omp_udr_find_orig, gfc_trans_omp_udr_expr): New functions. + (gfc_trans_omp_array_reduction): Renamed to... + (gfc_trans_omp_array_reduction_or_udr): ... this. Remove SYM + argument, instead pass gfc_omp_namelist pointer N. Handle + user defined reductions. + (gfc_trans_omp_reduction_list): Remove REDUCTION_CODE argument. + Handle user defined reductions and reduction ops in gfc_omp_namelist. + (gfc_trans_omp_clauses): Adjust for just a single OMP_LIST_REDUCTION + list. + (gfc_split_omp_clauses): Likewise. + + 2014-05-12 Tobias Burnus <burnus@net-b.de> + + PR fortran/60127 + * openmp.c (resolve_omp_do): Reject do concurrent loops. + + 2014-05-11 Jakub Jelinek <jakub@redhat.com> + + * gfortran.h (gfc_statement): Add ST_OMP_CANCEL, + ST_OMP_CANCELLATION_POINT, ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, + ST_OMP_SIMD, ST_OMP_END_SIMD, ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, + ST_OMP_PARALLEL_DO_SIMD, ST_OMP_END_PARALLEL_DO_SIMD and + ST_OMP_DECLARE_SIMD. + (gfc_omp_namelist): New typedef. + (gfc_get_omp_namelist): Define. + (OMP_LIST_UNIFORM, OMP_LIST_ALIGNED, OMP_LIST_LINEAR, + OMP_LIST_DEPEND_IN, OMP_LIST_DEPEND_OUT): New clause list kinds. + (gfc_omp_proc_bind_kind, gfc_omp_cancel_kind): New enums. + (gfc_omp_clauses): Change type of lists to gfc_omp_namelist *. + Add inbranch, notinbranch, cancel, proc_bind, safelen_expr and + simdlen_expr fields. + (gfc_omp_declare_simd): New typedef. + (gfc_get_omp_declare_simd): Define. + (gfc_namespace): Add omp_declare_simd field. + (gfc_exec_op): Add EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT, + EXEC_OMP_TASKGROUP, EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD and + EXEC_OMP_PARALLEL_DO_SIMD. + (gfc_omp_atomic_op): Add GFC_OMP_ATOMIC_MASK, GFC_OMP_ATOMIC_SEQ_CST + and GFC_OMP_ATOMIC_SWAP. + (gfc_code): Change type of omp_namelist field to gfc_omp_namelist *. + (gfc_free_omp_namelist, gfc_free_omp_declare_simd, + gfc_free_omp_declare_simd_list, gfc_resolve_omp_declare_simd): New + prototypes. + * trans-stmt.h (gfc_trans_omp_declare_simd): New prototype. + * symbol.c (gfc_free_namespace): Call gfc_free_omp_declare_simd. + * openmp.c (gfc_free_omp_clauses): Free safelen_expr and + simdlen_expr. Use gfc_free_omp_namelist instead of + gfc_free_namelist. + (gfc_free_omp_declare_simd, gfc_free_omp_declare_simd_list): New + functions. + (gfc_match_omp_variable_list): Add end_colon, headp and + allow_sections arguments. Handle parsing of array sections. + Use *omp_namelist* instead of *namelist* data structure and + functions/macros. Allow termination at : character. + (OMP_CLAUSE_ALIGNED, OMP_CLAUSE_DEPEND, OMP_CLAUSE_INBRANCH, + OMP_CLAUSE_LINEAR, OMP_CLAUSE_NOTINBRANCH, OMP_CLAUSE_PROC_BIND, + OMP_CLAUSE_SAFELEN, OMP_CLAUSE_SIMDLEN, OMP_CLAUSE_UNIFORM): Define. + (gfc_match_omp_clauses): Change first and needs_space variables + into arguments with default values. Parse inbranch, notinbranch, + proc_bind, safelen, simdlen, uniform, linear, aligned and + depend clauses. + (OMP_PARALLEL_CLAUSES): Add OMP_CLAUSE_PROC_BIND. + (OMP_DECLARE_SIMD_CLAUSES, OMP_SIMD_CLAUSES): Define. + (OMP_TASK_CLAUSES): Add OMP_CLAUSE_DEPEND. + (gfc_match_omp_do_simd): New function. + (gfc_match_omp_flush): Use *omp_namelist* instead of *namelist* + data structure and functions/macros. + (gfc_match_omp_simd, gfc_match_omp_declare_simd, + gfc_match_omp_parallel_do_simd): New functions. + (gfc_match_omp_atomic): Handle seq_cst clause. Handle atomic swap. + (gfc_match_omp_taskgroup, gfc_match_omp_cancel_kind, + gfc_match_omp_cancel, gfc_match_omp_cancellation_point): New + functions. + (resolve_omp_clauses): Add where, omp_clauses and ns arguments. + Use *omp_namelist* instead of *namelist* data structure and + functions/macros. Resolve uniform, aligned, linear, depend, + safelen and simdlen clauses. + (resolve_omp_atomic): Adjust for GFC_OMP_ATOMIC_{MASK,SEQ_CST,SWAP} + addition, recognize atomic swap. + (gfc_resolve_omp_parallel_blocks): Use gfc_omp_namelist instead + of gfc_namelist. Handle EXEC_OMP_PARALLEL_DO_SIMD the same as + EXEC_OMP_PARALLEL_DO. + (gfc_resolve_do_iterator): Use *omp_namelist* instead of *namelist* + data structure and functions/macros. + (resolve_omp_do): Likewise. Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD. + (gfc_resolve_omp_directive): Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD and EXEC_OMP_CANCEL. Adjust + resolve_omp_clauses caller. + (gfc_resolve_omp_declare_simd): New function. + * parse.c (decode_omp_directive): Parse cancellation point, cancel, + declare simd, end do simd, end simd, end parallel do simd, + end taskgroup, parallel do simd, simd and taskgroup directives. + (case_executable): Add ST_OMP_CANCEL and ST_OMP_CANCELLATION_POINT. + (case_exec_markers): Add ST_OMP_TASKGROUP, case ST_OMP_SIMD, + ST_OMP_DO_SIMD and ST_OMP_PARALLEL_DO_SIMD. + (case_decl): Add ST_OMP_DECLARE_SIMD. + (gfc_ascii_statement): Handle ST_OMP_CANCEL, + ST_OMP_CANCELLATION_POINT, ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, + ST_OMP_SIMD, ST_OMP_END_SIMD, ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, + ST_OMP_PARALLEL_DO_SIMD, ST_OMP_END_PARALLEL_DO_SIMD and + ST_OMP_DECLARE_SIMD. + (parse_omp_do): Handle ST_OMP_SIMD, ST_OMP_DO_SIMD and + ST_OMP_PARALLEL_DO_SIMD. + (parse_omp_atomic): Adjust for GFC_OMP_ATOMIC_* additions. + (parse_omp_structured_block): Handle ST_OMP_TASKGROUP and + ST_OMP_PARALLEL_DO_SIMD. + (parse_executable): Handle ST_OMP_SIMD, ST_OMP_DO_SIMD, + ST_OMP_PARALLEL_DO_SIMD and ST_OMP_TASKGROUP. + * trans-decl.c (gfc_get_extern_function_decl, + gfc_create_function_decl): Call gfc_trans_omp_declare_simd if + needed. + * frontend-passes.c (gfc_code_walker): Handle EXEC_OMP_SIMD, + EXEC_OMP_DO_SIMD and EXEC_OMP_PARALLEL_DO_SIMD. Walk + safelen_expr and simdlen_expr. Walk expressions in gfc_omp_namelist + of depend, aligned and linear clauses. + * match.c (match_exit_cycle): Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD + and EXEC_OMP_PARALLEL_DO_SIMD. + (gfc_free_omp_namelist): New function. + * dump-parse-tree.c (show_namelist): Removed. + (show_omp_namelist): New function. + (show_omp_node): Handle OpenMP 4.0 additions. + (show_code_node): Handle EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT, + EXEC_OMP_DO_SIMD, EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and + EXEC_OMP_TASKGROUP. + * match.h (gfc_match_omp_cancel, gfc_match_omp_cancellation_point, + gfc_match_omp_declare_simd, gfc_match_omp_do_simd, + gfc_match_omp_parallel_do_simd, gfc_match_omp_simd, + gfc_match_omp_taskgroup): New prototypes. + * trans-openmp.c (gfc_trans_omp_variable): Add declare_simd + argument, handle it. Allow current_function_decl to be NULL. + (gfc_trans_omp_variable_list): Add declare_simd argument, pass + it through to gfc_trans_omp_variable and disregard whether + sym is referenced if declare_simd is true. Work on gfc_omp_namelist + instead of gfc_namelist. + (gfc_trans_omp_reduction_list): Work on gfc_omp_namelist instead of + gfc_namelist. Adjust gfc_trans_omp_variable caller. + (gfc_trans_omp_clauses): Add declare_simd argument, pass it through + to gfc_trans_omp_variable{,_list} callers. Work on gfc_omp_namelist + instead of gfc_namelist. Handle inbranch, notinbranch, safelen, + simdlen, depend, uniform, linear, proc_bind and aligned clauses. + Handle cancel kind. + (gfc_trans_omp_atomic): Handle seq_cst clause, handle atomic swap, + adjust for GFC_OMP_ATOMIC_* changes. + (gfc_trans_omp_cancel, gfc_trans_omp_cancellation_point): New + functions. + (gfc_trans_omp_do): Add op argument, handle simd translation into + generic. + (GFC_OMP_SPLIT_SIMD, GFC_OMP_SPLIT_DO, GFC_OMP_SPLIT_PARALLEL, + GFC_OMP_SPLIT_NUM, GFC_OMP_MASK_SIMD, GFC_OMP_MASK_DO, + GFC_OMP_MASK_PARALLEL): New. + (gfc_split_omp_clauses, gfc_trans_omp_do_simd): New functions. + (gfc_trans_omp_parallel_do): Rework to use gfc_split_omp_clauses. + (gfc_trans_omp_parallel_do_simd, gfc_trans_omp_taskgroup): New + functions. + (gfc_trans_omp_directive): Handle EXEC_OMP_CANCEL, + EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + Adjust gfc_trans_omp_do caller. + (gfc_trans_omp_declare_simd): New function. + * st.c (gfc_free_statement): Handle EXEC_OMP_CANCEL, + EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + For EXEC_OMP_FLUSH call gfc_free_omp_namelist instead of + gfc_free_namelist. + * module.c (omp_declare_simd_clauses): New variable. + (mio_omp_declare_simd): New function. + (mio_symbol): Call it. + * trans.c (trans_code): Handle EXEC_OMP_CANCEL, + EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + * resolve.c (gfc_resolve_blocks): Handle EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + (resolve_code): Handle EXEC_OMP_CANCEL, + EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + (resolve_types): Call gfc_resolve_omp_declare_simd. + 2014-06-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> Backport from trunk. diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.c index 169599003db..7fb8d160267 100644 --- a/gcc/fortran/cpp.c +++ b/gcc/fortran/cpp.c @@ -171,7 +171,7 @@ cpp_define_builtins (cpp_reader *pfile) cpp_define (pfile, "_LANGUAGE_FORTRAN=1"); if (gfc_option.gfc_flag_openmp) - cpp_define (pfile, "_OPENMP=201107"); + cpp_define (pfile, "_OPENMP=201307"); /* The defines below are necessary for the TARGET_* macros. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 4048ac91353..eebecd59f1b 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1997,6 +1997,13 @@ variable_decl (int elem) if (!gfc_notify_std (GFC_STD_GNU, "Old-style " "initialization at %C")) return MATCH_ERROR; + else if (gfc_current_state () == COMP_DERIVED) + { + gfc_error ("Invalid old style initialization for derived type " + "component at %C"); + m = MATCH_ERROR; + goto cleanup; + } return match_old_style_init (name); } diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index b1343bc2a86..19f83a9eff8 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1016,11 +1016,60 @@ show_code (int level, gfc_code *c) } static void -show_namelist (gfc_namelist *n) +show_omp_namelist (int list_type, gfc_omp_namelist *n) { - for (; n->next; n = n->next) - fprintf (dumpfile, "%s,", n->sym->name); - fprintf (dumpfile, "%s", n->sym->name); + for (; n; n = n->next) + { + if (list_type == OMP_LIST_REDUCTION) + switch (n->u.reduction_op) + { + case OMP_REDUCTION_PLUS: + case OMP_REDUCTION_TIMES: + case OMP_REDUCTION_MINUS: + case OMP_REDUCTION_AND: + case OMP_REDUCTION_OR: + case OMP_REDUCTION_EQV: + case OMP_REDUCTION_NEQV: + fprintf (dumpfile, "%s:", + gfc_op2string ((gfc_intrinsic_op) n->u.reduction_op)); + break; + case OMP_REDUCTION_MAX: fputs ("max:", dumpfile); break; + case OMP_REDUCTION_MIN: fputs ("min:", dumpfile); break; + case OMP_REDUCTION_IAND: fputs ("iand:", dumpfile); break; + case OMP_REDUCTION_IOR: fputs ("ior:", dumpfile); break; + case OMP_REDUCTION_IEOR: fputs ("ieor:", dumpfile); break; + case OMP_REDUCTION_USER: + if (n->udr) + fprintf (dumpfile, "%s:", n->udr->udr->name); + break; + default: break; + } + else if (list_type == OMP_LIST_DEPEND) + switch (n->u.depend_op) + { + case OMP_DEPEND_IN: fputs ("in:", dumpfile); break; + case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break; + case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break; + default: break; + } + else if (list_type == OMP_LIST_MAP) + switch (n->u.map_op) + { + case OMP_MAP_ALLOC: fputs ("alloc:", dumpfile); break; + case OMP_MAP_TO: fputs ("to:", dumpfile); break; + case OMP_MAP_FROM: fputs ("from:", dumpfile); break; + case OMP_MAP_TOFROM: fputs ("tofrom:", dumpfile); break; + default: break; + } + fprintf (dumpfile, "%s", n->sym->name); + if (n->expr) + { + fputc (':', dumpfile); + show_expr (n->expr); + } + if (n->next) + fputc (',', dumpfile); + } } /* Show a single OpenMP directive node and everything underneath it @@ -1036,18 +1085,24 @@ show_omp_node (int level, gfc_code *c) { case EXEC_OMP_ATOMIC: name = "ATOMIC"; break; case EXEC_OMP_BARRIER: name = "BARRIER"; break; + case EXEC_OMP_CANCEL: name = "CANCEL"; break; + case EXEC_OMP_CANCELLATION_POINT: name = "CANCELLATION POINT"; break; case EXEC_OMP_CRITICAL: name = "CRITICAL"; break; case EXEC_OMP_FLUSH: name = "FLUSH"; break; case EXEC_OMP_DO: name = "DO"; break; + case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break; case EXEC_OMP_MASTER: name = "MASTER"; break; case EXEC_OMP_ORDERED: name = "ORDERED"; break; case EXEC_OMP_PARALLEL: name = "PARALLEL"; break; case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break; + case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break; case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break; case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break; case EXEC_OMP_SECTIONS: name = "SECTIONS"; break; + case EXEC_OMP_SIMD: name = "SIMD"; break; case EXEC_OMP_SINGLE: name = "SINGLE"; break; case EXEC_OMP_TASK: name = "TASK"; break; + case EXEC_OMP_TASKGROUP: name = "TASKGROUP"; break; case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break; case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break; case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break; @@ -1057,11 +1112,16 @@ show_omp_node (int level, gfc_code *c) fprintf (dumpfile, "!$OMP %s", name); switch (c->op) { + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: case EXEC_OMP_WORKSHARE: case EXEC_OMP_PARALLEL_WORKSHARE: @@ -1076,7 +1136,7 @@ show_omp_node (int level, gfc_code *c) if (c->ext.omp_namelist) { fputs (" (", dumpfile); - show_namelist (c->ext.omp_namelist); + show_omp_namelist (OMP_LIST_NUM, c->ext.omp_namelist); fputc (')', dumpfile); } return; @@ -1091,6 +1151,23 @@ show_omp_node (int level, gfc_code *c) { int list_type; + switch (omp_clauses->cancel) + { + case OMP_CANCEL_UNKNOWN: + break; + case OMP_CANCEL_PARALLEL: + fputs (" PARALLEL", dumpfile); + break; + case OMP_CANCEL_SECTIONS: + fputs (" SECTIONS", dumpfile); + break; + case OMP_CANCEL_DO: + fputs (" DO", dumpfile); + break; + case OMP_CANCEL_TASKGROUP: + fputs (" TASKGROUP", dumpfile); + break; + } if (omp_clauses->if_expr) { fputs (" IF(", dumpfile); @@ -1156,45 +1233,83 @@ show_omp_node (int level, gfc_code *c) if (omp_clauses->lists[list_type] != NULL && list_type != OMP_LIST_COPYPRIVATE) { - const char *type; - if (list_type >= OMP_LIST_REDUCTION_FIRST) + const char *type = NULL; + switch (list_type) { - switch (list_type) - { - case OMP_LIST_PLUS: type = "+"; break; - case OMP_LIST_MULT: type = "*"; break; - case OMP_LIST_SUB: type = "-"; break; - case OMP_LIST_AND: type = ".AND."; break; - case OMP_LIST_OR: type = ".OR."; break; - case OMP_LIST_EQV: type = ".EQV."; break; - case OMP_LIST_NEQV: type = ".NEQV."; break; - case OMP_LIST_MAX: type = "MAX"; break; - case OMP_LIST_MIN: type = "MIN"; break; - case OMP_LIST_IAND: type = "IAND"; break; - case OMP_LIST_IOR: type = "IOR"; break; - case OMP_LIST_IEOR: type = "IEOR"; break; - default: - gcc_unreachable (); - } - fprintf (dumpfile, " REDUCTION(%s:", type); + case OMP_LIST_PRIVATE: type = "PRIVATE"; break; + case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break; + case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break; + case OMP_LIST_SHARED: type = "SHARED"; break; + case OMP_LIST_COPYIN: type = "COPYIN"; break; + case OMP_LIST_UNIFORM: type = "UNIFORM"; break; + case OMP_LIST_ALIGNED: type = "ALIGNED"; break; + case OMP_LIST_LINEAR: type = "LINEAR"; break; + case OMP_LIST_REDUCTION: type = "REDUCTION"; break; + case OMP_LIST_DEPEND: type = "DEPEND"; break; + default: + gcc_unreachable (); } - else - { - switch (list_type) - { - case OMP_LIST_PRIVATE: type = "PRIVATE"; break; - case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break; - case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break; - case OMP_LIST_SHARED: type = "SHARED"; break; - case OMP_LIST_COPYIN: type = "COPYIN"; break; - default: - gcc_unreachable (); - } - fprintf (dumpfile, " %s(", type); - } - show_namelist (omp_clauses->lists[list_type]); + fprintf (dumpfile, " %s(", type); + show_omp_namelist (list_type, omp_clauses->lists[list_type]); fputc (')', dumpfile); } + if (omp_clauses->safelen_expr) + { + fputs (" SAFELEN(", dumpfile); + show_expr (omp_clauses->safelen_expr); + fputc (')', dumpfile); + } + if (omp_clauses->simdlen_expr) + { + fputs (" SIMDLEN(", dumpfile); + show_expr (omp_clauses->simdlen_expr); + fputc (')', dumpfile); + } + if (omp_clauses->inbranch) + fputs (" INBRANCH", dumpfile); + if (omp_clauses->notinbranch) + fputs (" NOTINBRANCH", dumpfile); + if (omp_clauses->proc_bind != OMP_PROC_BIND_UNKNOWN) + { + const char *type; + switch (omp_clauses->proc_bind) + { + case OMP_PROC_BIND_MASTER: type = "MASTER"; break; + case OMP_PROC_BIND_SPREAD: type = "SPREAD"; break; + case OMP_PROC_BIND_CLOSE: type = "CLOSE"; break; + default: + gcc_unreachable (); + } + fprintf (dumpfile, " PROC_BIND(%s)", type); + } + if (omp_clauses->num_teams) + { + fputs (" NUM_TEAMS(", dumpfile); + show_expr (omp_clauses->num_teams); + fputc (')', dumpfile); + } + if (omp_clauses->device) + { + fputs (" DEVICE(", dumpfile); + show_expr (omp_clauses->device); + fputc (')', dumpfile); + } + if (omp_clauses->thread_limit) + { + fputs (" THREAD_LIMIT(", dumpfile); + show_expr (omp_clauses->thread_limit); + fputc (')', dumpfile); + } + if (omp_clauses->dist_sched_kind != OMP_SCHED_NONE) + { + fprintf (dumpfile, " DIST_SCHEDULE (static"); + if (omp_clauses->dist_chunk_size) + { + fputc (',', dumpfile); + show_expr (omp_clauses->dist_chunk_size); + } + fputc (')', dumpfile); + } } fputc ('\n', dumpfile); if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) @@ -1214,6 +1329,7 @@ show_omp_node (int level, gfc_code *c) show_code (level + 1, c->block->next); if (c->op == EXEC_OMP_ATOMIC) return; + fputc ('\n', dumpfile); code_indent (level, 0); fprintf (dumpfile, "!$OMP END %s", name); if (omp_clauses != NULL) @@ -1221,7 +1337,8 @@ show_omp_node (int level, gfc_code *c) if (omp_clauses->lists[OMP_LIST_COPYPRIVATE]) { fputs (" COPYPRIVATE(", dumpfile); - show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]); + show_omp_namelist (OMP_LIST_COPYPRIVATE, + omp_clauses->lists[OMP_LIST_COPYPRIVATE]); fputc (')', dumpfile); } else if (omp_clauses->nowait) @@ -2195,19 +2312,25 @@ show_code_node (int level, gfc_code *c) break; case EXEC_OMP_ATOMIC: + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_BARRIER: case EXEC_OMP_CRITICAL: case EXEC_OMP_FLUSH: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: case EXEC_OMP_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_WORKSHARE: diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index e25e92a5533..12d3236615d 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -87,6 +87,24 @@ static alias_set_type gfc_get_alias_set (tree); static void gfc_init_ts (void); static tree gfc_builtin_function (tree); +/* Handle an "omp declare target" attribute; arguments as in + struct attribute_spec.handler. */ +static tree +gfc_handle_omp_declare_target_attribute (tree *, tree, tree, int, bool *) +{ + return NULL_TREE; +} + +/* Table of valid Fortran attributes. */ +static const struct attribute_spec gfc_attribute_table[] = +{ + /* { name, min_len, max_len, decl_req, type_req, fn_type_req, handler, + affects_type_identity } */ + { "omp declare target", 0, 0, true, false, false, + gfc_handle_omp_declare_target_attribute, false }, + { NULL, 0, 0, false, false, false, NULL, false } +}; + #undef LANG_HOOKS_NAME #undef LANG_HOOKS_INIT #undef LANG_HOOKS_FINISH @@ -108,7 +126,9 @@ static tree gfc_builtin_function (tree); #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR #undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR #undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP +#undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR #undef LANG_HOOKS_OMP_CLAUSE_DTOR +#undef LANG_HOOKS_OMP_FINISH_CLAUSE #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE #undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF @@ -116,6 +136,7 @@ static tree gfc_builtin_function (tree); #undef LANG_HOOKS_BUILTIN_FUNCTION #undef LANG_HOOKS_BUILTIN_FUNCTION #undef LANG_HOOKS_GET_ARRAY_DESCR_INFO +#undef LANG_HOOKS_ATTRIBUTE_TABLE /* Define lang hooks. */ #define LANG_HOOKS_NAME "GNU Fortran" @@ -138,14 +159,17 @@ static tree gfc_builtin_function (tree); #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR gfc_omp_clause_copy_ctor #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP gfc_omp_clause_assign_op +#define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR gfc_omp_clause_linear_ctor #define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor +#define LANG_HOOKS_OMP_FINISH_CLAUSE gfc_omp_finish_clause #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause #define LANG_HOOKS_OMP_PRIVATE_OUTER_REF gfc_omp_private_outer_ref #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \ gfc_omp_firstprivatize_type_sizes -#define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function -#define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info +#define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function +#define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info +#define LANG_HOOKS_ATTRIBUTE_TABLE gfc_attribute_table struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; @@ -1038,7 +1062,9 @@ gfc_init_builtin_functions (void) #include "../sync-builtins.def" #undef DEF_SYNC_BUILTIN - if (gfc_option.gfc_flag_openmp || flag_tree_parallelize_loops) + if (gfc_option.gfc_flag_openmp + || gfc_option.gfc_flag_openmp_simd + || flag_tree_parallelize_loops) { #undef DEF_GOMP_BUILTIN #define DEF_GOMP_BUILTIN(code, name, type, attr) \ @@ -1052,6 +1078,13 @@ gfc_init_builtin_functions (void) BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST); TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1; + ftype = build_varargs_function_type_list (ptr_type_node, const_ptr_type_node, + size_type_node, NULL_TREE); + gfc_define_builtin ("__builtin_assume_aligned", ftype, + BUILT_IN_ASSUME_ALIGNED, + "__builtin_assume_aligned", + ATTR_CONST_NOTHROW_LEAF_LIST); + gfc_define_builtin ("__emutls_get_address", builtin_types[BT_FN_PTR_PTR], BUILT_IN_EMUTLS_GET_ADDRESS, diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 9ceca956be4..4646cc33fd3 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -676,10 +676,10 @@ dummy_expr_callback (gfc_expr **e ATTRIBUTE_UNUSED, int *walk_subtrees, /* Dummy function for code callback, for use when we really don't want to do anything. */ -static int -dummy_code_callback (gfc_code **e ATTRIBUTE_UNUSED, - int *walk_subtrees ATTRIBUTE_UNUSED, - void *data ATTRIBUTE_UNUSED) +int +gfc_dummy_code_callback (gfc_code **e ATTRIBUTE_UNUSED, + int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) { return 0; } @@ -844,7 +844,8 @@ static void optimize_reduction (gfc_namespace *ns) { current_ns = ns; - gfc_code_walker (&ns->code, dummy_code_callback, callback_reduction, NULL); + gfc_code_walker (&ns->code, gfc_dummy_code_callback, + callback_reduction, NULL); /* BLOCKs are handled in the expression walker below. */ for (ns = ns->contained; ns; ns = ns->sibling) @@ -2131,6 +2132,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: in_omp_workshare = false; @@ -2145,12 +2147,31 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, in_omp_workshare = true; /* Fall through */ - + + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_END_SINGLE: + case EXEC_OMP_SIMD: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: /* Come to this label only from the EXEC_OMP_PARALLEL_* cases above. */ @@ -2159,10 +2180,27 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, if (co->ext.omp_clauses) { + gfc_omp_namelist *n; + static int list_types[] + = { OMP_LIST_ALIGNED, OMP_LIST_LINEAR, OMP_LIST_DEPEND, + OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM }; + size_t idx; WALK_SUBEXPR (co->ext.omp_clauses->if_expr); WALK_SUBEXPR (co->ext.omp_clauses->final_expr); WALK_SUBEXPR (co->ext.omp_clauses->num_threads); WALK_SUBEXPR (co->ext.omp_clauses->chunk_size); + WALK_SUBEXPR (co->ext.omp_clauses->safelen_expr); + WALK_SUBEXPR (co->ext.omp_clauses->simdlen_expr); + WALK_SUBEXPR (co->ext.omp_clauses->num_teams); + WALK_SUBEXPR (co->ext.omp_clauses->device); + WALK_SUBEXPR (co->ext.omp_clauses->thread_limit); + WALK_SUBEXPR (co->ext.omp_clauses->dist_chunk_size); + for (idx = 0; + idx < sizeof (list_types) / sizeof (list_types[0]); + idx++) + for (n = co->ext.omp_clauses->lists[list_types[idx]]; + n; n = n->next) + WALK_SUBEXPR (n->expr); } break; default: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 14c202dd413..6b88aec384a 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -211,8 +211,30 @@ typedef enum ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS, ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE, ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK, - ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, - ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_NONE + ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_OMP_CANCEL, ST_OMP_CANCELLATION_POINT, + ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, ST_OMP_SIMD, ST_OMP_END_SIMD, + ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, ST_OMP_PARALLEL_DO_SIMD, + ST_OMP_END_PARALLEL_DO_SIMD, ST_OMP_DECLARE_SIMD, ST_OMP_DECLARE_REDUCTION, + ST_OMP_TARGET, ST_OMP_END_TARGET, ST_OMP_TARGET_DATA, ST_OMP_END_TARGET_DATA, + ST_OMP_TARGET_UPDATE, ST_OMP_DECLARE_TARGET, + ST_OMP_TEAMS, ST_OMP_END_TEAMS, ST_OMP_DISTRIBUTE, ST_OMP_END_DISTRIBUTE, + ST_OMP_DISTRIBUTE_SIMD, ST_OMP_END_DISTRIBUTE_SIMD, + ST_OMP_DISTRIBUTE_PARALLEL_DO, ST_OMP_END_DISTRIBUTE_PARALLEL_DO, + ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_TARGET_TEAMS, ST_OMP_END_TARGET_TEAMS, ST_OMP_TEAMS_DISTRIBUTE, + ST_OMP_END_TEAMS_DISTRIBUTE, ST_OMP_TEAMS_DISTRIBUTE_SIMD, + ST_OMP_END_TEAMS_DISTRIBUTE_SIMD, ST_OMP_TARGET_TEAMS_DISTRIBUTE, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE, ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD, ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, + ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_NONE } gfc_statement; @@ -808,6 +830,13 @@ typedef struct variable for SELECT_TYPE or ASSOCIATE. */ unsigned select_type_temporary:1, associate_var:1; + /* This is omp_{out,in,priv,orig} artificial variable in + !$OMP DECLARE REDUCTION. */ + unsigned omp_udr_artificial_var:1; + + /* Mentioned in OMP DECLARE TARGET. */ + unsigned omp_declare_target:1; + /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; @@ -1028,6 +1057,62 @@ gfc_namelist; #define gfc_get_namelist() XCNEW (gfc_namelist) +typedef enum +{ + OMP_REDUCTION_NONE = -1, + OMP_REDUCTION_PLUS = INTRINSIC_PLUS, + OMP_REDUCTION_MINUS = INTRINSIC_MINUS, + OMP_REDUCTION_TIMES = INTRINSIC_TIMES, + OMP_REDUCTION_AND = INTRINSIC_AND, + OMP_REDUCTION_OR = INTRINSIC_OR, + OMP_REDUCTION_EQV = INTRINSIC_EQV, + OMP_REDUCTION_NEQV = INTRINSIC_NEQV, + OMP_REDUCTION_MAX = GFC_INTRINSIC_END, + OMP_REDUCTION_MIN, + OMP_REDUCTION_IAND, + OMP_REDUCTION_IOR, + OMP_REDUCTION_IEOR, + OMP_REDUCTION_USER +} +gfc_omp_reduction_op; + +typedef enum +{ + OMP_DEPEND_IN, + OMP_DEPEND_OUT, + OMP_DEPEND_INOUT +} +gfc_omp_depend_op; + +typedef enum +{ + OMP_MAP_ALLOC, + OMP_MAP_TO, + OMP_MAP_FROM, + OMP_MAP_TOFROM +} +gfc_omp_map_op; + +/* For use in OpenMP clauses in case we need extra information + (aligned clause alignment, linear clause step, etc.). */ + +typedef struct gfc_omp_namelist +{ + struct gfc_symbol *sym; + struct gfc_expr *expr; + union + { + gfc_omp_reduction_op reduction_op; + gfc_omp_depend_op depend_op; + gfc_omp_map_op map_op; + } u; + struct gfc_omp_namelist_udr *udr; + struct gfc_omp_namelist *next; +} +gfc_omp_namelist; + +#define gfc_get_omp_namelist() XCNEW (gfc_omp_namelist) + enum { OMP_LIST_PRIVATE, @@ -1036,20 +1121,14 @@ enum OMP_LIST_COPYPRIVATE, OMP_LIST_SHARED, OMP_LIST_COPYIN, - OMP_LIST_PLUS, - OMP_LIST_REDUCTION_FIRST = OMP_LIST_PLUS, - OMP_LIST_MULT, - OMP_LIST_SUB, - OMP_LIST_AND, - OMP_LIST_OR, - OMP_LIST_EQV, - OMP_LIST_NEQV, - OMP_LIST_MAX, - OMP_LIST_MIN, - OMP_LIST_IAND, - OMP_LIST_IOR, - OMP_LIST_IEOR, - OMP_LIST_REDUCTION_LAST = OMP_LIST_IEOR, + OMP_LIST_UNIFORM, + OMP_LIST_ALIGNED, + OMP_LIST_LINEAR, + OMP_LIST_DEPEND, + OMP_LIST_MAP, + OMP_LIST_TO, + OMP_LIST_FROM, + OMP_LIST_REDUCTION, OMP_LIST_NUM }; @@ -1075,23 +1154,93 @@ enum gfc_omp_default_sharing OMP_DEFAULT_FIRSTPRIVATE }; +enum gfc_omp_proc_bind_kind +{ + OMP_PROC_BIND_UNKNOWN, + OMP_PROC_BIND_MASTER, + OMP_PROC_BIND_SPREAD, + OMP_PROC_BIND_CLOSE +}; + +enum gfc_omp_cancel_kind +{ + OMP_CANCEL_UNKNOWN, + OMP_CANCEL_PARALLEL, + OMP_CANCEL_SECTIONS, + OMP_CANCEL_DO, + OMP_CANCEL_TASKGROUP +}; + typedef struct gfc_omp_clauses { struct gfc_expr *if_expr; struct gfc_expr *final_expr; struct gfc_expr *num_threads; - gfc_namelist *lists[OMP_LIST_NUM]; + gfc_omp_namelist *lists[OMP_LIST_NUM]; enum gfc_omp_sched_kind sched_kind; struct gfc_expr *chunk_size; enum gfc_omp_default_sharing default_sharing; int collapse; bool nowait, ordered, untied, mergeable; + bool inbranch, notinbranch; + enum gfc_omp_cancel_kind cancel; + enum gfc_omp_proc_bind_kind proc_bind; + struct gfc_expr *safelen_expr; + struct gfc_expr *simdlen_expr; + struct gfc_expr *num_teams; + struct gfc_expr *device; + struct gfc_expr *thread_limit; + enum gfc_omp_sched_kind dist_sched_kind; + struct gfc_expr *dist_chunk_size; } gfc_omp_clauses; #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses) +/* Node in the linked list used for storing !$omp declare simd constructs. */ + +typedef struct gfc_omp_declare_simd +{ + struct gfc_omp_declare_simd *next; + locus where; /* Where the !$omp declare simd construct occurred. */ + + gfc_symbol *proc_name; + + gfc_omp_clauses *clauses; +} +gfc_omp_declare_simd; +#define gfc_get_omp_declare_simd() XCNEW (gfc_omp_declare_simd) + +typedef struct gfc_omp_udr +{ + struct gfc_omp_udr *next; + locus where; /* Where the !$omp declare reduction construct occurred. */ + + const char *name; + gfc_typespec ts; + gfc_omp_reduction_op rop; + + struct gfc_symbol *omp_out; + struct gfc_symbol *omp_in; + struct gfc_namespace *combiner_ns; + + struct gfc_symbol *omp_priv; + struct gfc_symbol *omp_orig; + struct gfc_namespace *initializer_ns; +} +gfc_omp_udr; +#define gfc_get_omp_udr() XCNEW (gfc_omp_udr) + +typedef struct gfc_omp_namelist_udr +{ + struct gfc_omp_udr *udr; + struct gfc_code *combiner; + struct gfc_code *initializer; +} +gfc_omp_namelist_udr; +#define gfc_get_omp_namelist_udr() XCNEW (gfc_omp_namelist_udr) + /* The gfc_st_label structure is a BBT attached to a namespace that records the usage of statement labels within that space. */ @@ -1292,7 +1441,7 @@ struct gfc_undo_change_set typedef struct gfc_common_head { locus where; - char use_assoc, saved, threadprivate; + char use_assoc, saved, threadprivate, omp_declare_target; char name[GFC_MAX_SYMBOL_LEN + 1]; struct gfc_symbol *head; const char* binding_label; @@ -1368,6 +1517,7 @@ typedef struct gfc_symtree gfc_user_op *uop; gfc_common_head *common; gfc_typebound_proc *tb; + gfc_omp_udr *omp_udr; } n; } @@ -1398,6 +1548,8 @@ typedef struct gfc_namespace gfc_symtree *uop_root; /* Tree containing all the common blocks. */ gfc_symtree *common_root; + /* Tree containing all the OpenMP user defined reductions. */ + gfc_symtree *omp_udr_root; /* Tree containing type-bound procedures. */ gfc_symtree *tb_sym_root; @@ -1464,6 +1616,9 @@ typedef struct gfc_namespace /* A list of USE statements in this namespace. */ gfc_use_list *use_stmts; + /* Linked list of !$omp declare simd constructs. */ + struct gfc_omp_declare_simd *omp_declare_simd; + /* Set to 1 if namespace is a BLOCK DATA program unit. */ unsigned is_block_data:1; @@ -1480,6 +1635,9 @@ typedef struct gfc_namespace /* Set to 1 if symbols in this namespace should be 'construct entities', i.e. for BLOCK local variables. */ unsigned construct_entities:1; + + /* Set to 1 for !$OMP DECLARE REDUCTION namespaces. */ + unsigned omp_udr_ns:1; } gfc_namespace; @@ -2111,16 +2269,31 @@ typedef enum EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE, EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT, EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT, - EXEC_OMP_TASKYIELD + EXEC_OMP_TASKYIELD, EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT, + EXEC_OMP_TASKGROUP, EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_TARGET, EXEC_OMP_TARGET_DATA, + EXEC_OMP_TEAMS, EXEC_OMP_DISTRIBUTE, EXEC_OMP_DISTRIBUTE_SIMD, + EXEC_OMP_DISTRIBUTE_PARALLEL_DO, EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, + EXEC_OMP_TARGET_TEAMS, EXEC_OMP_TEAMS_DISTRIBUTE, + EXEC_OMP_TEAMS_DISTRIBUTE_SIMD, EXEC_OMP_TARGET_TEAMS_DISTRIBUTE, + EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD, + EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO, + EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + EXEC_OMP_TARGET_UPDATE } gfc_exec_op; typedef enum { - GFC_OMP_ATOMIC_UPDATE, - GFC_OMP_ATOMIC_READ, - GFC_OMP_ATOMIC_WRITE, - GFC_OMP_ATOMIC_CAPTURE + GFC_OMP_ATOMIC_UPDATE = 0, + GFC_OMP_ATOMIC_READ = 1, + GFC_OMP_ATOMIC_WRITE = 2, + GFC_OMP_ATOMIC_CAPTURE = 3, + GFC_OMP_ATOMIC_MASK = 3, + GFC_OMP_ATOMIC_SEQ_CST = 4, + GFC_OMP_ATOMIC_SWAP = 8 } gfc_omp_atomic_op; @@ -2172,7 +2345,7 @@ typedef struct gfc_code gfc_entry_list *entry; gfc_omp_clauses *omp_clauses; const char *omp_name; - gfc_namelist *omp_namelist; + gfc_omp_namelist *omp_namelist; bool omp_bool; gfc_omp_atomic_op omp_atomic; } @@ -2573,6 +2746,7 @@ bool gfc_add_protected (symbol_attribute *, const char *, locus *); bool gfc_add_result (symbol_attribute *, const char *, locus *); bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *); bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *); +bool gfc_add_omp_declare_target (symbol_attribute *, const char *, locus *); bool gfc_add_saved_common (symbol_attribute *, locus *); bool gfc_add_target (symbol_attribute *, locus *); bool gfc_add_dummy (symbol_attribute *, const char *, locus *); @@ -2728,6 +2902,7 @@ void gfc_free_iterator (gfc_iterator *, int); void gfc_free_forall_iterator (gfc_forall_iterator *); void gfc_free_alloc_list (gfc_alloc *); void gfc_free_namelist (gfc_namelist *); +void gfc_free_omp_namelist (gfc_omp_namelist *); void gfc_free_equiv (gfc_equiv *); void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *); void gfc_free_data (gfc_data *); @@ -2739,10 +2914,16 @@ gfc_expr *gfc_get_parentheses (gfc_expr *); /* openmp.c */ struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; }; void gfc_free_omp_clauses (gfc_omp_clauses *); +void gfc_free_omp_declare_simd (gfc_omp_declare_simd *); +void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *); +void gfc_free_omp_udr (gfc_omp_udr *); +gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *); void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *); void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *); void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *); void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *); +void gfc_resolve_omp_declare_simd (gfc_namespace *); +void gfc_resolve_omp_udrs (gfc_symtree *); void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *); void gfc_omp_restore_state (struct gfc_omp_saved_state *); @@ -2833,6 +3014,7 @@ void gfc_free_association_list (gfc_association_list *); /* resolve.c */ bool gfc_resolve_expr (gfc_expr *); void gfc_resolve (gfc_namespace *); +void gfc_resolve_code (gfc_code *, gfc_namespace *); void gfc_resolve_blocks (gfc_code *, gfc_namespace *); int gfc_impure_variable (gfc_symbol *); int gfc_pure (gfc_symbol *); @@ -3019,6 +3201,7 @@ void gfc_run_passes (gfc_namespace *); typedef int (*walk_code_fn_t) (gfc_code **, int *, void *); typedef int (*walk_expr_fn_t) (gfc_expr **, int *, void *); +int gfc_dummy_code_callback (gfc_code **, int *, void *); int gfc_expr_walker (gfc_expr **, walk_expr_fn_t, void *); int gfc_code_walker (gfc_code **, walk_code_fn_t, walk_expr_fn_t, void *); diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 773ec62a51c..c852b3aa15c 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -531,7 +531,7 @@ The current status of the support is can be found in the @ref{TS 29113 status} sections of the documentation. Additionally, the GNU Fortran compilers supports the OpenMP specification -(version 3.1, @url{http://openmp.org/@/wp/@/openmp-specifications/}). +(version 4.0, @url{http://openmp.org/@/wp/@/openmp-specifications/}). @node Varying Length Character Strings @subsection Varying Length Character Strings @@ -1884,8 +1884,8 @@ It consists of a set of compiler directives, library routines, and environment variables that influence run-time behavior. GNU Fortran strives to be compatible to the -@uref{http://www.openmp.org/mp-documents/spec31.pdf, -OpenMP Application Program Interface v3.1}. +@uref{http://openmp.org/wp/openmp-specifications/, +OpenMP Application Program Interface v4.0}. To enable the processing of the OpenMP directive @code{!$omp} in free-form source code; the @code{c$omp}, @code{*$omp} and @code{!$omp} diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index efbb2f142a0..eb6924c8176 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -13208,8 +13208,7 @@ named constants: @code{OMP_LIB} provides the scalar default-integer named constant @code{openmp_version} with a value of the form @var{yyyymm}, where @code{yyyy} is the year and @var{mm} the month -of the OpenMP version; for OpenMP v3.1 the value is @code{201107} -and for OpenMP v4.0 the value is @code{201307}. +of the OpenMP version; for OpenMP v4.0 the value is @code{201307}. The following scalar integer named constants of the kind @code{omp_sched_kind}: diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 4c4609401a0..b3f47a8e73e 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2595,7 +2595,10 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op) && o != NULL && o->state == COMP_OMP_STRUCTURED_BLOCK && (o->head->op == EXEC_OMP_DO - || o->head->op == EXEC_OMP_PARALLEL_DO)) + || o->head->op == EXEC_OMP_PARALLEL_DO + || o->head->op == EXEC_OMP_SIMD + || o->head->op == EXEC_OMP_DO_SIMD + || o->head->op == EXEC_OMP_PARALLEL_DO_SIMD)) { int collapse = 1; gcc_assert (o->head->next != NULL @@ -4564,6 +4567,30 @@ gfc_free_namelist (gfc_namelist *name) } +/* Free an OpenMP namelist structure. */ + +void +gfc_free_omp_namelist (gfc_omp_namelist *name) +{ + gfc_omp_namelist *n; + + for (; name; name = n) + { + gfc_free_expr (name->expr); + if (name->udr) + { + if (name->udr->combiner) + gfc_free_statement (name->udr->combiner); + if (name->udr->initializer) + gfc_free_statement (name->udr->initializer); + free (name->udr); + } + n = name->next; + free (name); + } +} + + /* Match a NAMELIST statement. */ match diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 385e84020eb..d07db11ef30 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -126,20 +126,46 @@ gfc_common_head *gfc_get_common (const char *, int); match gfc_match_omp_eos (void); match gfc_match_omp_atomic (void); match gfc_match_omp_barrier (void); +match gfc_match_omp_cancel (void); +match gfc_match_omp_cancellation_point (void); match gfc_match_omp_critical (void); +match gfc_match_omp_declare_reduction (void); +match gfc_match_omp_declare_simd (void); +match gfc_match_omp_declare_target (void); +match gfc_match_omp_distribute (void); +match gfc_match_omp_distribute_parallel_do (void); +match gfc_match_omp_distribute_parallel_do_simd (void); +match gfc_match_omp_distribute_simd (void); match gfc_match_omp_do (void); +match gfc_match_omp_do_simd (void); match gfc_match_omp_flush (void); match gfc_match_omp_master (void); match gfc_match_omp_ordered (void); match gfc_match_omp_parallel (void); match gfc_match_omp_parallel_do (void); +match gfc_match_omp_parallel_do_simd (void); match gfc_match_omp_parallel_sections (void); match gfc_match_omp_parallel_workshare (void); match gfc_match_omp_sections (void); +match gfc_match_omp_simd (void); match gfc_match_omp_single (void); +match gfc_match_omp_target (void); +match gfc_match_omp_target_data (void); +match gfc_match_omp_target_teams (void); +match gfc_match_omp_target_teams_distribute (void); +match gfc_match_omp_target_teams_distribute_parallel_do (void); +match gfc_match_omp_target_teams_distribute_parallel_do_simd (void); +match gfc_match_omp_target_teams_distribute_simd (void); +match gfc_match_omp_target_update (void); match gfc_match_omp_task (void); +match gfc_match_omp_taskgroup (void); match gfc_match_omp_taskwait (void); match gfc_match_omp_taskyield (void); +match gfc_match_omp_teams (void); +match gfc_match_omp_teams_distribute (void); +match gfc_match_omp_teams_distribute_parallel_do (void); +match gfc_match_omp_teams_distribute_parallel_do_simd (void); +match gfc_match_omp_teams_distribute_simd (void); match gfc_match_omp_threadprivate (void); match gfc_match_omp_workshare (void); match gfc_match_omp_end_nowait (void); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 52fdebe340c..2bfe1778433 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -83,6 +83,7 @@ along with GCC; see the file COPYING3. If not see /* Don't put any single quote (') in MOD_VERSION, if you want it to be recognized. */ #define MOD_VERSION "12" +#define MOD_VERSION_OMP4 "12 OpenMP 4" /* Structure that describes a position within a module file. */ @@ -196,6 +197,7 @@ static char* module_content; static long module_pos; static int module_line, module_column, only_flag; static int prev_module_line, prev_module_column; +static bool module_omp4; static enum { IO_INPUT, IO_OUTPUT } @@ -1877,7 +1879,7 @@ typedef enum AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP, AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION, AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER, - AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY + AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET } ab_attribute; @@ -1932,6 +1934,7 @@ static const mstring attr_bits[] = minit ("CLASS_POINTER", AB_CLASS_POINTER), minit ("IMPLICIT_PURE", AB_IMPLICIT_PURE), minit ("UNLIMITED_POLY", AB_UNLIMITED_POLY), + minit ("OMP_DECLARE_TARGET", AB_OMP_DECLARE_TARGET), minit (NULL, -1) }; @@ -2110,6 +2113,8 @@ mio_symbol_attribute (symbol_attribute *attr) MIO_NAME (ab_attribute) (AB_VTYPE, attr_bits); if (attr->vtab) MIO_NAME (ab_attribute) (AB_VTAB, attr_bits); + if (attr->omp_declare_target) + MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET, attr_bits); mio_rparen (); @@ -2273,6 +2278,9 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_VTAB: attr->vtab = 1; break; + case AB_OMP_DECLARE_TARGET: + attr->omp_declare_target = 1; + break; } } } @@ -3130,6 +3138,7 @@ static const mstring intrinsics[] = minit ("LE", INTRINSIC_LE_OS), minit ("NOT", INTRINSIC_NOT), minit ("PARENTHESES", INTRINSIC_PARENTHESES), + minit ("USER", INTRINSIC_USER), minit (NULL, -1) }; @@ -3166,7 +3175,8 @@ fix_mio_expr (gfc_expr *e) && !e->symtree->n.sym->attr.dummy) e->symtree = ns_st; } - else if (e->expr_type == EXPR_FUNCTION && e->value.function.name) + else if (e->expr_type == EXPR_FUNCTION + && (e->value.function.name || e->value.function.isym)) { gfc_symbol *sym; @@ -3281,6 +3291,32 @@ mio_expr (gfc_expr **ep) mio_expr (&e->value.op.op2); break; + case INTRINSIC_USER: + /* INTRINSIC_USER should not appear in resolved expressions, + though for UDRs we need to stream unresolved ones. */ + if (iomode == IO_OUTPUT) + write_atom (ATOM_STRING, e->value.op.uop->name); + else + { + char *name = read_string (); + const char *uop_name = find_use_name (name, true); + if (uop_name == NULL) + { + size_t len = strlen (name); + char *name2 = XCNEWVEC (char, len + 2); + memcpy (name2, name, len); + name2[len] = ' '; + name2[len + 1] = '\0'; + free (name); + uop_name = name = name2; + } + e->value.op.uop = gfc_get_uop (uop_name); + free (name); + } + mio_expr (&e->value.op.op1); + mio_expr (&e->value.op.op2); + break; + default: bad_module ("Bad operator"); } @@ -3299,6 +3335,8 @@ mio_expr (gfc_expr **ep) flag = 1; else if (e->ref) flag = 2; + else if (e->value.function.isym == NULL) + flag = 3; else flag = 0; mio_integer (&flag); @@ -3310,6 +3348,8 @@ mio_expr (gfc_expr **ep) case 2: mio_ref_list (&e->ref); break; + case 3: + break; default: write_atom (ATOM_STRING, e->value.function.isym->name); } @@ -3317,7 +3357,10 @@ mio_expr (gfc_expr **ep) else { require_atom (ATOM_STRING); - e->value.function.name = gfc_get_string (atom_string); + if (atom_string[0] == '\0') + e->value.function.name = NULL; + else + e->value.function.name = gfc_get_string (atom_string); free (atom_string); mio_integer (&flag); @@ -3329,6 +3372,8 @@ mio_expr (gfc_expr **ep) case 2: mio_ref_list (&e->ref); break; + case 3: + break; default: require_atom (ATOM_STRING); e->value.function.isym = gfc_find_function (atom_string); @@ -3790,6 +3835,203 @@ mio_full_f2k_derived (gfc_symbol *sym) mio_rparen (); } +static const mstring omp_declare_simd_clauses[] = +{ + minit ("INBRANCH", 0), + minit ("NOTINBRANCH", 1), + minit ("SIMDLEN", 2), + minit ("UNIFORM", 3), + minit ("LINEAR", 4), + minit ("ALIGNED", 5), + minit (NULL, -1) +}; + +/* Handle !$omp declare simd. */ + +static void +mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp) +{ + if (iomode == IO_OUTPUT) + { + if (*odsp == NULL) + return; + } + else if (peek_atom () != ATOM_LPAREN) + return; + + gfc_omp_declare_simd *ods = *odsp; + + mio_lparen (); + if (iomode == IO_OUTPUT) + { + write_atom (ATOM_NAME, "OMP_DECLARE_SIMD"); + if (ods->clauses) + { + gfc_omp_namelist *n; + + if (ods->clauses->inbranch) + mio_name (0, omp_declare_simd_clauses); + if (ods->clauses->notinbranch) + mio_name (1, omp_declare_simd_clauses); + if (ods->clauses->simdlen_expr) + { + mio_name (2, omp_declare_simd_clauses); + mio_expr (&ods->clauses->simdlen_expr); + } + for (n = ods->clauses->lists[OMP_LIST_UNIFORM]; n; n = n->next) + { + mio_name (3, omp_declare_simd_clauses); + mio_symbol_ref (&n->sym); + } + for (n = ods->clauses->lists[OMP_LIST_LINEAR]; n; n = n->next) + { + mio_name (4, omp_declare_simd_clauses); + mio_symbol_ref (&n->sym); + mio_expr (&n->expr); + } + for (n = ods->clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + { + mio_name (5, omp_declare_simd_clauses); + mio_symbol_ref (&n->sym); + mio_expr (&n->expr); + } + } + } + else + { + gfc_omp_namelist **ptrs[3] = { NULL, NULL, NULL }; + + require_atom (ATOM_NAME); + *odsp = ods = gfc_get_omp_declare_simd (); + ods->where = gfc_current_locus; + ods->proc_name = ns->proc_name; + if (peek_atom () == ATOM_NAME) + { + ods->clauses = gfc_get_omp_clauses (); + ptrs[0] = &ods->clauses->lists[OMP_LIST_UNIFORM]; + ptrs[1] = &ods->clauses->lists[OMP_LIST_LINEAR]; + ptrs[2] = &ods->clauses->lists[OMP_LIST_ALIGNED]; + } + while (peek_atom () == ATOM_NAME) + { + gfc_omp_namelist *n; + int t = mio_name (0, omp_declare_simd_clauses); + + switch (t) + { + case 0: ods->clauses->inbranch = true; break; + case 1: ods->clauses->notinbranch = true; break; + case 2: mio_expr (&ods->clauses->simdlen_expr); break; + case 3: + case 4: + case 5: + *ptrs[t - 3] = n = gfc_get_omp_namelist (); + ptrs[t - 3] = &n->next; + mio_symbol_ref (&n->sym); + if (t != 3) + mio_expr (&n->expr); + break; + } + } + } + + mio_omp_declare_simd (ns, &ods->next); + + mio_rparen (); +} + + +static const mstring omp_declare_reduction_stmt[] = +{ + minit ("ASSIGN", 0), + minit ("CALL", 1), + minit (NULL, -1) +}; + + +static void +mio_omp_udr_expr (gfc_omp_udr *udr, gfc_symbol **sym1, gfc_symbol **sym2, + gfc_namespace *ns, bool is_initializer) +{ + if (iomode == IO_OUTPUT) + { + if ((*sym1)->module == NULL) + { + (*sym1)->module = module_name; + (*sym2)->module = module_name; + } + mio_symbol_ref (sym1); + mio_symbol_ref (sym2); + if (ns->code->op == EXEC_ASSIGN) + { + mio_name (0, omp_declare_reduction_stmt); + mio_expr (&ns->code->expr1); + mio_expr (&ns->code->expr2); + } + else + { + int flag; + mio_name (1, omp_declare_reduction_stmt); + mio_symtree_ref (&ns->code->symtree); + mio_actual_arglist (&ns->code->ext.actual); + + flag = ns->code->resolved_isym != NULL; + mio_integer (&flag); + if (flag) + write_atom (ATOM_STRING, ns->code->resolved_isym->name); + else + mio_symbol_ref (&ns->code->resolved_sym); + } + } + else + { + pointer_info *p1 = mio_symbol_ref (sym1); + pointer_info *p2 = mio_symbol_ref (sym2); + gfc_symbol *sym; + gcc_assert (p1->u.rsym.ns == p2->u.rsym.ns); + gcc_assert (p1->u.rsym.sym == NULL); + /* Add hidden symbols to the symtree. */ + pointer_info *q = get_integer (p1->u.rsym.ns); + q->u.pointer = (void *) ns; + sym = gfc_new_symbol (is_initializer ? "omp_priv" : "omp_out", ns); + sym->ts = udr->ts; + sym->module = gfc_get_string (p1->u.rsym.module); + associate_integer_pointer (p1, sym); + sym->attr.omp_udr_artificial_var = 1; + gcc_assert (p2->u.rsym.sym == NULL); + sym = gfc_new_symbol (is_initializer ? "omp_orig" : "omp_in", ns); + sym->ts = udr->ts; + sym->module = gfc_get_string (p2->u.rsym.module); + associate_integer_pointer (p2, sym); + sym->attr.omp_udr_artificial_var = 1; + if (mio_name (0, omp_declare_reduction_stmt) == 0) + { + ns->code = gfc_get_code (EXEC_ASSIGN); + mio_expr (&ns->code->expr1); + mio_expr (&ns->code->expr2); + } + else + { + int flag; + ns->code = gfc_get_code (EXEC_CALL); + mio_symtree_ref (&ns->code->symtree); + mio_actual_arglist (&ns->code->ext.actual); + + mio_integer (&flag); + if (flag) + { + require_atom (ATOM_STRING); + ns->code->resolved_isym = gfc_find_subroutine (atom_string); + free (atom_string); + } + else + mio_symbol_ref (&ns->code->resolved_sym); + } + ns->code->loc = gfc_current_locus; + ns->omp_udr_ns = 1; + } +} + /* Unlike most other routines, the address of the symbol node is already fixed on input and the name/module has already been filled in. @@ -3864,6 +4106,17 @@ mio_symbol (gfc_symbol *sym) if (sym->attr.flavor == FL_DERIVED) mio_integer (&(sym->hash_value)); + if (sym->formal_ns + && sym->formal_ns->proc_name == sym + && sym->formal_ns->entries == NULL) + { + if (module_omp4) + mio_omp_declare_simd (sym->formal_ns, + &sym->formal_ns->omp_declare_simd); + else if (iomode == IO_OUTPUT) + gcc_assert (sym->formal_ns->omp_declare_simd == NULL); + } + mio_rparen (); } @@ -4343,6 +4596,119 @@ load_derived_extensions (void) } +/* This function loads OpenMP user defined reductions. */ +static void +load_omp_udrs (void) +{ + mio_lparen (); + while (peek_atom () != ATOM_RPAREN) + { + const char *name, *newname; + char *altname; + gfc_typespec ts; + gfc_symtree *st; + gfc_omp_reduction_op rop = OMP_REDUCTION_USER; + + mio_lparen (); + mio_pool_string (&name); + mio_typespec (&ts); + if (strncmp (name, "operator ", sizeof ("operator ") - 1) == 0) + { + const char *p = name + sizeof ("operator ") - 1; + if (strcmp (p, "+") == 0) + rop = OMP_REDUCTION_PLUS; + else if (strcmp (p, "*") == 0) + rop = OMP_REDUCTION_TIMES; + else if (strcmp (p, "-") == 0) + rop = OMP_REDUCTION_MINUS; + else if (strcmp (p, ".and.") == 0) + rop = OMP_REDUCTION_AND; + else if (strcmp (p, ".or.") == 0) + rop = OMP_REDUCTION_OR; + else if (strcmp (p, ".eqv.") == 0) + rop = OMP_REDUCTION_EQV; + else if (strcmp (p, ".neqv.") == 0) + rop = OMP_REDUCTION_NEQV; + } + altname = NULL; + if (rop == OMP_REDUCTION_USER && name[0] == '.') + { + size_t len = strlen (name + 1); + altname = XALLOCAVEC (char, len); + gcc_assert (name[len] == '.'); + memcpy (altname, name + 1, len - 1); + altname[len - 1] = '\0'; + } + newname = name; + if (rop == OMP_REDUCTION_USER) + newname = find_use_name (altname ? altname : name, !!altname); + else if (only_flag && find_use_operator ((gfc_intrinsic_op) rop) == NULL) + newname = NULL; + if (newname == NULL) + { + skip_list (1); + continue; + } + if (altname && newname != altname) + { + size_t len = strlen (newname); + altname = XALLOCAVEC (char, len + 3); + altname[0] = '.'; + memcpy (altname + 1, newname, len); + altname[len + 1] = '.'; + altname[len + 2] = '\0'; + name = gfc_get_string (altname); + } + st = gfc_find_symtree (gfc_current_ns->omp_udr_root, name); + gfc_omp_udr *udr = gfc_omp_udr_find (st, &ts); + if (udr) + { + require_atom (ATOM_INTEGER); + pointer_info *p = get_integer (atom_int); + if (strcmp (p->u.rsym.module, udr->omp_out->module)) + { + gfc_error ("Ambiguous !$OMP DECLARE REDUCTION from " + "module %s at %L", + p->u.rsym.module, &gfc_current_locus); + gfc_error ("Previous !$OMP DECLARE REDUCTION from module " + "%s at %L", + udr->omp_out->module, &udr->where); + } + skip_list (1); + continue; + } + udr = gfc_get_omp_udr (); + udr->name = name; + udr->rop = rop; + udr->ts = ts; + udr->where = gfc_current_locus; + udr->combiner_ns = gfc_get_namespace (gfc_current_ns, 1); + udr->combiner_ns->proc_name = gfc_current_ns->proc_name; + mio_omp_udr_expr (udr, &udr->omp_out, &udr->omp_in, udr->combiner_ns, + false); + if (peek_atom () != ATOM_RPAREN) + { + udr->initializer_ns = gfc_get_namespace (gfc_current_ns, 1); + udr->initializer_ns->proc_name = gfc_current_ns->proc_name; + mio_omp_udr_expr (udr, &udr->omp_priv, &udr->omp_orig, + udr->initializer_ns, true); + } + if (st) + { + udr->next = st->n.omp_udr; + st->n.omp_udr = udr; + } + else + { + st = gfc_new_symtree (&gfc_current_ns->omp_udr_root, name); + st->n.omp_udr = udr; + } + mio_rparen (); + } + mio_rparen (); +} + + /* Recursive function to traverse the pointer_info tree and load a needed symbol. We return nonzero if we load a symbol and stop the traversal, because the act of loading can alter the tree. */ @@ -4530,7 +4896,7 @@ check_for_ambiguous (gfc_symbol *st_sym, pointer_info *info) static void read_module (void) { - module_locus operator_interfaces, user_operators, extensions; + module_locus operator_interfaces, user_operators, extensions, omp_udrs; const char *p; char name[GFC_MAX_SYMBOL_LEN + 1]; int i; @@ -4554,6 +4920,11 @@ read_module (void) get_module_locus (&extensions); skip_list (); + /* Skip OpenMP UDRs. */ + get_module_locus (&omp_udrs); + if (module_omp4) + skip_list (); + mio_lparen (); /* Create the fixup nodes for all the symbols. */ @@ -4819,6 +5190,13 @@ read_module (void) load_commons (); load_equiv (); + if (module_omp4) + { + /* Load OpenMP user defined reductions. */ + set_module_locus (&omp_udrs); + load_omp_udrs (); + } + /* At this point, we read those symbols that are needed but haven't been loaded yet. If one symbol requires another, the other gets marked as NEEDED if its previous state was UNUSED. */ @@ -5197,6 +5575,80 @@ write_symbol0 (gfc_symtree *st) } +static void +write_omp_udr (gfc_omp_udr *udr) +{ + switch (udr->rop) + { + case OMP_REDUCTION_USER: + /* Non-operators can't be used outside of the module. */ + if (udr->name[0] != '.') + return; + else + { + gfc_symtree *st; + size_t len = strlen (udr->name + 1); + char *name = XALLOCAVEC (char, len); + memcpy (name, udr->name, len - 1); + name[len - 1] = '\0'; + st = gfc_find_symtree (gfc_current_ns->uop_root, name); + /* If corresponding user operator is private, don't write + the UDR. */ + if (st != NULL) + { + gfc_user_op *uop = st->n.uop; + if (!check_access (uop->access, uop->ns->default_access)) + return; + } + } + break; + case OMP_REDUCTION_PLUS: + case OMP_REDUCTION_MINUS: + case OMP_REDUCTION_TIMES: + case OMP_REDUCTION_AND: + case OMP_REDUCTION_OR: + case OMP_REDUCTION_EQV: + case OMP_REDUCTION_NEQV: + /* If corresponding operator is private, don't write the UDR. */ + if (!check_access (gfc_current_ns->operator_access[udr->rop], + gfc_current_ns->default_access)) + return; + break; + default: + break; + } + if (udr->ts.type == BT_DERIVED || udr->ts.type == BT_CLASS) + { + /* If derived type is private, don't write the UDR. */ + if (!gfc_check_symbol_access (udr->ts.u.derived)) + return; + } + + mio_lparen (); + mio_pool_string (&udr->name); + mio_typespec (&udr->ts); + mio_omp_udr_expr (udr, &udr->omp_out, &udr->omp_in, udr->combiner_ns, false); + if (udr->initializer_ns) + mio_omp_udr_expr (udr, &udr->omp_priv, &udr->omp_orig, + udr->initializer_ns, true); + mio_rparen (); +} + + +static void +write_omp_udrs (gfc_symtree *st) +{ + if (st == NULL) + return; + + write_omp_udrs (st->left); + gfc_omp_udr *udr; + for (udr = st->n.omp_udr; udr; udr = udr->next) + write_omp_udr (udr); + write_omp_udrs (st->right); +} + + /* Type for the temporary tree used when writing secondary symbols. */ struct sorted_pointer_info @@ -5445,6 +5897,17 @@ write_module (void) write_char ('\n'); write_char ('\n'); + if (module_omp4) + { + mio_lparen (); + write_omp_udrs (gfc_current_ns->omp_udr_root); + mio_rparen (); + write_char ('\n'); + write_char ('\n'); + } + else + gcc_assert (gfc_current_ns->omp_udr_root == NULL); + /* Write symbol information. First we traverse all symbols in the primary namespace, writing those that need to be written. Sometimes writing one symbol will cause another to need to be @@ -5513,6 +5976,21 @@ read_crc32_from_module_file (const char* filename, uLong* crc) } +/* Set module_omp4 if any symbol has !$OMP DECLARE SIMD directives. */ + +static void +find_omp_declare_simd (gfc_symtree *st) +{ + gfc_symbol *sym = st->n.sym; + if (sym->formal_ns + && sym->formal_ns->proc_name == sym + && sym->formal_ns->omp_declare_simd) + module_omp4 = true; + else if (sym->attr.omp_declare_target) + module_omp4 = true; +} + + /* Given module, dump it to disk. If there was an error while processing the module, dump_flag will be set to zero and we delete the module file, even if it was already there. */ @@ -5555,6 +6033,12 @@ gfc_dump_module (const char *name, int dump_flag) if (gfc_cpp_makedep ()) gfc_cpp_add_target (filename); + module_omp4 = false; + if (gfc_current_ns->omp_udr_root) + module_omp4 = true; + else + gfc_traverse_symtree (gfc_current_ns->sym_root, find_omp_declare_simd); + /* Write the module to the temporary file. */ module_fp = gzopen (filename_tmp, "w"); if (module_fp == NULL) @@ -5562,7 +6046,7 @@ gfc_dump_module (const char *name, int dump_flag) filename_tmp, xstrerror (errno)); gzprintf (module_fp, "GFORTRAN module version '%s' created from %s\n", - MOD_VERSION, gfc_source_file); + module_omp4 ? MOD_VERSION_OMP4 : MOD_VERSION, gfc_source_file); /* Write the module itself. */ iomode = IO_OUTPUT; @@ -6353,6 +6837,8 @@ gfc_use_module (gfc_use_list *module) read_module_to_tmpbuf (); gzclose (module_fp); + module_omp4 = false; + /* Skip the first line of the module, after checking that this is a gfortran module file. */ line = 0; @@ -6372,11 +6858,15 @@ gfc_use_module (gfc_use_list *module) if (strcmp (atom_name, " version") != 0 || module_char () != ' ' || parse_atom () != ATOM_STRING - || strcmp (atom_string, MOD_VERSION)) + || (strcmp (atom_string, MOD_VERSION) + && strcmp (atom_string, MOD_VERSION_OMP4))) gfc_fatal_error ("Cannot read module file '%s' opened at %C," " because it was created by a different" " version of GNU Fortran", filename); + if (strcmp (atom_string, MOD_VERSION_OMP4) == 0) + module_omp4 = true; + free (atom_string); } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index dff3ab1ad91..68ba70f7ebe 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -23,6 +23,7 @@ along with GCC; see the file COPYING3. If not see #include "coretypes.h" #include "flags.h" #include "gfortran.h" +#include "arith.h" #include "match.h" #include "parse.h" #include "pointer-set.h" @@ -69,19 +70,111 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->final_expr); gfc_free_expr (c->num_threads); gfc_free_expr (c->chunk_size); + gfc_free_expr (c->safelen_expr); + gfc_free_expr (c->simdlen_expr); + gfc_free_expr (c->num_teams); + gfc_free_expr (c->device); + gfc_free_expr (c->thread_limit); + gfc_free_expr (c->dist_chunk_size); for (i = 0; i < OMP_LIST_NUM; i++) - gfc_free_namelist (c->lists[i]); + gfc_free_omp_namelist (c->lists[i]); free (c); } +/* Free an !$omp declare simd construct list. */ + +void +gfc_free_omp_declare_simd (gfc_omp_declare_simd *ods) +{ + if (ods) + { + gfc_free_omp_clauses (ods->clauses); + free (ods); + } +} + +void +gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *list) +{ + while (list) + { + gfc_omp_declare_simd *current = list; + list = list->next; + gfc_free_omp_declare_simd (current); + } +} + +/* Free an !$omp declare reduction. */ + +void +gfc_free_omp_udr (gfc_omp_udr *omp_udr) +{ + if (omp_udr) + { + gfc_free_omp_udr (omp_udr->next); + gfc_free_namespace (omp_udr->combiner_ns); + if (omp_udr->initializer_ns) + gfc_free_namespace (omp_udr->initializer_ns); + free (omp_udr); + } +} + + +static gfc_omp_udr * +gfc_find_omp_udr (gfc_namespace *ns, const char *name, gfc_typespec *ts) +{ + gfc_symtree *st; + + if (ns == NULL) + ns = gfc_current_ns; + do + { + gfc_omp_udr *omp_udr; + + st = gfc_find_symtree (ns->omp_udr_root, name); + if (st != NULL) + for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next) + if (ts == NULL) + return omp_udr; + else if (gfc_compare_types (&omp_udr->ts, ts)) + { + if (ts->type == BT_CHARACTER) + { + if (omp_udr->ts.u.cl->length == NULL) + return omp_udr; + if (ts->u.cl->length == NULL) + continue; + if (gfc_compare_expr (omp_udr->ts.u.cl->length, + ts->u.cl->length, + INTRINSIC_EQ) != 0) + continue; + } + return omp_udr; + } + + /* Don't escape an interface block. */ + if (ns && !ns->has_import_set + && ns->proc_name && ns->proc_name->attr.if_source == IFSRC_IFBODY) + break; + + ns = ns->parent; + } + while (ns != NULL); + + return NULL; +} + + /* Match a variable/common block list and construct a namelist from it. */ static match -gfc_match_omp_variable_list (const char *str, gfc_namelist **list, - bool allow_common) +gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, + bool allow_common, bool *end_colon = NULL, + gfc_omp_namelist ***headp = NULL, + bool allow_sections = false) { - gfc_namelist *head, *tail, *p; - locus old_loc; + gfc_omp_namelist *head, *tail, *p; + locus old_loc, cur_loc; char n[GFC_MAX_SYMBOL_LEN+1]; gfc_symbol *sym; match m; @@ -97,12 +190,29 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, for (;;) { + cur_loc = gfc_current_locus; m = gfc_match_symbol (&sym, 1); switch (m) { case MATCH_YES: + gfc_expr *expr; + expr = NULL; + if (allow_sections && gfc_peek_ascii_char () == '(') + { + gfc_current_locus = cur_loc; + m = gfc_match_variable (&expr, 0); + switch (m) + { + case MATCH_ERROR: + goto cleanup; + case MATCH_NO: + goto syntax; + default: + break; + } + } gfc_set_sym_referenced (sym); - p = gfc_get_namelist (); + p = gfc_get_omp_namelist (); if (head == NULL) head = tail = p; else @@ -111,6 +221,7 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, tail = tail->next; } tail->sym = sym; + tail->expr = expr; goto next_item; case MATCH_NO: break; @@ -136,7 +247,7 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, for (sym = st->n.common->head; sym; sym = sym->common_next) { gfc_set_sym_referenced (sym); - p = gfc_get_namelist (); + p = gfc_get_omp_namelist (); if (head == NULL) head = tail = p; else @@ -148,6 +259,11 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, } next_item: + if (end_colon && gfc_match_char (':') == MATCH_YES) + { + *end_colon = true; + break; + } if (gfc_match_char (')') == MATCH_YES) break; if (gfc_match_char (',') != MATCH_YES) @@ -158,43 +274,61 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, list = &(*list)->next; *list = head; + if (headp) + *headp = list; return MATCH_YES; syntax: gfc_error ("Syntax error in OpenMP variable list at %C"); cleanup: - gfc_free_namelist (head); + gfc_free_omp_namelist (head); gfc_current_locus = old_loc; return MATCH_ERROR; } -#define OMP_CLAUSE_PRIVATE (1 << 0) -#define OMP_CLAUSE_FIRSTPRIVATE (1 << 1) -#define OMP_CLAUSE_LASTPRIVATE (1 << 2) -#define OMP_CLAUSE_COPYPRIVATE (1 << 3) -#define OMP_CLAUSE_SHARED (1 << 4) -#define OMP_CLAUSE_COPYIN (1 << 5) -#define OMP_CLAUSE_REDUCTION (1 << 6) -#define OMP_CLAUSE_IF (1 << 7) -#define OMP_CLAUSE_NUM_THREADS (1 << 8) -#define OMP_CLAUSE_SCHEDULE (1 << 9) -#define OMP_CLAUSE_DEFAULT (1 << 10) -#define OMP_CLAUSE_ORDERED (1 << 11) -#define OMP_CLAUSE_COLLAPSE (1 << 12) -#define OMP_CLAUSE_UNTIED (1 << 13) -#define OMP_CLAUSE_FINAL (1 << 14) -#define OMP_CLAUSE_MERGEABLE (1 << 15) +#define OMP_CLAUSE_PRIVATE (1U << 0) +#define OMP_CLAUSE_FIRSTPRIVATE (1U << 1) +#define OMP_CLAUSE_LASTPRIVATE (1U << 2) +#define OMP_CLAUSE_COPYPRIVATE (1U << 3) +#define OMP_CLAUSE_SHARED (1U << 4) +#define OMP_CLAUSE_COPYIN (1U << 5) +#define OMP_CLAUSE_REDUCTION (1U << 6) +#define OMP_CLAUSE_IF (1U << 7) +#define OMP_CLAUSE_NUM_THREADS (1U << 8) +#define OMP_CLAUSE_SCHEDULE (1U << 9) +#define OMP_CLAUSE_DEFAULT (1U << 10) +#define OMP_CLAUSE_ORDERED (1U << 11) +#define OMP_CLAUSE_COLLAPSE (1U << 12) +#define OMP_CLAUSE_UNTIED (1U << 13) +#define OMP_CLAUSE_FINAL (1U << 14) +#define OMP_CLAUSE_MERGEABLE (1U << 15) +#define OMP_CLAUSE_ALIGNED (1U << 16) +#define OMP_CLAUSE_DEPEND (1U << 17) +#define OMP_CLAUSE_INBRANCH (1U << 18) +#define OMP_CLAUSE_LINEAR (1U << 19) +#define OMP_CLAUSE_NOTINBRANCH (1U << 20) +#define OMP_CLAUSE_PROC_BIND (1U << 21) +#define OMP_CLAUSE_SAFELEN (1U << 22) +#define OMP_CLAUSE_SIMDLEN (1U << 23) +#define OMP_CLAUSE_UNIFORM (1U << 24) +#define OMP_CLAUSE_DEVICE (1U << 25) +#define OMP_CLAUSE_MAP (1U << 26) +#define OMP_CLAUSE_TO (1U << 27) +#define OMP_CLAUSE_FROM (1U << 28) +#define OMP_CLAUSE_NUM_TEAMS (1U << 29) +#define OMP_CLAUSE_THREAD_LIMIT (1U << 30) +#define OMP_CLAUSE_DIST_SCHEDULE (1U << 31) /* Match OpenMP directive clauses. MASK is a bitmask of clauses that are allowed for a particular directive. */ static match -gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) +gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned int mask, + bool first = true, bool needs_space = true) { gfc_omp_clauses *c = gfc_get_omp_clauses (); locus old_loc; - bool needs_space = true, first = true; *cp = NULL; while (1) @@ -251,22 +385,30 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) if ((mask & OMP_CLAUSE_REDUCTION) && gfc_match ("reduction ( ") == MATCH_YES) { - int reduction = OMP_LIST_NUM; - char buffer[GFC_MAX_SYMBOL_LEN + 1]; + gfc_omp_reduction_op rop = OMP_REDUCTION_NONE; + char buffer[GFC_MAX_SYMBOL_LEN + 3]; if (gfc_match_char ('+') == MATCH_YES) - reduction = OMP_LIST_PLUS; + rop = OMP_REDUCTION_PLUS; else if (gfc_match_char ('*') == MATCH_YES) - reduction = OMP_LIST_MULT; + rop = OMP_REDUCTION_TIMES; else if (gfc_match_char ('-') == MATCH_YES) - reduction = OMP_LIST_SUB; + rop = OMP_REDUCTION_MINUS; else if (gfc_match (".and.") == MATCH_YES) - reduction = OMP_LIST_AND; + rop = OMP_REDUCTION_AND; else if (gfc_match (".or.") == MATCH_YES) - reduction = OMP_LIST_OR; + rop = OMP_REDUCTION_OR; else if (gfc_match (".eqv.") == MATCH_YES) - reduction = OMP_LIST_EQV; + rop = OMP_REDUCTION_EQV; else if (gfc_match (".neqv.") == MATCH_YES) - reduction = OMP_LIST_NEQV; + rop = OMP_REDUCTION_NEQV; + if (rop != OMP_REDUCTION_NONE) + snprintf (buffer, sizeof buffer, + "operator %s", gfc_op2string ((gfc_intrinsic_op) rop)); + else if (gfc_match_defined_op_name (buffer + 1, 1) == MATCH_YES) + { + buffer[0] = '.'; + strcat (buffer, "."); + } else if (gfc_match_name (buffer) == MATCH_YES) { gfc_symbol *sym; @@ -294,40 +436,64 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) || sym->attr.if_source != IFSRC_UNKNOWN || sym == sym->ns->proc_name) { - gfc_error_now ("%s is not INTRINSIC procedure name " - "at %C", buffer); sym = NULL; + n = NULL; } else n = sym->name; } - if (strcmp (n, "max") == 0) - reduction = OMP_LIST_MAX; + if (n == NULL) + rop = OMP_REDUCTION_NONE; + else if (strcmp (n, "max") == 0) + rop = OMP_REDUCTION_MAX; else if (strcmp (n, "min") == 0) - reduction = OMP_LIST_MIN; + rop = OMP_REDUCTION_MIN; else if (strcmp (n, "iand") == 0) - reduction = OMP_LIST_IAND; + rop = OMP_REDUCTION_IAND; else if (strcmp (n, "ior") == 0) - reduction = OMP_LIST_IOR; + rop = OMP_REDUCTION_IOR; else if (strcmp (n, "ieor") == 0) - reduction = OMP_LIST_IEOR; - if (reduction != OMP_LIST_NUM + rop = OMP_REDUCTION_IEOR; + if (rop != OMP_REDUCTION_NONE && sym != NULL && ! sym->attr.intrinsic && ! sym->attr.use_assoc && ((sym->attr.flavor == FL_UNKNOWN - && !gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, NULL)) + && !gfc_add_flavor (&sym->attr, FL_PROCEDURE, + sym->name, NULL)) || !gfc_add_intrinsic (&sym->attr, NULL))) + rop = OMP_REDUCTION_NONE; + } + gfc_omp_udr *udr = gfc_find_omp_udr (gfc_current_ns, buffer, NULL); + gfc_omp_namelist **head = NULL; + if (rop == OMP_REDUCTION_NONE && udr) + rop = OMP_REDUCTION_USER; + + if (gfc_match_omp_variable_list (" :", + &c->lists[OMP_LIST_REDUCTION], + false, NULL, &head) == MATCH_YES) + { + gfc_omp_namelist *n; + if (rop == OMP_REDUCTION_NONE) { - gfc_free_omp_clauses (c); - return MATCH_ERROR; + n = *head; + *head = NULL; + gfc_error_now ("!$OMP DECLARE REDUCTION %s not found " + "at %L", buffer, &old_loc); + gfc_free_omp_namelist (n); } + else + for (n = *head; n; n = n->next) + { + n->u.reduction_op = rop; + if (udr) + { + n->udr = gfc_get_omp_namelist_udr (); + n->udr->udr = udr; + } + } + continue; } - if (reduction != OMP_LIST_NUM - && gfc_match_omp_variable_list (" :", &c->lists[reduction], - false) - == MATCH_YES) - continue; else gfc_current_locus = old_loc; } @@ -419,6 +585,188 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) continue; } } + if ((mask & OMP_CLAUSE_INBRANCH) && !c->inbranch && !c->notinbranch + && gfc_match ("inbranch") == MATCH_YES) + { + c->inbranch = needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_NOTINBRANCH) && !c->notinbranch && !c->inbranch + && gfc_match ("notinbranch") == MATCH_YES) + { + c->notinbranch = needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_PROC_BIND) + && c->proc_bind == OMP_PROC_BIND_UNKNOWN) + { + if (gfc_match ("proc_bind ( master )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_MASTER; + else if (gfc_match ("proc_bind ( spread )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_SPREAD; + else if (gfc_match ("proc_bind ( close )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_CLOSE; + if (c->proc_bind != OMP_PROC_BIND_UNKNOWN) + continue; + } + if ((mask & OMP_CLAUSE_SAFELEN) && c->safelen_expr == NULL + && gfc_match ("safelen ( %e )", &c->safelen_expr) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_SIMDLEN) && c->simdlen_expr == NULL + && gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_UNIFORM) + && gfc_match_omp_variable_list ("uniform (", + &c->lists[OMP_LIST_UNIFORM], false) + == MATCH_YES) + continue; + bool end_colon = false; + gfc_omp_namelist **head = NULL; + old_loc = gfc_current_locus; + if ((mask & OMP_CLAUSE_ALIGNED) + && gfc_match_omp_variable_list ("aligned (", + &c->lists[OMP_LIST_ALIGNED], false, + &end_colon, &head) + == MATCH_YES) + { + gfc_expr *alignment = NULL; + gfc_omp_namelist *n; + + if (end_colon + && gfc_match (" %e )", &alignment) != MATCH_YES) + { + gfc_free_omp_namelist (*head); + gfc_current_locus = old_loc; + *head = NULL; + break; + } + for (n = *head; n; n = n->next) + if (n->next && alignment) + n->expr = gfc_copy_expr (alignment); + else + n->expr = alignment; + continue; + } + end_colon = false; + head = NULL; + old_loc = gfc_current_locus; + if ((mask & OMP_CLAUSE_LINEAR) + && gfc_match_omp_variable_list ("linear (", + &c->lists[OMP_LIST_LINEAR], false, + &end_colon, &head) + == MATCH_YES) + { + gfc_expr *step = NULL; + + if (end_colon + && gfc_match (" %e )", &step) != MATCH_YES) + { + gfc_free_omp_namelist (*head); + gfc_current_locus = old_loc; + *head = NULL; + break; + } + else if (!end_colon) + { + step = gfc_get_constant_expr (BT_INTEGER, + gfc_default_integer_kind, + &old_loc); + mpz_set_si (step->value.integer, 1); + } + (*head)->expr = step; + continue; + } + if ((mask & OMP_CLAUSE_DEPEND) + && gfc_match ("depend ( ") == MATCH_YES) + { + match m = MATCH_YES; + gfc_omp_depend_op depend_op = OMP_DEPEND_OUT; + if (gfc_match ("inout") == MATCH_YES) + depend_op = OMP_DEPEND_INOUT; + else if (gfc_match ("in") == MATCH_YES) + depend_op = OMP_DEPEND_IN; + else if (gfc_match ("out") == MATCH_YES) + depend_op = OMP_DEPEND_OUT; + else + m = MATCH_NO; + head = NULL; + if (m == MATCH_YES + && gfc_match_omp_variable_list (" : ", + &c->lists[OMP_LIST_DEPEND], + false, NULL, &head, true) + == MATCH_YES) + { + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + n->u.depend_op = depend_op; + continue; + } + else + gfc_current_locus = old_loc; + } + if ((mask & OMP_CLAUSE_DIST_SCHEDULE) + && c->dist_sched_kind == OMP_SCHED_NONE + && gfc_match ("dist_schedule ( static") == MATCH_YES) + { + match m = MATCH_NO; + c->dist_sched_kind = OMP_SCHED_STATIC; + m = gfc_match (" , %e )", &c->dist_chunk_size); + if (m != MATCH_YES) + m = gfc_match_char (')'); + if (m != MATCH_YES) + { + c->dist_sched_kind = OMP_SCHED_NONE; + gfc_current_locus = old_loc; + } + else + continue; + } + if ((mask & OMP_CLAUSE_NUM_TEAMS) && c->num_teams == NULL + && gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_DEVICE) && c->device == NULL + && gfc_match ("device ( %e )", &c->device) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_THREAD_LIMIT) && c->thread_limit == NULL + && gfc_match ("thread_limit ( %e )", &c->thread_limit) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_MAP) + && gfc_match ("map ( ") == MATCH_YES) + { + gfc_omp_map_op map_op = OMP_MAP_TOFROM; + if (gfc_match ("alloc : ") == MATCH_YES) + map_op = OMP_MAP_ALLOC; + else if (gfc_match ("tofrom : ") == MATCH_YES) + map_op = OMP_MAP_TOFROM; + else if (gfc_match ("to : ") == MATCH_YES) + map_op = OMP_MAP_TO; + else if (gfc_match ("from : ") == MATCH_YES) + map_op = OMP_MAP_FROM; + head = NULL; + if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP], + false, NULL, &head, true) + == MATCH_YES) + { + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + n->u.map_op = map_op; + continue; + } + else + gfc_current_locus = old_loc; + } + if ((mask & OMP_CLAUSE_TO) + && gfc_match_omp_variable_list ("to (", + &c->lists[OMP_LIST_TO], false, + NULL, &head, true) + == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_FROM) + && gfc_match_omp_variable_list ("from (", + &c->lists[OMP_LIST_FROM], false, + NULL, &head, true) + == MATCH_YES) + continue; break; } @@ -436,7 +784,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) #define OMP_PARALLEL_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \ | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \ - | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT) + | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PROC_BIND) +#define OMP_DECLARE_SIMD_CLAUSES \ + (OMP_CLAUSE_SIMDLEN | OMP_CLAUSE_LINEAR | OMP_CLAUSE_UNIFORM \ + | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH | OMP_CLAUSE_NOTINBRANCH) #define OMP_DO_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ @@ -444,107 +795,633 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) #define OMP_SECTIONS_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) +#define OMP_SIMD_CLAUSES \ + (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ + | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN | OMP_CLAUSE_LINEAR \ + | OMP_CLAUSE_ALIGNED) #define OMP_TASK_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \ | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \ - | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE) + | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_DEPEND) +#define OMP_TARGET_CLAUSES \ + (OMP_CLAUSE_DEVICE | OMP_CLAUSE_MAP | OMP_CLAUSE_IF) +#define OMP_TARGET_DATA_CLAUSES \ + (OMP_CLAUSE_DEVICE | OMP_CLAUSE_MAP | OMP_CLAUSE_IF) +#define OMP_TARGET_UPDATE_CLAUSES \ + (OMP_CLAUSE_DEVICE | OMP_CLAUSE_IF | OMP_CLAUSE_TO | OMP_CLAUSE_FROM) +#define OMP_TEAMS_CLAUSES \ + (OMP_CLAUSE_NUM_TEAMS | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_DEFAULT \ + | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \ + | OMP_CLAUSE_REDUCTION) +#define OMP_DISTRIBUTE_CLAUSES \ + (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_COLLAPSE \ + | OMP_CLAUSE_DIST_SCHEDULE) -match -gfc_match_omp_parallel (void) -{ - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES) != MATCH_YES) - return MATCH_ERROR; - new_st.op = EXEC_OMP_PARALLEL; - new_st.ext.omp_clauses = c; - return MATCH_YES; -} - -match -gfc_match_omp_task (void) +static match +match_omp (gfc_exec_op op, unsigned int mask) { gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_TASK_CLAUSES) != MATCH_YES) + if (gfc_match_omp_clauses (&c, mask) != MATCH_YES) return MATCH_ERROR; - new_st.op = EXEC_OMP_TASK; + new_st.op = op; new_st.ext.omp_clauses = c; return MATCH_YES; } match -gfc_match_omp_taskwait (void) +gfc_match_omp_critical (void) { + char n[GFC_MAX_SYMBOL_LEN+1]; + + if (gfc_match (" ( %n )", n) != MATCH_YES) + n[0] = '\0'; if (gfc_match_omp_eos () != MATCH_YES) { - gfc_error ("Unexpected junk after TASKWAIT clause at %C"); + gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C"); return MATCH_ERROR; } - new_st.op = EXEC_OMP_TASKWAIT; - new_st.ext.omp_clauses = NULL; + new_st.op = EXEC_OMP_CRITICAL; + new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL; return MATCH_YES; } match -gfc_match_omp_taskyield (void) +gfc_match_omp_distribute (void) { - if (gfc_match_omp_eos () != MATCH_YES) - { - gfc_error ("Unexpected junk after TASKYIELD clause at %C"); - return MATCH_ERROR; - } - new_st.op = EXEC_OMP_TASKYIELD; - new_st.ext.omp_clauses = NULL; - return MATCH_YES; + return match_omp (EXEC_OMP_DISTRIBUTE, OMP_DISTRIBUTE_CLAUSES); } match -gfc_match_omp_critical (void) +gfc_match_omp_distribute_parallel_do (void) { - char n[GFC_MAX_SYMBOL_LEN+1]; + return match_omp (EXEC_OMP_DISTRIBUTE_PARALLEL_DO, + OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES); +} - if (gfc_match (" ( %n )", n) != MATCH_YES) - n[0] = '\0'; + +match +gfc_match_omp_distribute_parallel_do_simd (void) +{ + return match_omp (EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, + (OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) + & ~OMP_CLAUSE_ORDERED); +} + + +match +gfc_match_omp_distribute_simd (void) +{ + return match_omp (EXEC_OMP_DISTRIBUTE_SIMD, + OMP_DISTRIBUTE_CLAUSES | OMP_SIMD_CLAUSES); +} + + +match +gfc_match_omp_do (void) +{ + return match_omp (EXEC_OMP_DO, OMP_DO_CLAUSES); +} + + +match +gfc_match_omp_do_simd (void) +{ + return match_omp (EXEC_OMP_DO_SIMD, ((OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) + & ~OMP_CLAUSE_ORDERED)); +} + + +match +gfc_match_omp_flush (void) +{ + gfc_omp_namelist *list = NULL; + gfc_match_omp_variable_list (" (", &list, true); if (gfc_match_omp_eos () != MATCH_YES) { - gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C"); + gfc_error ("Unexpected junk after $OMP FLUSH statement at %C"); + gfc_free_omp_namelist (list); return MATCH_ERROR; } - new_st.op = EXEC_OMP_CRITICAL; - new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL; + new_st.op = EXEC_OMP_FLUSH; + new_st.ext.omp_namelist = list; return MATCH_YES; } match -gfc_match_omp_do (void) +gfc_match_omp_declare_simd (void) { + locus where = gfc_current_locus; + gfc_symbol *proc_name; gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_DO_CLAUSES) != MATCH_YES) + gfc_omp_declare_simd *ods; + + if (gfc_match (" ( %s ) ", &proc_name) != MATCH_YES) return MATCH_ERROR; - new_st.op = EXEC_OMP_DO; - new_st.ext.omp_clauses = c; + + if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, true, + false) != MATCH_YES) + return MATCH_ERROR; + + ods = gfc_get_omp_declare_simd (); + ods->where = where; + ods->proc_name = proc_name; + ods->clauses = c; + ods->next = gfc_current_ns->omp_declare_simd; + gfc_current_ns->omp_declare_simd = ods; return MATCH_YES; } +static bool +match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2) +{ + match m; + locus old_loc = gfc_current_locus; + char sname[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symbol *sym; + gfc_namespace *ns = gfc_current_ns; + gfc_expr *lvalue = NULL, *rvalue = NULL; + gfc_symtree *st; + gfc_actual_arglist *arglist; + + m = gfc_match (" %v =", &lvalue); + if (m != MATCH_YES) + gfc_current_locus = old_loc; + else + { + m = gfc_match (" %e )", &rvalue); + if (m == MATCH_YES) + { + ns->code = gfc_get_code (EXEC_ASSIGN); + ns->code->expr1 = lvalue; + ns->code->expr2 = rvalue; + ns->code->loc = old_loc; + return true; + } + + gfc_current_locus = old_loc; + gfc_free_expr (lvalue); + } + + m = gfc_match (" %n", sname); + if (m != MATCH_YES) + return false; + + if (strcmp (sname, omp_sym1->name) == 0 + || strcmp (sname, omp_sym2->name) == 0) + return false; + + gfc_current_ns = ns->parent; + if (gfc_get_ha_sym_tree (sname, &st)) + return false; + + sym = st->n.sym; + if (sym->attr.flavor != FL_PROCEDURE + && sym->attr.flavor != FL_UNKNOWN) + return false; + + if (!sym->attr.generic + && !sym->attr.subroutine + && !sym->attr.function) + { + if (!(sym->attr.external && !sym->attr.referenced)) + { + /* ...create a symbol in this scope... */ + if (sym->ns != gfc_current_ns + && gfc_get_sym_tree (sname, NULL, &st, false) == 1) + return false; + + if (sym != st->n.sym) + sym = st->n.sym; + } + + /* ...and then to try to make the symbol into a subroutine. */ + if (!gfc_add_subroutine (&sym->attr, sym->name, NULL)) + return false; + } + + gfc_set_sym_referenced (sym); + gfc_gobble_whitespace (); + if (gfc_peek_ascii_char () != '(') + return false; + + gfc_current_ns = ns; + m = gfc_match_actual_arglist (1, &arglist); + if (m != MATCH_YES) + return false; + + if (gfc_match_char (')') != MATCH_YES) + return false; + + ns->code = gfc_get_code (EXEC_CALL); + ns->code->symtree = st; + ns->code->ext.actual = arglist; + ns->code->loc = old_loc; + return true; +} + +static bool +gfc_omp_udr_predef (gfc_omp_reduction_op rop, const char *name, + gfc_typespec *ts, const char **n) +{ + if (!gfc_numeric_ts (ts) && ts->type != BT_LOGICAL) + return false; + + switch (rop) + { + case OMP_REDUCTION_PLUS: + case OMP_REDUCTION_MINUS: + case OMP_REDUCTION_TIMES: + return ts->type != BT_LOGICAL; + case OMP_REDUCTION_AND: + case OMP_REDUCTION_OR: + case OMP_REDUCTION_EQV: + case OMP_REDUCTION_NEQV: + return ts->type == BT_LOGICAL; + case OMP_REDUCTION_USER: + if (name[0] != '.' && (ts->type == BT_INTEGER || ts->type == BT_REAL)) + { + gfc_symbol *sym; + + gfc_find_symbol (name, NULL, 1, &sym); + if (sym != NULL) + { + if (sym->attr.intrinsic) + *n = sym->name; + else if ((sym->attr.flavor != FL_UNKNOWN + && sym->attr.flavor != FL_PROCEDURE) + || sym->attr.external + || sym->attr.generic + || sym->attr.entry + || sym->attr.result + || sym->attr.dummy + || sym->attr.subroutine + || sym->attr.pointer + || sym->attr.target + || sym->attr.cray_pointer + || sym->attr.cray_pointee + || (sym->attr.proc != PROC_UNKNOWN + && sym->attr.proc != PROC_INTRINSIC) + || sym->attr.if_source != IFSRC_UNKNOWN + || sym == sym->ns->proc_name) + *n = NULL; + else + *n = sym->name; + } + else + *n = name; + if (*n + && (strcmp (*n, "max") == 0 || strcmp (*n, "min") == 0)) + return true; + else if (*n + && ts->type == BT_INTEGER + && (strcmp (*n, "iand") == 0 + || strcmp (*n, "ior") == 0 + || strcmp (*n, "ieor") == 0)) + return true; + } + break; + default: + break; + } + return false; +} + +gfc_omp_udr * +gfc_omp_udr_find (gfc_symtree *st, gfc_typespec *ts) +{ + gfc_omp_udr *omp_udr; + + if (st == NULL) + return NULL; + + for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next) + if (omp_udr->ts.type == ts->type + || ((omp_udr->ts.type == BT_DERIVED || omp_udr->ts.type == BT_CLASS) + && (ts->type == BT_DERIVED && ts->type == BT_CLASS))) + { + if (omp_udr->ts.type == BT_DERIVED || omp_udr->ts.type == BT_CLASS) + { + if (strcmp (omp_udr->ts.u.derived->name, ts->u.derived->name) == 0) + return omp_udr; + } + else if (omp_udr->ts.kind == ts->kind) + { + if (omp_udr->ts.type == BT_CHARACTER) + { + if (omp_udr->ts.u.cl->length == NULL + || ts->u.cl->length == NULL) + return omp_udr; + if (omp_udr->ts.u.cl->length->expr_type != EXPR_CONSTANT) + return omp_udr; + if (ts->u.cl->length->expr_type != EXPR_CONSTANT) + return omp_udr; + if (omp_udr->ts.u.cl->length->ts.type != BT_INTEGER) + return omp_udr; + if (ts->u.cl->length->ts.type != BT_INTEGER) + return omp_udr; + if (gfc_compare_expr (omp_udr->ts.u.cl->length, + ts->u.cl->length, INTRINSIC_EQ) != 0) + continue; + } + return omp_udr; + } + } + return NULL; +} + match -gfc_match_omp_flush (void) +gfc_match_omp_declare_reduction (void) { - gfc_namelist *list = NULL; - gfc_match_omp_variable_list (" (", &list, true); + match m; + gfc_intrinsic_op op; + char name[GFC_MAX_SYMBOL_LEN + 3]; + auto_vec<gfc_typespec, 5> tss; + gfc_typespec ts; + unsigned int i; + gfc_symtree *st; + locus where = gfc_current_locus; + locus end_loc = gfc_current_locus; + bool end_loc_set = false; + gfc_omp_reduction_op rop = OMP_REDUCTION_NONE; + + if (gfc_match_char ('(') != MATCH_YES) + return MATCH_ERROR; + + m = gfc_match (" %o : ", &op); + if (m == MATCH_ERROR) + return MATCH_ERROR; + if (m == MATCH_YES) + { + snprintf (name, sizeof name, "operator %s", gfc_op2string (op)); + rop = (gfc_omp_reduction_op) op; + } + else + { + m = gfc_match_defined_op_name (name + 1, 1); + if (m == MATCH_ERROR) + return MATCH_ERROR; + if (m == MATCH_YES) + { + name[0] = '.'; + strcat (name, "."); + if (gfc_match (" : ") != MATCH_YES) + return MATCH_ERROR; + } + else + { + if (gfc_match (" %n : ", name) != MATCH_YES) + return MATCH_ERROR; + } + rop = OMP_REDUCTION_USER; + } + + m = gfc_match_type_spec (&ts); + if (m != MATCH_YES) + return MATCH_ERROR; + /* Treat len=: the same as len=*. */ + if (ts.type == BT_CHARACTER) + ts.deferred = false; + tss.safe_push (ts); + + while (gfc_match_char (',') == MATCH_YES) + { + m = gfc_match_type_spec (&ts); + if (m != MATCH_YES) + return MATCH_ERROR; + tss.safe_push (ts); + } + if (gfc_match_char (':') != MATCH_YES) + return MATCH_ERROR; + + st = gfc_find_symtree (gfc_current_ns->omp_udr_root, name); + for (i = 0; i < tss.length (); i++) + { + gfc_symtree *omp_out, *omp_in; + gfc_symtree *omp_priv = NULL, *omp_orig = NULL; + gfc_namespace *combiner_ns, *initializer_ns = NULL; + gfc_omp_udr *prev_udr, *omp_udr; + const char *predef_name = NULL; + + omp_udr = gfc_get_omp_udr (); + omp_udr->name = gfc_get_string (name); + omp_udr->rop = rop; + omp_udr->ts = tss[i]; + omp_udr->where = where; + + gfc_current_ns = combiner_ns = gfc_get_namespace (gfc_current_ns, 1); + combiner_ns->proc_name = combiner_ns->parent->proc_name; + + gfc_get_sym_tree ("omp_out", combiner_ns, &omp_out, false); + gfc_get_sym_tree ("omp_in", combiner_ns, &omp_in, false); + combiner_ns->omp_udr_ns = 1; + omp_out->n.sym->ts = tss[i]; + omp_in->n.sym->ts = tss[i]; + omp_out->n.sym->attr.omp_udr_artificial_var = 1; + omp_in->n.sym->attr.omp_udr_artificial_var = 1; + omp_out->n.sym->attr.flavor = FL_VARIABLE; + omp_in->n.sym->attr.flavor = FL_VARIABLE; + gfc_commit_symbols (); + omp_udr->combiner_ns = combiner_ns; + omp_udr->omp_out = omp_out->n.sym; + omp_udr->omp_in = omp_in->n.sym; + + locus old_loc = gfc_current_locus; + + if (!match_udr_expr (omp_out, omp_in)) + { + syntax: + gfc_current_locus = old_loc; + gfc_current_ns = combiner_ns->parent; + gfc_free_omp_udr (omp_udr); + return MATCH_ERROR; + } + + if (gfc_match (" initializer ( ") == MATCH_YES) + { + gfc_current_ns = combiner_ns->parent; + initializer_ns = gfc_get_namespace (gfc_current_ns, 1); + gfc_current_ns = initializer_ns; + initializer_ns->proc_name = initializer_ns->parent->proc_name; + + gfc_get_sym_tree ("omp_priv", initializer_ns, &omp_priv, false); + gfc_get_sym_tree ("omp_orig", initializer_ns, &omp_orig, false); + initializer_ns->omp_udr_ns = 1; + omp_priv->n.sym->ts = tss[i]; + omp_orig->n.sym->ts = tss[i]; + omp_priv->n.sym->attr.omp_udr_artificial_var = 1; + omp_orig->n.sym->attr.omp_udr_artificial_var = 1; + omp_priv->n.sym->attr.flavor = FL_VARIABLE; + omp_orig->n.sym->attr.flavor = FL_VARIABLE; + gfc_commit_symbols (); + omp_udr->initializer_ns = initializer_ns; + omp_udr->omp_priv = omp_priv->n.sym; + omp_udr->omp_orig = omp_orig->n.sym; + + if (!match_udr_expr (omp_priv, omp_orig)) + goto syntax; + } + + gfc_current_ns = combiner_ns->parent; + if (!end_loc_set) + { + end_loc_set = true; + end_loc = gfc_current_locus; + } + gfc_current_locus = old_loc; + + prev_udr = gfc_omp_udr_find (st, &tss[i]); + if (gfc_omp_udr_predef (rop, name, &tss[i], &predef_name) + /* Don't error on !$omp declare reduction (min : integer : ...) + just yet, there could be integer :: min afterwards, + making it valid. When the UDR is resolved, we'll get + to it again. */ + && (rop != OMP_REDUCTION_USER || name[0] == '.')) + { + if (predef_name) + gfc_error_now ("Redefinition of predefined %s " + "!$OMP DECLARE REDUCTION at %L", + predef_name, &where); + else + gfc_error_now ("Redefinition of predefined " + "!$OMP DECLARE REDUCTION at %L", &where); + } + else if (prev_udr) + { + gfc_error_now ("Redefinition of !$OMP DECLARE REDUCTION at %L", + &where); + gfc_error_now ("Previous !$OMP DECLARE REDUCTION at %L", + &prev_udr->where); + } + else if (st) + { + omp_udr->next = st->n.omp_udr; + st->n.omp_udr = omp_udr; + } + else + { + st = gfc_new_symtree (&gfc_current_ns->omp_udr_root, name); + st->n.omp_udr = omp_udr; + } + } + + if (end_loc_set) + { + gfc_current_locus = end_loc; + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after !$OMP DECLARE REDUCTION at %C"); + gfc_current_locus = where; + return MATCH_ERROR; + } + + return MATCH_YES; + } + gfc_clear_error (); + return MATCH_ERROR; +} + + +match +gfc_match_omp_declare_target (void) +{ + locus old_loc; + char n[GFC_MAX_SYMBOL_LEN+1]; + gfc_symbol *sym; + match m; + gfc_symtree *st; + + old_loc = gfc_current_locus; + + m = gfc_match (" ("); + + if (gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY + && m == MATCH_YES) + { + gfc_error ("Only the !$OMP DECLARE TARGET form without " + "list is allowed in interface block at %C"); + goto cleanup; + } + + if (m == MATCH_NO + && gfc_current_ns->proc_name + && gfc_match_omp_eos () == MATCH_YES) + { + if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr, + gfc_current_ns->proc_name->name, + &old_loc)) + goto cleanup; + return MATCH_YES; + } + + if (m != MATCH_YES) + return m; + + for (;;) + { + m = gfc_match_symbol (&sym, 0); + switch (m) + { + case MATCH_YES: + if (sym->attr.in_common) + gfc_error_now ("OMP DECLARE TARGET on a variable at %C is an " + "element of a COMMON block"); + else if (!gfc_add_omp_declare_target (&sym->attr, sym->name, + &sym->declared_at)) + goto cleanup; + goto next_item; + case MATCH_NO: + break; + case MATCH_ERROR: + goto cleanup; + } + + m = gfc_match (" / %n /", n); + if (m == MATCH_ERROR) + goto cleanup; + if (m == MATCH_NO || n[0] == '\0') + goto syntax; + + st = gfc_find_symtree (gfc_current_ns->common_root, n); + if (st == NULL) + { + gfc_error ("COMMON block /%s/ not found at %C", n); + goto cleanup; + } + st->n.common->omp_declare_target = 1; + for (sym = st->n.common->head; sym; sym = sym->common_next) + if (!gfc_add_omp_declare_target (&sym->attr, sym->name, + &sym->declared_at)) + goto cleanup; + + next_item: + if (gfc_match_char (')') == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + } + if (gfc_match_omp_eos () != MATCH_YES) { - gfc_error ("Unexpected junk after $OMP FLUSH statement at %C"); - gfc_free_namelist (list); - return MATCH_ERROR; + gfc_error ("Unexpected junk after !$OMP DECLARE TARGET at %C"); + goto cleanup; } - new_st.op = EXEC_OMP_FLUSH; - new_st.ext.omp_namelist = list; return MATCH_YES; + +syntax: + gfc_error ("Syntax error in !$OMP DECLARE TARGET list at %C"); + +cleanup: + gfc_current_locus = old_loc; + return MATCH_ERROR; } @@ -605,6 +1482,12 @@ gfc_match_omp_threadprivate (void) goto syntax; } + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after OMP THREADPRIVATE at %C"); + goto cleanup; + } + return MATCH_YES; syntax: @@ -617,69 +1500,213 @@ cleanup: match +gfc_match_omp_parallel (void) +{ + return match_omp (EXEC_OMP_PARALLEL, OMP_PARALLEL_CLAUSES); +} + + +match gfc_match_omp_parallel_do (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES) - != MATCH_YES) - return MATCH_ERROR; - new_st.op = EXEC_OMP_PARALLEL_DO; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_omp (EXEC_OMP_PARALLEL_DO, + OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES); +} + + +match +gfc_match_omp_parallel_do_simd (void) +{ + return match_omp (EXEC_OMP_PARALLEL_DO_SIMD, + (OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) + & ~OMP_CLAUSE_ORDERED); } match gfc_match_omp_parallel_sections (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_SECTIONS_CLAUSES) - != MATCH_YES) - return MATCH_ERROR; - new_st.op = EXEC_OMP_PARALLEL_SECTIONS; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_omp (EXEC_OMP_PARALLEL_SECTIONS, + OMP_PARALLEL_CLAUSES | OMP_SECTIONS_CLAUSES); } match gfc_match_omp_parallel_workshare (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES) != MATCH_YES) - return MATCH_ERROR; - new_st.op = EXEC_OMP_PARALLEL_WORKSHARE; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_omp (EXEC_OMP_PARALLEL_WORKSHARE, OMP_PARALLEL_CLAUSES); } match gfc_match_omp_sections (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_SECTIONS_CLAUSES) != MATCH_YES) - return MATCH_ERROR; - new_st.op = EXEC_OMP_SECTIONS; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_omp (EXEC_OMP_SECTIONS, OMP_SECTIONS_CLAUSES); +} + + +match +gfc_match_omp_simd (void) +{ + return match_omp (EXEC_OMP_SIMD, OMP_SIMD_CLAUSES); } match gfc_match_omp_single (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE) - != MATCH_YES) - return MATCH_ERROR; - new_st.op = EXEC_OMP_SINGLE; - new_st.ext.omp_clauses = c; + return match_omp (EXEC_OMP_SINGLE, + OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE); +} + + +match +gfc_match_omp_task (void) +{ + return match_omp (EXEC_OMP_TASK, OMP_TASK_CLAUSES); +} + + +match +gfc_match_omp_taskwait (void) +{ + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after TASKWAIT clause at %C"); + return MATCH_ERROR; + } + new_st.op = EXEC_OMP_TASKWAIT; + new_st.ext.omp_clauses = NULL; return MATCH_YES; } match +gfc_match_omp_taskyield (void) +{ + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after TASKYIELD clause at %C"); + return MATCH_ERROR; + } + new_st.op = EXEC_OMP_TASKYIELD; + new_st.ext.omp_clauses = NULL; + return MATCH_YES; +} + + +match +gfc_match_omp_target (void) +{ + return match_omp (EXEC_OMP_TARGET, OMP_TARGET_CLAUSES); +} + + +match +gfc_match_omp_target_data (void) +{ + return match_omp (EXEC_OMP_TARGET_DATA, OMP_TARGET_DATA_CLAUSES); +} + + +match +gfc_match_omp_target_teams (void) +{ + return match_omp (EXEC_OMP_TARGET_TEAMS, + OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES); +} + + +match +gfc_match_omp_target_teams_distribute (void) +{ + return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE, + OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES + | OMP_DISTRIBUTE_CLAUSES); +} + + +match +gfc_match_omp_target_teams_distribute_parallel_do (void) +{ + return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES + | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES); +} + + +match +gfc_match_omp_target_teams_distribute_parallel_do_simd (void) +{ + return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + (OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES + | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) + & ~OMP_CLAUSE_ORDERED); +} + + +match +gfc_match_omp_target_teams_distribute_simd (void) +{ + return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD, + OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES + | OMP_DISTRIBUTE_CLAUSES | OMP_SIMD_CLAUSES); +} + + +match +gfc_match_omp_target_update (void) +{ + return match_omp (EXEC_OMP_TARGET_UPDATE, OMP_TARGET_UPDATE_CLAUSES); +} + + +match +gfc_match_omp_teams (void) +{ + return match_omp (EXEC_OMP_TEAMS, OMP_TEAMS_CLAUSES); +} + + +match +gfc_match_omp_teams_distribute (void) +{ + return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE, + OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES); +} + + +match +gfc_match_omp_teams_distribute_parallel_do (void) +{ + return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO, + OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES + | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES); +} + + +match +gfc_match_omp_teams_distribute_parallel_do_simd (void) +{ + return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + (OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES + | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES + | OMP_SIMD_CLAUSES) & ~OMP_CLAUSE_ORDERED); +} + + +match +gfc_match_omp_teams_distribute_simd (void) +{ + return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_SIMD, + OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES + | OMP_SIMD_CLAUSES); +} + + +match gfc_match_omp_workshare (void) { if (gfc_match_omp_eos () != MATCH_YES) @@ -725,20 +1752,44 @@ match gfc_match_omp_atomic (void) { gfc_omp_atomic_op op = GFC_OMP_ATOMIC_UPDATE; - if (gfc_match ("% update") == MATCH_YES) - op = GFC_OMP_ATOMIC_UPDATE; - else if (gfc_match ("% read") == MATCH_YES) - op = GFC_OMP_ATOMIC_READ; - else if (gfc_match ("% write") == MATCH_YES) - op = GFC_OMP_ATOMIC_WRITE; - else if (gfc_match ("% capture") == MATCH_YES) - op = GFC_OMP_ATOMIC_CAPTURE; + int seq_cst = 0; + if (gfc_match ("% seq_cst") == MATCH_YES) + seq_cst = 1; + locus old_loc = gfc_current_locus; + if (seq_cst && gfc_match_char (',') == MATCH_YES) + seq_cst = 2; + if (seq_cst == 2 + || gfc_match_space () == MATCH_YES) + { + gfc_gobble_whitespace (); + if (gfc_match ("update") == MATCH_YES) + op = GFC_OMP_ATOMIC_UPDATE; + else if (gfc_match ("read") == MATCH_YES) + op = GFC_OMP_ATOMIC_READ; + else if (gfc_match ("write") == MATCH_YES) + op = GFC_OMP_ATOMIC_WRITE; + else if (gfc_match ("capture") == MATCH_YES) + op = GFC_OMP_ATOMIC_CAPTURE; + else + { + if (seq_cst == 2) + gfc_current_locus = old_loc; + goto finish; + } + if (!seq_cst + && (gfc_match (", seq_cst") == MATCH_YES + || gfc_match ("% seq_cst") == MATCH_YES)) + seq_cst = 1; + } + finish: if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP ATOMIC statement at %C"); return MATCH_ERROR; } new_st.op = EXEC_OMP_ATOMIC; + if (seq_cst) + op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST); new_st.ext.omp_atomic = op; return MATCH_YES; } @@ -759,6 +1810,73 @@ gfc_match_omp_barrier (void) match +gfc_match_omp_taskgroup (void) +{ + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after $OMP TASKGROUP statement at %C"); + return MATCH_ERROR; + } + new_st.op = EXEC_OMP_TASKGROUP; + return MATCH_YES; +} + + +static enum gfc_omp_cancel_kind +gfc_match_omp_cancel_kind (void) +{ + if (gfc_match_space () != MATCH_YES) + return OMP_CANCEL_UNKNOWN; + if (gfc_match ("parallel") == MATCH_YES) + return OMP_CANCEL_PARALLEL; + if (gfc_match ("sections") == MATCH_YES) + return OMP_CANCEL_SECTIONS; + if (gfc_match ("do") == MATCH_YES) + return OMP_CANCEL_DO; + if (gfc_match ("taskgroup") == MATCH_YES) + return OMP_CANCEL_TASKGROUP; + return OMP_CANCEL_UNKNOWN; +} + + +match +gfc_match_omp_cancel (void) +{ + gfc_omp_clauses *c; + enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind (); + if (kind == OMP_CANCEL_UNKNOWN) + return MATCH_ERROR; + if (gfc_match_omp_clauses (&c, OMP_CLAUSE_IF, false) != MATCH_YES) + return MATCH_ERROR; + c->cancel = kind; + new_st.op = EXEC_OMP_CANCEL; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + + +match +gfc_match_omp_cancellation_point (void) +{ + gfc_omp_clauses *c; + enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind (); + if (kind == OMP_CANCEL_UNKNOWN) + return MATCH_ERROR; + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after $OMP CANCELLATION POINT statement " + "at %C"); + return MATCH_ERROR; + } + c = gfc_get_omp_clauses (); + c->cancel = kind; + new_st.op = EXEC_OMP_CANCELLATION_POINT; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + + +match gfc_match_omp_end_nowait (void) { bool nowait = false; @@ -793,17 +1911,116 @@ gfc_match_omp_end_single (void) } +struct resolve_omp_udr_callback_data +{ + gfc_symbol *sym1, *sym2; +}; + + +static int +resolve_omp_udr_callback (gfc_expr **e, int *, void *data) +{ + struct resolve_omp_udr_callback_data *rcd + = (struct resolve_omp_udr_callback_data *) data; + if ((*e)->expr_type == EXPR_VARIABLE + && ((*e)->symtree->n.sym == rcd->sym1 + || (*e)->symtree->n.sym == rcd->sym2)) + { + gfc_ref *ref = gfc_get_ref (); + ref->type = REF_ARRAY; + ref->u.ar.where = (*e)->where; + ref->u.ar.as = (*e)->symtree->n.sym->as; + ref->u.ar.type = AR_FULL; + ref->u.ar.dimen = 0; + ref->next = (*e)->ref; + (*e)->ref = ref; + } + return 0; +} + + +static int +resolve_omp_udr_callback2 (gfc_expr **e, int *, void *) +{ + if ((*e)->expr_type == EXPR_FUNCTION + && (*e)->value.function.isym == NULL) + { + gfc_symbol *sym = (*e)->symtree->n.sym; + if (!sym->attr.intrinsic + && sym->attr.if_source == IFSRC_UNKNOWN) + gfc_error ("Implicitly declared function %s used in " + "!$OMP DECLARE REDUCTION at %L ", sym->name, &(*e)->where); + } + return 0; +} + + +static gfc_code * +resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns, + gfc_symbol *sym1, gfc_symbol *sym2) +{ + gfc_code *copy; + gfc_symbol sym1_copy, sym2_copy; + + if (ns->code->op == EXEC_ASSIGN) + { + copy = gfc_get_code (EXEC_ASSIGN); + copy->expr1 = gfc_copy_expr (ns->code->expr1); + copy->expr2 = gfc_copy_expr (ns->code->expr2); + } + else + { + copy = gfc_get_code (EXEC_CALL); + copy->symtree = ns->code->symtree; + copy->ext.actual = gfc_copy_actual_arglist (ns->code->ext.actual); + } + copy->loc = ns->code->loc; + sym1_copy = *sym1; + sym2_copy = *sym2; + *sym1 = *n->sym; + *sym2 = *n->sym; + sym1->name = sym1_copy.name; + sym2->name = sym2_copy.name; + ns->proc_name = ns->parent->proc_name; + if (n->sym->attr.dimension) + { + struct resolve_omp_udr_callback_data rcd; + rcd.sym1 = sym1; + rcd.sym2 = sym2; + gfc_code_walker (©, gfc_dummy_code_callback, + resolve_omp_udr_callback, &rcd); + } + gfc_resolve_code (copy, gfc_current_ns); + if (copy->op == EXEC_CALL && copy->resolved_isym == NULL) + { + gfc_symbol *sym = copy->resolved_sym; + if (sym + && !sym->attr.intrinsic + && sym->attr.if_source == IFSRC_UNKNOWN) + gfc_error ("Implicitly declared subroutine %s used in " + "!$OMP DECLARE REDUCTION at %L ", sym->name, + ©->loc); + } + gfc_code_walker (©, gfc_dummy_code_callback, + resolve_omp_udr_callback2, NULL); + *sym1 = sym1_copy; + *sym2 = sym2_copy; + return copy; +} + + /* OpenMP directive resolving routines. */ static void -resolve_omp_clauses (gfc_code *code) +resolve_omp_clauses (gfc_code *code, locus *where, + gfc_omp_clauses *omp_clauses, gfc_namespace *ns) { - gfc_omp_clauses *omp_clauses = code->ext.omp_clauses; - gfc_namelist *n; + gfc_omp_namelist *n; int list; static const char *clause_names[] = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED", - "COPYIN", "REDUCTION" }; + "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP", + "TO", "FROM", "REDUCTION" }; if (omp_clauses == NULL) return; @@ -847,8 +2064,15 @@ resolve_omp_clauses (gfc_code *code) for (n = omp_clauses->lists[list]; n; n = n->next) { n->sym->mark = 0; - if (n->sym->attr.flavor == FL_VARIABLE || n->sym->attr.proc_pointer) - continue; + if (n->sym->attr.flavor == FL_VARIABLE + || n->sym->attr.proc_pointer + || (!code && (!n->sym->attr.dummy || n->sym->ns != ns))) + { + if (!code && (!n->sym->attr.dummy || n->sym->ns != ns)) + gfc_error ("Variable '%s' is not a dummy argument at %L", + n->sym->name, where); + continue; + } if (n->sym->attr.flavor == FL_PROCEDURE && n->sym->result == n->sym && n->sym->attr.function) @@ -878,16 +2102,22 @@ resolve_omp_clauses (gfc_code *code) } } gfc_error ("Object '%s' is not a variable at %L", n->sym->name, - &code->loc); + where); } for (list = 0; list < OMP_LIST_NUM; list++) - if (list != OMP_LIST_FIRSTPRIVATE && list != OMP_LIST_LASTPRIVATE) + if (list != OMP_LIST_FIRSTPRIVATE + && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALIGNED + && list != OMP_LIST_DEPEND + && list != OMP_LIST_MAP + && list != OMP_LIST_FROM + && list != OMP_LIST_TO) for (n = omp_clauses->lists[list]; n; n = n->next) { if (n->sym->mark) gfc_error ("Symbol '%s' present on multiple clauses at %L", - n->sym->name, &code->loc); + n->sym->name, where); else n->sym->mark = 1; } @@ -898,7 +2128,7 @@ resolve_omp_clauses (gfc_code *code) if (n->sym->mark) { gfc_error ("Symbol '%s' present on multiple clauses at %L", - n->sym->name, &code->loc); + n->sym->name, where); n->sym->mark = 0; } @@ -906,7 +2136,7 @@ resolve_omp_clauses (gfc_code *code) { if (n->sym->mark) gfc_error ("Symbol '%s' present on multiple clauses at %L", - n->sym->name, &code->loc); + n->sym->name, where); else n->sym->mark = 1; } @@ -917,19 +2147,44 @@ resolve_omp_clauses (gfc_code *code) { if (n->sym->mark) gfc_error ("Symbol '%s' present on multiple clauses at %L", - n->sym->name, &code->loc); + n->sym->name, where); + else + n->sym->mark = 1; + } + + for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + n->sym->mark = 0; + + for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + { + if (n->sym->mark) + gfc_error ("Symbol '%s' present on multiple clauses at %L", + n->sym->name, where); + else + n->sym->mark = 1; + } + + for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) + n->sym->mark = 0; + for (n = omp_clauses->lists[OMP_LIST_FROM]; n; n = n->next) + if (n->expr == NULL) + n->sym->mark = 1; + for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) + { + if (n->expr == NULL && n->sym->mark) + gfc_error ("Symbol '%s' present on both FROM and TO clauses at %L", + n->sym->name, where); else n->sym->mark = 1; } + for (list = 0; list < OMP_LIST_NUM; list++) if ((n = omp_clauses->lists[list]) != NULL) { const char *name; - if (list < OMP_LIST_REDUCTION_FIRST) + if (list < OMP_LIST_NUM) name = clause_names[list]; - else if (list <= OMP_LIST_REDUCTION_LAST) - name = clause_names[OMP_LIST_REDUCTION_FIRST]; else gcc_unreachable (); @@ -940,10 +2195,7 @@ resolve_omp_clauses (gfc_code *code) { if (!n->sym->attr.threadprivate) gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause" - " at %L", n->sym->name, &code->loc); - if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp) - gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components", - n->sym->name, &code->loc); + " at %L", n->sym->name, where); } break; case OMP_LIST_COPYPRIVATE: @@ -951,10 +2203,10 @@ resolve_omp_clauses (gfc_code *code) { if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE) gfc_error ("Assumed size array '%s' in COPYPRIVATE clause " - "at %L", n->sym->name, &code->loc); - if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp) - gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components", - n->sym->name, &code->loc); + "at %L", n->sym->name, where); + if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN) + gfc_error ("INTENT(IN) POINTER '%s' in COPYPRIVATE clause " + "at %L", n->sym->name, where); } break; case OMP_LIST_SHARED: @@ -962,96 +2214,286 @@ resolve_omp_clauses (gfc_code *code) { if (n->sym->attr.threadprivate) gfc_error ("THREADPRIVATE object '%s' in SHARED clause at " - "%L", n->sym->name, &code->loc); + "%L", n->sym->name, where); if (n->sym->attr.cray_pointee) gfc_error ("Cray pointee '%s' in SHARED clause at %L", - n->sym->name, &code->loc); + n->sym->name, where); + if (n->sym->attr.associate_var) + gfc_error ("ASSOCIATE name '%s' in SHARED clause at %L", + n->sym->name, where); + } + break; + case OMP_LIST_ALIGNED: + for (; n != NULL; n = n->next) + { + if (!n->sym->attr.pointer + && !n->sym->attr.allocatable + && !n->sym->attr.cray_pointer + && (n->sym->ts.type != BT_DERIVED + || (n->sym->ts.u.derived->from_intmod + != INTMOD_ISO_C_BINDING) + || (n->sym->ts.u.derived->intmod_sym_id + != ISOCBINDING_PTR))) + gfc_error ("'%s' in ALIGNED clause must be POINTER, " + "ALLOCATABLE, Cray pointer or C_PTR at %L", + n->sym->name, where); + else if (n->expr) + { + gfc_expr *expr = n->expr; + int alignment = 0; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER + || expr->rank != 0 + || gfc_extract_int (expr, &alignment) + || alignment <= 0) + gfc_error ("'%s' in ALIGNED clause at %L requires a scalar " + "positive constant integer alignment " + "expression", n->sym->name, where); + } } break; + case OMP_LIST_DEPEND: + case OMP_LIST_MAP: + case OMP_LIST_TO: + case OMP_LIST_FROM: + for (; n != NULL; n = n->next) + if (n->expr) + { + if (!gfc_resolve_expr (n->expr) + || n->expr->expr_type != EXPR_VARIABLE + || n->expr->ref == NULL + || n->expr->ref->next + || n->expr->ref->type != REF_ARRAY) + gfc_error ("'%s' in %s clause at %L is not a proper " + "array section", n->sym->name, name, where); + else if (n->expr->ref->u.ar.codimen) + gfc_error ("Coarrays not supported in %s clause at %L", + name, where); + else + { + int i; + gfc_array_ref *ar = &n->expr->ref->u.ar; + for (i = 0; i < ar->dimen; i++) + if (ar->stride[i]) + { + gfc_error ("Stride should not be specified for " + "array section in %s clause at %L", + name, where); + break; + } + else if (ar->dimen_type[i] != DIMEN_ELEMENT + && ar->dimen_type[i] != DIMEN_RANGE) + { + gfc_error ("'%s' in %s clause at %L is not a " + "proper array section", + n->sym->name, name, where); + break; + } + else if (list == OMP_LIST_DEPEND + && ar->start[i] + && ar->start[i]->expr_type == EXPR_CONSTANT + && ar->end[i] + && ar->end[i]->expr_type == EXPR_CONSTANT + && mpz_cmp (ar->start[i]->value.integer, + ar->end[i]->value.integer) > 0) + { + gfc_error ("'%s' in DEPEND clause at %L is a zero " + "size array section", n->sym->name, + where); + break; + } + } + } + if (list != OMP_LIST_DEPEND) + for (n = omp_clauses->lists[list]; n != NULL; n = n->next) + { + n->sym->attr.referenced = 1; + if (n->sym->attr.threadprivate) + gfc_error ("THREADPRIVATE object '%s' in %s clause at %L", + n->sym->name, name, where); + if (n->sym->attr.cray_pointee) + gfc_error ("Cray pointee '%s' in %s clause at %L", + n->sym->name, name, where); + } + break; default: for (; n != NULL; n = n->next) { + bool bad = false; if (n->sym->attr.threadprivate) gfc_error ("THREADPRIVATE object '%s' in %s clause at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); if (n->sym->attr.cray_pointee) gfc_error ("Cray pointee '%s' in %s clause at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); + if (n->sym->attr.associate_var) + gfc_error ("ASSOCIATE name '%s' in %s clause at %L", + n->sym->name, name, where); if (list != OMP_LIST_PRIVATE) { - if (n->sym->attr.pointer - && list >= OMP_LIST_REDUCTION_FIRST - && list <= OMP_LIST_REDUCTION_LAST) + if (n->sym->attr.proc_pointer && list == OMP_LIST_REDUCTION) + gfc_error ("Procedure pointer '%s' in %s clause at %L", + n->sym->name, name, where); + if (n->sym->attr.pointer && list == OMP_LIST_REDUCTION) gfc_error ("POINTER object '%s' in %s clause at %L", - n->sym->name, name, &code->loc); - /* Variables in REDUCTION-clauses must be of intrinsic type (flagged below). */ - if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST) - && n->sym->ts.type == BT_DERIVED - && n->sym->ts.u.derived->attr.alloc_comp) - gfc_error ("%s clause object '%s' has ALLOCATABLE components at %L", - name, n->sym->name, &code->loc); - if (n->sym->attr.cray_pointer - && list >= OMP_LIST_REDUCTION_FIRST - && list <= OMP_LIST_REDUCTION_LAST) + n->sym->name, name, where); + if (n->sym->attr.cray_pointer && list == OMP_LIST_REDUCTION) gfc_error ("Cray pointer '%s' in %s clause at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); } if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE) gfc_error ("Assumed size array '%s' in %s clause at %L", - n->sym->name, name, &code->loc); - if (n->sym->attr.in_namelist - && (list < OMP_LIST_REDUCTION_FIRST - || list > OMP_LIST_REDUCTION_LAST)) + n->sym->name, name, where); + if (n->sym->attr.in_namelist && list != OMP_LIST_REDUCTION) gfc_error ("Variable '%s' in %s clause is used in " "NAMELIST statement at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); + if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN) + switch (list) + { + case OMP_LIST_PRIVATE: + case OMP_LIST_LASTPRIVATE: + case OMP_LIST_LINEAR: + /* case OMP_LIST_REDUCTION: */ + gfc_error ("INTENT(IN) POINTER '%s' in %s clause at %L", + n->sym->name, name, where); + break; + default: + break; + } switch (list) { - case OMP_LIST_PLUS: - case OMP_LIST_MULT: - case OMP_LIST_SUB: - if (!gfc_numeric_ts (&n->sym->ts)) - gfc_error ("%c REDUCTION variable '%s' at %L must be of numeric type, got %s", - list == OMP_LIST_PLUS ? '+' - : list == OMP_LIST_MULT ? '*' : '-', - n->sym->name, &code->loc, - gfc_typename (&n->sym->ts)); - break; - case OMP_LIST_AND: - case OMP_LIST_OR: - case OMP_LIST_EQV: - case OMP_LIST_NEQV: - if (n->sym->ts.type != BT_LOGICAL) - gfc_error ("%s REDUCTION variable '%s' must be LOGICAL " - "at %L", - list == OMP_LIST_AND ? ".AND." - : list == OMP_LIST_OR ? ".OR." - : list == OMP_LIST_EQV ? ".EQV." : ".NEQV.", - n->sym->name, &code->loc); - break; - case OMP_LIST_MAX: - case OMP_LIST_MIN: - if (n->sym->ts.type != BT_INTEGER - && n->sym->ts.type != BT_REAL) - gfc_error ("%s REDUCTION variable '%s' must be " - "INTEGER or REAL at %L", - list == OMP_LIST_MAX ? "MAX" : "MIN", - n->sym->name, &code->loc); + case OMP_LIST_REDUCTION: + switch (n->u.reduction_op) + { + case OMP_REDUCTION_PLUS: + case OMP_REDUCTION_TIMES: + case OMP_REDUCTION_MINUS: + if (!gfc_numeric_ts (&n->sym->ts)) + bad = true; + break; + case OMP_REDUCTION_AND: + case OMP_REDUCTION_OR: + case OMP_REDUCTION_EQV: + case OMP_REDUCTION_NEQV: + if (n->sym->ts.type != BT_LOGICAL) + bad = true; + break; + case OMP_REDUCTION_MAX: + case OMP_REDUCTION_MIN: + if (n->sym->ts.type != BT_INTEGER + && n->sym->ts.type != BT_REAL) + bad = true; + break; + case OMP_REDUCTION_IAND: + case OMP_REDUCTION_IOR: + case OMP_REDUCTION_IEOR: + if (n->sym->ts.type != BT_INTEGER) + bad = true; + break; + case OMP_REDUCTION_USER: + bad = true; + break; + default: + break; + } + if (!bad) + n->udr = NULL; + else + { + const char *udr_name = NULL; + if (n->udr) + { + udr_name = n->udr->udr->name; + n->udr->udr + = gfc_find_omp_udr (NULL, udr_name, + &n->sym->ts); + if (n->udr->udr == NULL) + { + free (n->udr); + n->udr = NULL; + } + } + if (n->udr == NULL) + { + if (udr_name == NULL) + switch (n->u.reduction_op) + { + case OMP_REDUCTION_PLUS: + case OMP_REDUCTION_TIMES: + case OMP_REDUCTION_MINUS: + case OMP_REDUCTION_AND: + case OMP_REDUCTION_OR: + case OMP_REDUCTION_EQV: + case OMP_REDUCTION_NEQV: + udr_name = gfc_op2string ((gfc_intrinsic_op) + n->u.reduction_op); + break; + case OMP_REDUCTION_MAX: + udr_name = "max"; + break; + case OMP_REDUCTION_MIN: + udr_name = "min"; + break; + case OMP_REDUCTION_IAND: + udr_name = "iand"; + break; + case OMP_REDUCTION_IOR: + udr_name = "ior"; + break; + case OMP_REDUCTION_IEOR: + udr_name = "ieor"; + break; + default: + gcc_unreachable (); + } + gfc_error ("!$OMP DECLARE REDUCTION %s not found " + "for type %s at %L", udr_name, + gfc_typename (&n->sym->ts), where); + } + else + { + gfc_omp_udr *udr = n->udr->udr; + n->u.reduction_op = OMP_REDUCTION_USER; + n->udr->combiner + = resolve_omp_udr_clause (n, udr->combiner_ns, + udr->omp_out, + udr->omp_in); + if (udr->initializer_ns) + n->udr->initializer + = resolve_omp_udr_clause (n, + udr->initializer_ns, + udr->omp_priv, + udr->omp_orig); + } + } break; - case OMP_LIST_IAND: - case OMP_LIST_IOR: - case OMP_LIST_IEOR: + case OMP_LIST_LINEAR: if (n->sym->ts.type != BT_INTEGER) - gfc_error ("%s REDUCTION variable '%s' must be INTEGER " - "at %L", - list == OMP_LIST_IAND ? "IAND" - : list == OMP_LIST_MULT ? "IOR" : "IEOR", - n->sym->name, &code->loc); + gfc_error ("LINEAR variable '%s' must be INTEGER " + "at %L", n->sym->name, where); + else if (!code && !n->sym->attr.value) + gfc_error ("LINEAR dummy argument '%s' must have VALUE " + "attribute at %L", n->sym->name, where); + else if (n->expr) + { + gfc_expr *expr = n->expr; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER + || expr->rank != 0) + gfc_error ("'%s' in LINEAR clause at %L requires " + "a scalar integer linear-step expression", + n->sym->name, where); + else if (!code && expr->expr_type != EXPR_CONSTANT) + gfc_error ("'%s' in LINEAR clause at %L requires " + "a constant integer linear-step expression", + n->sym->name, where); + } break; /* Workaround for PR middle-end/26316, nothing really needs to be done here for OMP_LIST_PRIVATE. */ case OMP_LIST_PRIVATE: - gcc_assert (code->op != EXEC_NOP); + gcc_assert (code && code->op != EXEC_NOP); default: break; } @@ -1059,6 +2501,54 @@ resolve_omp_clauses (gfc_code *code) break; } } + if (omp_clauses->safelen_expr) + { + gfc_expr *expr = omp_clauses->safelen_expr; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("SAFELEN clause at %L requires a scalar " + "INTEGER expression", &expr->where); + } + if (omp_clauses->simdlen_expr) + { + gfc_expr *expr = omp_clauses->simdlen_expr; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("SIMDLEN clause at %L requires a scalar " + "INTEGER expression", &expr->where); + } + if (omp_clauses->num_teams) + { + gfc_expr *expr = omp_clauses->num_teams; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("NUM_TEAMS clause at %L requires a scalar " + "INTEGER expression", &expr->where); + } + if (omp_clauses->device) + { + gfc_expr *expr = omp_clauses->device; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("DEVICE clause at %L requires a scalar " + "INTEGER expression", &expr->where); + } + if (omp_clauses->dist_chunk_size) + { + gfc_expr *expr = omp_clauses->dist_chunk_size; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("DIST_SCHEDULE clause's chunk_size at %L requires " + "a scalar INTEGER expression", &expr->where); + } + if (omp_clauses->thread_limit) + { + gfc_expr *expr = omp_clauses->thread_limit; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("THREAD_LIMIT clause at %L requires a scalar " + "INTEGER expression", &expr->where); + } } @@ -1142,12 +2632,13 @@ resolve_omp_atomic (gfc_code *code) gfc_code *atomic_code = code; gfc_symbol *var; gfc_expr *expr2, *expr2_tmp; + gfc_omp_atomic_op aop + = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK); code = code->block->next; gcc_assert (code->op == EXEC_ASSIGN); - gcc_assert ((atomic_code->ext.omp_atomic != GFC_OMP_ATOMIC_CAPTURE - && code->next == NULL) - || (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE + gcc_assert (((aop != GFC_OMP_ATOMIC_CAPTURE) && code->next == NULL) + || ((aop == GFC_OMP_ATOMIC_CAPTURE) && code->next != NULL && code->next->op == EXEC_ASSIGN && code->next->next == NULL)); @@ -1169,14 +2660,13 @@ resolve_omp_atomic (gfc_code *code) expr2 = is_conversion (code->expr2, false); if (expr2 == NULL) { - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_READ - || atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE) + if (aop == GFC_OMP_ATOMIC_READ || aop == GFC_OMP_ATOMIC_WRITE) expr2 = is_conversion (code->expr2, true); if (expr2 == NULL) expr2 = code->expr2; } - switch (atomic_code->ext.omp_atomic) + switch (aop) { case GFC_OMP_ATOMIC_READ: if (expr2->expr_type != EXPR_VARIABLE @@ -1249,7 +2739,21 @@ resolve_omp_atomic (gfc_code *code) break; } - if (expr2->expr_type == EXPR_OP) + if (var->attr.allocatable) + { + gfc_error ("!$OMP ATOMIC with ALLOCATABLE variable at %L", + &code->loc); + return; + } + + if (aop == GFC_OMP_ATOMIC_CAPTURE + && code->next == NULL + && code->expr2->rank == 0 + && !expr_references_sym (code->expr2, var, NULL)) + atomic_code->ext.omp_atomic + = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic + | GFC_OMP_ATOMIC_SWAP); + else if (expr2->expr_type == EXPR_OP) { gfc_expr *v = NULL, *e, *c; gfc_intrinsic_op op = expr2->value.op.op; @@ -1420,11 +2924,18 @@ resolve_omp_atomic (gfc_code *code) && arg->expr->symtree->n.sym == var) var_arg = arg; else if (expr_references_sym (arg->expr, var, NULL)) - gfc_error ("!$OMP ATOMIC intrinsic arguments except one must not " - "reference '%s' at %L", var->name, &arg->expr->where); + { + gfc_error ("!$OMP ATOMIC intrinsic arguments except one must " + "not reference '%s' at %L", + var->name, &arg->expr->where); + return; + } if (arg->expr->rank != 0) - gfc_error ("!$OMP ATOMIC intrinsic arguments must be scalar " - "at %L", &arg->expr->where); + { + gfc_error ("!$OMP ATOMIC intrinsic arguments must be scalar " + "at %L", &arg->expr->where); + return; + } } if (var_arg == NULL) @@ -1447,10 +2958,10 @@ resolve_omp_atomic (gfc_code *code) } } else - gfc_error ("!$OMP ATOMIC assignment must have an operator or intrinsic " - "on right hand side at %L", &expr2->where); + gfc_error ("!$OMP ATOMIC assignment must have an operator or " + "intrinsic on right hand side at %L", &expr2->where); - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE && code->next) + if (aop == GFC_OMP_ATOMIC_CAPTURE && code->next) { code = code->next; if (code->expr1->expr_type != EXPR_VARIABLE @@ -1542,7 +3053,7 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns) { struct omp_context ctx; gfc_omp_clauses *omp_clauses = code->ext.omp_clauses; - gfc_namelist *n; + gfc_omp_namelist *n; int list; ctx.code = code; @@ -1552,13 +3063,38 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns) omp_current_ctx = &ctx; for (list = 0; list < OMP_LIST_NUM; list++) - for (n = omp_clauses->lists[list]; n; n = n->next) - pointer_set_insert (ctx.sharing_clauses, n->sym); + switch (list) + { + case OMP_LIST_SHARED: + case OMP_LIST_PRIVATE: + case OMP_LIST_FIRSTPRIVATE: + case OMP_LIST_LASTPRIVATE: + case OMP_LIST_REDUCTION: + case OMP_LIST_LINEAR: + for (n = omp_clauses->lists[list]; n; n = n->next) + pointer_set_insert (ctx.sharing_clauses, n->sym); + break; + default: + break; + } - if (code->op == EXEC_OMP_PARALLEL_DO) - gfc_resolve_omp_do_blocks (code, ns); - else - gfc_resolve_blocks (code->block, ns); + switch (code->op) + { + case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + gfc_resolve_omp_do_blocks (code, ns); + break; + default: + gfc_resolve_blocks (code->block, ns); + } omp_current_ctx = ctx.previous; pointer_set_destroy (ctx.sharing_clauses); @@ -1624,9 +3160,9 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym) if (! pointer_set_insert (omp_current_ctx->private_iterators, sym)) { gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses; - gfc_namelist *p; + gfc_omp_namelist *p; - p = gfc_get_namelist (); + p = gfc_get_omp_namelist (); p->sym = sym; p->next = omp_clauses->lists[OMP_LIST_PRIVATE]; omp_clauses->lists[OMP_LIST_PRIVATE] = p; @@ -1639,11 +3175,64 @@ resolve_omp_do (gfc_code *code) { gfc_code *do_code, *c; int list, i, collapse; - gfc_namelist *n; + gfc_omp_namelist *n; gfc_symbol *dovar; + const char *name; + bool is_simd = false; + + switch (code->op) + { + case EXEC_OMP_DISTRIBUTE: name = "!$OMP DISTRIBUTE"; break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + name = "!$OMP DISTRIBUTE PARALLEL DO"; + break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "!$OMP DISTRIBUTE PARALLEL DO SIMD"; + is_simd = true; + break; + case EXEC_OMP_DISTRIBUTE_SIMD: + name = "!$OMP DISTRIBUTE SIMD"; + is_simd = true; + break; + case EXEC_OMP_DO: name = "!$OMP DO"; break; + case EXEC_OMP_DO_SIMD: name = "!$OMP DO SIMD"; is_simd = true; break; + case EXEC_OMP_PARALLEL_DO: name = "!$OMP PARALLEL DO"; break; + case EXEC_OMP_PARALLEL_DO_SIMD: + name = "!$OMP PARALLEL DO SIMD"; + is_simd = true; + break; + case EXEC_OMP_SIMD: name = "!$OMP SIMD"; is_simd = true; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + name = "!$OMP TARGET TEAMS_DISTRIBUTE"; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + name = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO"; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; + is_simd = true; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + name = "!$OMP TARGET TEAMS DISTRIBUTE SIMD"; + is_simd = true; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE: name = "!$OMP TEAMS_DISTRIBUTE"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + name = "!$OMP TEAMS DISTRIBUTE PARALLEL DO"; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "!$OMP TEAMS DISTRIBUTE PARALLEL DO SIMD"; + is_simd = true; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + name = "!$OMP TEAMS DISTRIBUTE SIMD"; + is_simd = true; + break; + default: gcc_unreachable (); + } if (code->ext.omp_clauses) - resolve_omp_clauses (code); + resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL); do_code = code->block->next; collapse = code->ext.omp_clauses->collapse; @@ -1653,27 +3242,46 @@ resolve_omp_do (gfc_code *code) { if (do_code->op == EXEC_DO_WHILE) { - gfc_error ("!$OMP DO cannot be a DO WHILE or DO without loop control " - "at %L", &do_code->loc); + gfc_error ("%s cannot be a DO WHILE or DO without loop control " + "at %L", name, &do_code->loc); + break; + } + if (do_code->op == EXEC_DO_CONCURRENT) + { + gfc_error ("%s cannot be a DO CONCURRENT loop at %L", name, + &do_code->loc); break; } gcc_assert (do_code->op == EXEC_DO); if (do_code->ext.iterator->var->ts.type != BT_INTEGER) - gfc_error ("!$OMP DO iteration variable must be of type integer at %L", - &do_code->loc); + gfc_error ("%s iteration variable must be of type integer at %L", + name, &do_code->loc); dovar = do_code->ext.iterator->var->symtree->n.sym; if (dovar->attr.threadprivate) - gfc_error ("!$OMP DO iteration variable must not be THREADPRIVATE " - "at %L", &do_code->loc); + gfc_error ("%s iteration variable must not be THREADPRIVATE " + "at %L", name, &do_code->loc); if (code->ext.omp_clauses) for (list = 0; list < OMP_LIST_NUM; list++) - if (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE) + if (!is_simd + ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE) + : code->ext.omp_clauses->collapse > 1 + ? (list != OMP_LIST_LASTPRIVATE) + : (list != OMP_LIST_LINEAR)) for (n = code->ext.omp_clauses->lists[list]; n; n = n->next) if (dovar == n->sym) { - gfc_error ("!$OMP DO iteration variable present on clause " - "other than PRIVATE or LASTPRIVATE at %L", - &do_code->loc); + if (!is_simd) + gfc_error ("%s iteration variable present on clause " + "other than PRIVATE or LASTPRIVATE at %L", + name, &do_code->loc); + else if (code->ext.omp_clauses->collapse > 1) + gfc_error ("%s iteration variable present on clause " + "other than LASTPRIVATE at %L", + name, &do_code->loc); + else + gfc_error ("%s iteration variable present on clause " + "other than LINEAR at %L", + name, &do_code->loc); break; } if (i > 1) @@ -1689,8 +3297,8 @@ resolve_omp_do (gfc_code *code) || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end) || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step)) { - gfc_error ("!$OMP DO collapsed loops don't form rectangular iteration space at %L", - &do_code->loc); + gfc_error ("%s collapsed loops don't form rectangular " + "iteration space at %L", name, &do_code->loc); break; } if (j < i) @@ -1703,8 +3311,8 @@ resolve_omp_do (gfc_code *code) for (c = do_code->next; c; c = c->next) if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE) { - gfc_error ("collapsed !$OMP DO loops not perfectly nested at %L", - &c->loc); + gfc_error ("collapsed %s loops not perfectly nested at %L", + name, &c->loc); break; } if (c) @@ -1712,16 +3320,16 @@ resolve_omp_do (gfc_code *code) do_code = do_code->block; if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE) { - gfc_error ("not enough DO loops for collapsed !$OMP DO at %L", - &code->loc); + gfc_error ("not enough DO loops for collapsed %s at %L", + name, &code->loc); break; } do_code = do_code->next; if (do_code == NULL || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)) { - gfc_error ("not enough DO loops for collapsed !$OMP DO at %L", - &code->loc); + gfc_error ("not enough DO loops for collapsed %s at %L", + name, &code->loc); break; } } @@ -1739,19 +3347,48 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) switch (code->op) { + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: resolve_omp_do (code); break; - case EXEC_OMP_WORKSHARE: + case EXEC_OMP_CANCEL: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TASK: + case EXEC_OMP_TEAMS: + case EXEC_OMP_WORKSHARE: if (code->ext.omp_clauses) - resolve_omp_clauses (code); + resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL); + break; + case EXEC_OMP_TARGET_UPDATE: + if (code->ext.omp_clauses) + resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL); + if (code->ext.omp_clauses == NULL + || (code->ext.omp_clauses->lists[OMP_LIST_TO] == NULL + && code->ext.omp_clauses->lists[OMP_LIST_FROM] == NULL)) + gfc_error ("OMP TARGET UPDATE at %L requires at least one TO or " + "FROM clause", &code->loc); break; case EXEC_OMP_ATOMIC: resolve_omp_atomic (code); @@ -1760,3 +3397,165 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) break; } } + +/* Resolve !$omp declare simd constructs in NS. */ + +void +gfc_resolve_omp_declare_simd (gfc_namespace *ns) +{ + gfc_omp_declare_simd *ods; + + for (ods = ns->omp_declare_simd; ods; ods = ods->next) + { + if (ods->proc_name != ns->proc_name) + gfc_error ("!$OMP DECLARE SIMD should refer to containing procedure " + "'%s' at %L", ns->proc_name->name, &ods->where); + if (ods->clauses) + resolve_omp_clauses (NULL, &ods->where, ods->clauses, ns); + } +} + +struct omp_udr_callback_data +{ + gfc_omp_udr *omp_udr; + bool is_initializer; +}; + +static int +omp_udr_callback (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data) +{ + struct omp_udr_callback_data *cd = (struct omp_udr_callback_data *) data; + if ((*e)->expr_type == EXPR_VARIABLE) + { + if (cd->is_initializer) + { + if ((*e)->symtree->n.sym != cd->omp_udr->omp_priv + && (*e)->symtree->n.sym != cd->omp_udr->omp_orig) + gfc_error ("Variable other than OMP_PRIV or OMP_ORIG used in " + "INITIALIZER clause of !$OMP DECLARE REDUCTION at %L", + &(*e)->where); + } + else + { + if ((*e)->symtree->n.sym != cd->omp_udr->omp_out + && (*e)->symtree->n.sym != cd->omp_udr->omp_in) + gfc_error ("Variable other than OMP_OUT or OMP_IN used in " + "combiner of !$OMP DECLARE REDUCTION at %L", + &(*e)->where); + } + } + return 0; +} + +/* Resolve !$omp declare reduction constructs. */ + +static void +gfc_resolve_omp_udr (gfc_omp_udr *omp_udr) +{ + gfc_actual_arglist *a; + const char *predef_name = NULL; + + switch (omp_udr->rop) + { + case OMP_REDUCTION_PLUS: + case OMP_REDUCTION_TIMES: + case OMP_REDUCTION_MINUS: + case OMP_REDUCTION_AND: + case OMP_REDUCTION_OR: + case OMP_REDUCTION_EQV: + case OMP_REDUCTION_NEQV: + case OMP_REDUCTION_MAX: + case OMP_REDUCTION_USER: + break; + default: + gfc_error ("Invalid operator for !$OMP DECLARE REDUCTION %s at %L", + omp_udr->name, &omp_udr->where); + return; + } + + if (gfc_omp_udr_predef (omp_udr->rop, omp_udr->name, + &omp_udr->ts, &predef_name)) + { + if (predef_name) + gfc_error_now ("Redefinition of predefined %s " + "!$OMP DECLARE REDUCTION at %L", + predef_name, &omp_udr->where); + else + gfc_error_now ("Redefinition of predefined " + "!$OMP DECLARE REDUCTION at %L", &omp_udr->where); + return; + } + + if (omp_udr->ts.type == BT_CHARACTER + && omp_udr->ts.u.cl->length + && omp_udr->ts.u.cl->length->expr_type != EXPR_CONSTANT) + { + gfc_error ("CHARACTER length in !$OMP DECLARE REDUCTION %s not " + "constant at %L", omp_udr->name, &omp_udr->where); + return; + } + + struct omp_udr_callback_data cd; + cd.omp_udr = omp_udr; + cd.is_initializer = false; + gfc_code_walker (&omp_udr->combiner_ns->code, gfc_dummy_code_callback, + omp_udr_callback, &cd); + if (omp_udr->combiner_ns->code->op == EXEC_CALL) + { + for (a = omp_udr->combiner_ns->code->ext.actual; a; a = a->next) + if (a->expr == NULL) + break; + if (a) + gfc_error ("Subroutine call with alternate returns in combiner " + "of !$OMP DECLARE REDUCTION at %L", + &omp_udr->combiner_ns->code->loc); + } + if (omp_udr->initializer_ns) + { + cd.is_initializer = true; + gfc_code_walker (&omp_udr->initializer_ns->code, gfc_dummy_code_callback, + omp_udr_callback, &cd); + if (omp_udr->initializer_ns->code->op == EXEC_CALL) + { + for (a = omp_udr->initializer_ns->code->ext.actual; a; a = a->next) + if (a->expr == NULL) + break; + if (a) + gfc_error ("Subroutine call with alternate returns in " + "INITIALIZER clause of !$OMP DECLARE REDUCTION " + "at %L", &omp_udr->initializer_ns->code->loc); + for (a = omp_udr->initializer_ns->code->ext.actual; a; a = a->next) + if (a->expr + && a->expr->expr_type == EXPR_VARIABLE + && a->expr->symtree->n.sym == omp_udr->omp_priv + && a->expr->ref == NULL) + break; + if (a == NULL) + gfc_error ("One of actual subroutine arguments in INITIALIZER " + "clause of !$OMP DECLARE REDUCTION must be OMP_PRIV " + "at %L", &omp_udr->initializer_ns->code->loc); + } + } + else if (omp_udr->ts.type == BT_DERIVED + && !gfc_has_default_initializer (omp_udr->ts.u.derived)) + { + gfc_error ("Missing INITIALIZER clause for !$OMP DECLARE REDUCTION " + "of derived type without default initializer at %L", + &omp_udr->where); + return; + } +} + +void +gfc_resolve_omp_udrs (gfc_symtree *st) +{ + gfc_omp_udr *omp_udr; + + if (st == NULL) + return; + gfc_resolve_omp_udrs (st->left); + gfc_resolve_omp_udrs (st->right); + for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next) + gfc_resolve_omp_udr (omp_udr); +} diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 0faf47a0041..3428b331e7c 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -74,6 +74,34 @@ match_word (const char *str, match (*subr) (void), locus *old_locus) } +/* Like match_word, but if str is matched, set a flag that it + was matched. */ +static match +match_word_omp_simd (const char *str, match (*subr) (void), locus *old_locus, + bool *simd_matched) +{ + match m; + + if (str != NULL) + { + m = gfc_match (str); + if (m != MATCH_YES) + return m; + *simd_matched = true; + } + + m = (*subr) (); + + if (m != MATCH_YES) + { + gfc_current_locus = *old_locus; + reject_statement (); + } + + return m; +} + + /* Load symbols from all USE statements encountered in this scoping unit. */ static void @@ -103,7 +131,7 @@ use_modules (void) if (match_word (keyword, subr, &old_locus) == MATCH_YES) \ return st; \ else \ - undo_new_statement (); \ + undo_new_statement (); \ } while (0); @@ -531,11 +559,34 @@ decode_statement (void) return ST_NONE; } +/* Like match, but set a flag simd_matched if keyword matched. */ +#define matchs(keyword, subr, st) \ + do { \ + if (match_word_omp_simd (keyword, subr, &old_locus, \ + &simd_matched) == MATCH_YES) \ + return st; \ + else \ + undo_new_statement (); \ + } while (0); + +/* Like match, but don't match anything if not -fopenmp. */ +#define matcho(keyword, subr, st) \ + do { \ + if (!gfc_option.gfc_flag_openmp) \ + ; \ + else if (match_word (keyword, subr, &old_locus) \ + == MATCH_YES) \ + return st; \ + else \ + undo_new_statement (); \ + } while (0); + static gfc_statement decode_omp_directive (void) { locus old_locus; char c; + bool simd_matched = false; gfc_enforce_clean_symbol_state (); @@ -560,77 +611,167 @@ decode_omp_directive (void) c = gfc_peek_ascii_char (); + /* match is for directives that should be recognized only if + -fopenmp, matchs for directives that should be recognized + if either -fopenmp or -fopenmp-simd. */ switch (c) { case 'a': - match ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC); + matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC); break; case 'b': - match ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER); + matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER); break; case 'c': - match ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL); + matcho ("cancellation% point", gfc_match_omp_cancellation_point, + ST_OMP_CANCELLATION_POINT); + matcho ("cancel", gfc_match_omp_cancel, ST_OMP_CANCEL); + matcho ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL); break; case 'd': - match ("do", gfc_match_omp_do, ST_OMP_DO); + matchs ("declare reduction", gfc_match_omp_declare_reduction, + ST_OMP_DECLARE_REDUCTION); + matchs ("declare simd", gfc_match_omp_declare_simd, + ST_OMP_DECLARE_SIMD); + matcho ("declare target", gfc_match_omp_declare_target, + ST_OMP_DECLARE_TARGET); + matchs ("distribute parallel do simd", + gfc_match_omp_distribute_parallel_do_simd, + ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD); + matcho ("distribute parallel do", gfc_match_omp_distribute_parallel_do, + ST_OMP_DISTRIBUTE_PARALLEL_DO); + matchs ("distribute simd", gfc_match_omp_distribute_simd, + ST_OMP_DISTRIBUTE_SIMD); + matcho ("distribute", gfc_match_omp_distribute, ST_OMP_DISTRIBUTE); + matchs ("do simd", gfc_match_omp_do_simd, ST_OMP_DO_SIMD); + matcho ("do", gfc_match_omp_do, ST_OMP_DO); break; case 'e': - match ("end atomic", gfc_match_omp_eos, ST_OMP_END_ATOMIC); - match ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL); - match ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO); - match ("end master", gfc_match_omp_eos, ST_OMP_END_MASTER); - match ("end ordered", gfc_match_omp_eos, ST_OMP_END_ORDERED); - match ("end parallel do", gfc_match_omp_eos, ST_OMP_END_PARALLEL_DO); - match ("end parallel sections", gfc_match_omp_eos, - ST_OMP_END_PARALLEL_SECTIONS); - match ("end parallel workshare", gfc_match_omp_eos, - ST_OMP_END_PARALLEL_WORKSHARE); - match ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL); - match ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS); - match ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE); - match ("end task", gfc_match_omp_eos, ST_OMP_END_TASK); - match ("end workshare", gfc_match_omp_end_nowait, - ST_OMP_END_WORKSHARE); + matcho ("end atomic", gfc_match_omp_eos, ST_OMP_END_ATOMIC); + matcho ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL); + matchs ("end distribute parallel do simd", gfc_match_omp_eos, + ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD); + matcho ("end distribute parallel do", gfc_match_omp_eos, + ST_OMP_END_DISTRIBUTE_PARALLEL_DO); + matchs ("end distribute simd", gfc_match_omp_eos, + ST_OMP_END_DISTRIBUTE_SIMD); + matcho ("end distribute", gfc_match_omp_eos, ST_OMP_END_DISTRIBUTE); + matchs ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD); + matcho ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO); + matchs ("end simd", gfc_match_omp_eos, ST_OMP_END_SIMD); + matcho ("end master", gfc_match_omp_eos, ST_OMP_END_MASTER); + matcho ("end ordered", gfc_match_omp_eos, ST_OMP_END_ORDERED); + matchs ("end parallel do simd", gfc_match_omp_eos, + ST_OMP_END_PARALLEL_DO_SIMD); + matcho ("end parallel do", gfc_match_omp_eos, ST_OMP_END_PARALLEL_DO); + matcho ("end parallel sections", gfc_match_omp_eos, + ST_OMP_END_PARALLEL_SECTIONS); + matcho ("end parallel workshare", gfc_match_omp_eos, + ST_OMP_END_PARALLEL_WORKSHARE); + matcho ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL); + matcho ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS); + matcho ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE); + matcho ("end target data", gfc_match_omp_eos, ST_OMP_END_TARGET_DATA); + matchs ("end target teams distribute parallel do simd", + gfc_match_omp_eos, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); + matcho ("end target teams distribute parallel do", gfc_match_omp_eos, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO); + matchs ("end target teams distribute simd", gfc_match_omp_eos, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD); + matcho ("end target teams distribute", gfc_match_omp_eos, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE); + matcho ("end target teams", gfc_match_omp_eos, ST_OMP_END_TARGET_TEAMS); + matcho ("end target", gfc_match_omp_eos, ST_OMP_END_TARGET); + matcho ("end taskgroup", gfc_match_omp_eos, ST_OMP_END_TASKGROUP); + matcho ("end task", gfc_match_omp_eos, ST_OMP_END_TASK); + matchs ("end teams distribute parallel do simd", gfc_match_omp_eos, + ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); + matcho ("end teams distribute parallel do", gfc_match_omp_eos, + ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO); + matchs ("end teams distribute simd", gfc_match_omp_eos, + ST_OMP_END_TEAMS_DISTRIBUTE_SIMD); + matcho ("end teams distribute", gfc_match_omp_eos, + ST_OMP_END_TEAMS_DISTRIBUTE); + matcho ("end teams", gfc_match_omp_eos, ST_OMP_END_TEAMS); + matcho ("end workshare", gfc_match_omp_end_nowait, + ST_OMP_END_WORKSHARE); break; case 'f': - match ("flush", gfc_match_omp_flush, ST_OMP_FLUSH); + matcho ("flush", gfc_match_omp_flush, ST_OMP_FLUSH); break; case 'm': - match ("master", gfc_match_omp_master, ST_OMP_MASTER); + matcho ("master", gfc_match_omp_master, ST_OMP_MASTER); break; case 'o': - match ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED); + matcho ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED); break; case 'p': - match ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO); - match ("parallel sections", gfc_match_omp_parallel_sections, - ST_OMP_PARALLEL_SECTIONS); - match ("parallel workshare", gfc_match_omp_parallel_workshare, - ST_OMP_PARALLEL_WORKSHARE); - match ("parallel", gfc_match_omp_parallel, ST_OMP_PARALLEL); + matchs ("parallel do simd", gfc_match_omp_parallel_do_simd, + ST_OMP_PARALLEL_DO_SIMD); + matcho ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO); + matcho ("parallel sections", gfc_match_omp_parallel_sections, + ST_OMP_PARALLEL_SECTIONS); + matcho ("parallel workshare", gfc_match_omp_parallel_workshare, + ST_OMP_PARALLEL_WORKSHARE); + matcho ("parallel", gfc_match_omp_parallel, ST_OMP_PARALLEL); break; case 's': - match ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS); - match ("section", gfc_match_omp_eos, ST_OMP_SECTION); - match ("single", gfc_match_omp_single, ST_OMP_SINGLE); + matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS); + matcho ("section", gfc_match_omp_eos, ST_OMP_SECTION); + matchs ("simd", gfc_match_omp_simd, ST_OMP_SIMD); + matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE); break; case 't': - match ("task", gfc_match_omp_task, ST_OMP_TASK); - match ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT); - match ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD); - match ("threadprivate", gfc_match_omp_threadprivate, - ST_OMP_THREADPRIVATE); + matcho ("target data", gfc_match_omp_target_data, ST_OMP_TARGET_DATA); + matchs ("target teams distribute parallel do simd", + gfc_match_omp_target_teams_distribute_parallel_do_simd, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); + matcho ("target teams distribute parallel do", + gfc_match_omp_target_teams_distribute_parallel_do, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO); + matchs ("target teams distribute simd", + gfc_match_omp_target_teams_distribute_simd, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD); + matcho ("target teams distribute", gfc_match_omp_target_teams_distribute, + ST_OMP_TARGET_TEAMS_DISTRIBUTE); + matcho ("target teams", gfc_match_omp_target_teams, ST_OMP_TARGET_TEAMS); + matcho ("target update", gfc_match_omp_target_update, + ST_OMP_TARGET_UPDATE); + matcho ("target", gfc_match_omp_target, ST_OMP_TARGET); + matcho ("taskgroup", gfc_match_omp_taskgroup, ST_OMP_TASKGROUP); + matcho ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT); + matcho ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD); + matcho ("task", gfc_match_omp_task, ST_OMP_TASK); + matchs ("teams distribute parallel do simd", + gfc_match_omp_teams_distribute_parallel_do_simd, + ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); + matcho ("teams distribute parallel do", + gfc_match_omp_teams_distribute_parallel_do, + ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO); + matchs ("teams distribute simd", gfc_match_omp_teams_distribute_simd, + ST_OMP_TEAMS_DISTRIBUTE_SIMD); + matcho ("teams distribute", gfc_match_omp_teams_distribute, + ST_OMP_TEAMS_DISTRIBUTE); + matcho ("teams", gfc_match_omp_teams, ST_OMP_TEAMS); + matcho ("threadprivate", gfc_match_omp_threadprivate, + ST_OMP_THREADPRIVATE); break; case 'w': - match ("workshare", gfc_match_omp_workshare, ST_OMP_WORKSHARE); + matcho ("workshare", gfc_match_omp_workshare, ST_OMP_WORKSHARE); break; } /* All else has failed, so give up. See if any of the matchers has - stored an error message of some sort. */ + stored an error message of some sort. Don't error out if + not -fopenmp and simd_matched is false, i.e. if a directive other + than one marked with match has been seen. */ - if (gfc_error_check () == 0) - gfc_error_now ("Unclassifiable OpenMP directive at %C"); + if (gfc_option.gfc_flag_openmp || simd_matched) + { + if (gfc_error_check () == 0) + gfc_error_now ("Unclassifiable OpenMP directive at %C"); + } reject_statement (); @@ -753,7 +894,9 @@ next_free (void) return decode_gcc_attribute (); } - else if (c == '$' && gfc_option.gfc_flag_openmp) + else if (c == '$' + && (gfc_option.gfc_flag_openmp + || gfc_option.gfc_flag_openmp_simd)) { int i; @@ -842,7 +985,9 @@ next_fixed (void) return decode_gcc_attribute (); } - else if (c == '$' && gfc_option.gfc_flag_openmp) + else if (c == '$' + && (gfc_option.gfc_flag_openmp + || gfc_option.gfc_flag_openmp_simd)) { for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING)) gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]); @@ -1013,8 +1158,9 @@ next_statement (void) case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \ case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \ case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \ - case ST_ERROR_STOP: case ST_SYNC_ALL: case ST_SYNC_IMAGES: \ - case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK + case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \ + case ST_OMP_TARGET_UPDATE: case ST_ERROR_STOP: case ST_SYNC_ALL: \ + case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK /* Statements that mark other executable statements. */ @@ -1026,14 +1172,28 @@ next_statement (void) case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \ case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \ case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \ - case ST_OMP_TASK: case ST_CRITICAL + case ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: \ + case ST_OMP_DO_SIMD: case ST_OMP_PARALLEL_DO_SIMD: case ST_OMP_TARGET: \ + case ST_OMP_TARGET_DATA: case ST_OMP_TARGET_TEAMS: \ + case ST_OMP_TARGET_TEAMS_DISTRIBUTE: \ + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: \ + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: \ + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: \ + case ST_OMP_TEAMS: case ST_OMP_TEAMS_DISTRIBUTE: \ + case ST_OMP_TEAMS_DISTRIBUTE_SIMD: \ + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: \ + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_DISTRIBUTE: \ + case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DISTRIBUTE_PARALLEL_DO: \ + case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: \ + case ST_CRITICAL /* Declaration statements */ #define case_decl case ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: \ case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \ case ST_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE: \ - case ST_PROCEDURE + case ST_PROCEDURE: case ST_OMP_DECLARE_SIMD: case ST_OMP_DECLARE_REDUCTION: \ + case ST_OMP_DECLARE_TARGET /* Block end statements. Errors associated with interchanging these are detected in gfc_match_end(). */ @@ -1524,21 +1684,69 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_BARRIER: p = "!$OMP BARRIER"; break; + case ST_OMP_CANCEL: + p = "!$OMP CANCEL"; + break; + case ST_OMP_CANCELLATION_POINT: + p = "!$OMP CANCELLATION POINT"; + break; case ST_OMP_CRITICAL: p = "!$OMP CRITICAL"; break; + case ST_OMP_DECLARE_REDUCTION: + p = "!$OMP DECLARE REDUCTION"; + break; + case ST_OMP_DECLARE_SIMD: + p = "!$OMP DECLARE SIMD"; + break; + case ST_OMP_DECLARE_TARGET: + p = "!$OMP DECLARE TARGET"; + break; + case ST_OMP_DISTRIBUTE: + p = "!$OMP DISTRIBUTE"; + break; + case ST_OMP_DISTRIBUTE_PARALLEL_DO: + p = "!$OMP DISTRIBUTE PARALLEL DO"; + break; + case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + p = "!$OMP DISTRIBUTE PARALLEL DO SIMD"; + break; + case ST_OMP_DISTRIBUTE_SIMD: + p = "!$OMP DISTRIBUTE SIMD"; + break; case ST_OMP_DO: p = "!$OMP DO"; break; + case ST_OMP_DO_SIMD: + p = "!$OMP DO SIMD"; + break; case ST_OMP_END_ATOMIC: p = "!$OMP END ATOMIC"; break; case ST_OMP_END_CRITICAL: p = "!$OMP END CRITICAL"; break; + case ST_OMP_END_DISTRIBUTE: + p = "!$OMP END DISTRIBUTE"; + break; + case ST_OMP_END_DISTRIBUTE_PARALLEL_DO: + p = "!$OMP END DISTRIBUTE PARALLEL DO"; + break; + case ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD: + p = "!$OMP END DISTRIBUTE PARALLEL DO SIMD"; + break; + case ST_OMP_END_DISTRIBUTE_SIMD: + p = "!$OMP END DISTRIBUTE SIMD"; + break; case ST_OMP_END_DO: p = "!$OMP END DO"; break; + case ST_OMP_END_DO_SIMD: + p = "!$OMP END DO SIMD"; + break; + case ST_OMP_END_SIMD: + p = "!$OMP END SIMD"; + break; case ST_OMP_END_MASTER: p = "!$OMP END MASTER"; break; @@ -1551,6 +1759,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_PARALLEL_DO: p = "!$OMP END PARALLEL DO"; break; + case ST_OMP_END_PARALLEL_DO_SIMD: + p = "!$OMP END PARALLEL DO SIMD"; + break; case ST_OMP_END_PARALLEL_SECTIONS: p = "!$OMP END PARALLEL SECTIONS"; break; @@ -1566,6 +1777,45 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_TASK: p = "!$OMP END TASK"; break; + case ST_OMP_END_TARGET: + p = "!$OMP END TARGET"; + break; + case ST_OMP_END_TARGET_DATA: + p = "!$OMP END TARGET DATA"; + break; + case ST_OMP_END_TARGET_TEAMS: + p = "!$OMP END TARGET TEAMS"; + break; + case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE: + p = "!$OMP END TARGET TEAMS DISTRIBUTE"; + break; + case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + p = "!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO"; + break; + case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + p = "!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; + break; + case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD: + p = "!$OMP END TARGET TEAMS DISTRIBUTE SIMD"; + break; + case ST_OMP_END_TASKGROUP: + p = "!$OMP END TASKGROUP"; + break; + case ST_OMP_END_TEAMS: + p = "!$OMP END TEAMS"; + break; + case ST_OMP_END_TEAMS_DISTRIBUTE: + p = "!$OMP END TEAMS DISTRIBUTE"; + break; + case ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO: + p = "!$OMP END TEAMS DISTRIBUTE PARALLEL DO"; + break; + case ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + p = "!$OMP END TEAMS DISTRIBUTE PARALLEL DO SIMD"; + break; + case ST_OMP_END_TEAMS_DISTRIBUTE_SIMD: + p = "!$OMP END TEAMS DISTRIBUTE SIMD"; + break; case ST_OMP_END_WORKSHARE: p = "!$OMP END WORKSHARE"; break; @@ -1584,6 +1834,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_PARALLEL_DO: p = "!$OMP PARALLEL DO"; break; + case ST_OMP_PARALLEL_DO_SIMD: + p = "!$OMP PARALLEL DO SIMD"; + break; case ST_OMP_PARALLEL_SECTIONS: p = "!$OMP PARALLEL SECTIONS"; break; @@ -1596,18 +1849,63 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_SECTION: p = "!$OMP SECTION"; break; + case ST_OMP_SIMD: + p = "!$OMP SIMD"; + break; case ST_OMP_SINGLE: p = "!$OMP SINGLE"; break; + case ST_OMP_TARGET: + p = "!$OMP TARGET"; + break; + case ST_OMP_TARGET_DATA: + p = "!$OMP TARGET DATA"; + break; + case ST_OMP_TARGET_TEAMS: + p = "!$OMP TARGET TEAMS"; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE: + p = "!$OMP TARGET TEAMS DISTRIBUTE"; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + p = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO"; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + p = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + p = "!$OMP TARGET TEAMS DISTRIBUTE SIMD"; + break; + case ST_OMP_TARGET_UPDATE: + p = "!$OMP TARGET UPDATE"; + break; case ST_OMP_TASK: p = "!$OMP TASK"; break; + case ST_OMP_TASKGROUP: + p = "!$OMP TASKGROUP"; + break; case ST_OMP_TASKWAIT: p = "!$OMP TASKWAIT"; break; case ST_OMP_TASKYIELD: p = "!$OMP TASKYIELD"; break; + case ST_OMP_TEAMS: + p = "!$OMP TEAMS"; + break; + case ST_OMP_TEAMS_DISTRIBUTE: + p = "!$OMP TEAMS DISTRIBUTE"; + break; + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + p = "!$OMP TEAMS DISTRIBUTE PARALLEL DO"; + break; + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + p = "!$OMP TEAMS DISTRIBUTE PARALLEL DO SIMD"; + break; + case ST_OMP_TEAMS_DISTRIBUTE_SIMD: + p = "!$OMP TEAMS DISTRIBUTE SIMD"; + break; case ST_OMP_THREADPRIVATE: p = "!$OMP THREADPRIVATE"; break; @@ -3578,7 +3876,53 @@ parse_omp_do (gfc_statement omp_st) pop_state (); st = next_statement (); - if (st == (omp_st == ST_OMP_DO ? ST_OMP_END_DO : ST_OMP_END_PARALLEL_DO)) + gfc_statement omp_end_st = ST_OMP_END_DO; + switch (omp_st) + { + case ST_OMP_DISTRIBUTE: omp_end_st = ST_OMP_END_DISTRIBUTE; break; + case ST_OMP_DISTRIBUTE_PARALLEL_DO: + omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO; + break; + case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD; + break; + case ST_OMP_DISTRIBUTE_SIMD: + omp_end_st = ST_OMP_END_DISTRIBUTE_SIMD; + break; + case ST_OMP_DO: omp_end_st = ST_OMP_END_DO; break; + case ST_OMP_DO_SIMD: omp_end_st = ST_OMP_END_DO_SIMD; break; + case ST_OMP_PARALLEL_DO: omp_end_st = ST_OMP_END_PARALLEL_DO; break; + case ST_OMP_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_PARALLEL_DO_SIMD; + break; + case ST_OMP_SIMD: omp_end_st = ST_OMP_END_SIMD; break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD; + break; + case ST_OMP_TEAMS_DISTRIBUTE: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE; + break; + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO; + break; + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; + break; + case ST_OMP_TEAMS_DISTRIBUTE_SIMD: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD; + break; + default: gcc_unreachable (); + } + if (st == omp_end_st) { if (new_st.op == EXEC_OMP_END_NOWAIT) cp->ext.omp_clauses->nowait |= new_st.ext.omp_bool; @@ -3610,7 +3954,8 @@ parse_omp_atomic (void) np = new_level (cp); np->op = cp->op; np->block = NULL; - count = 1 + (cp->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE); + count = 1 + ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_CAPTURE); while (count) { @@ -3636,7 +3981,8 @@ parse_omp_atomic (void) gfc_warning_check (); st = next_statement (); } - else if (cp->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE) + else if ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_CAPTURE) gfc_error ("Missing !$OMP END ATOMIC after !$OMP ATOMIC CAPTURE at %C"); return st; } @@ -3682,9 +4028,60 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case ST_OMP_SINGLE: omp_end_st = ST_OMP_END_SINGLE; break; + case ST_OMP_TARGET: + omp_end_st = ST_OMP_END_TARGET; + break; + case ST_OMP_TARGET_DATA: + omp_end_st = ST_OMP_END_TARGET_DATA; + break; + case ST_OMP_TARGET_TEAMS: + omp_end_st = ST_OMP_END_TARGET_TEAMS; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD; + break; case ST_OMP_TASK: omp_end_st = ST_OMP_END_TASK; break; + case ST_OMP_TASKGROUP: + omp_end_st = ST_OMP_END_TASKGROUP; + break; + case ST_OMP_TEAMS: + omp_end_st = ST_OMP_END_TEAMS; + break; + case ST_OMP_TEAMS_DISTRIBUTE: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE; + break; + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO; + break; + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; + break; + case ST_OMP_TEAMS_DISTRIBUTE_SIMD: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD; + break; + case ST_OMP_DISTRIBUTE: + omp_end_st = ST_OMP_END_DISTRIBUTE; + break; + case ST_OMP_DISTRIBUTE_PARALLEL_DO: + omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO; + break; + case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD; + break; + case ST_OMP_DISTRIBUTE_SIMD: + omp_end_st = ST_OMP_END_DISTRIBUTE_SIMD; + break; case ST_OMP_WORKSHARE: omp_end_st = ST_OMP_END_WORKSHARE; break; @@ -3744,6 +4141,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) break; case ST_OMP_PARALLEL_DO: + case ST_OMP_PARALLEL_DO_SIMD: st = parse_omp_do (st); continue; @@ -3916,7 +4314,12 @@ parse_executable (gfc_statement st) case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: + case ST_OMP_TARGET: + case ST_OMP_TARGET_DATA: + case ST_OMP_TARGET_TEAMS: + case ST_OMP_TEAMS: case ST_OMP_TASK: + case ST_OMP_TASKGROUP: parse_omp_structured_block (st, false); break; @@ -3925,8 +4328,23 @@ parse_executable (gfc_statement st) parse_omp_structured_block (st, true); break; + case ST_OMP_DISTRIBUTE: + case ST_OMP_DISTRIBUTE_PARALLEL_DO: + case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DO: + case ST_OMP_DO_SIMD: case ST_OMP_PARALLEL_DO: + case ST_OMP_PARALLEL_DO_SIMD: + case ST_OMP_SIMD: + case ST_OMP_TARGET_TEAMS_DISTRIBUTE: + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case ST_OMP_TEAMS_DISTRIBUTE: + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case ST_OMP_TEAMS_DISTRIBUTE_SIMD: st = parse_omp_do (st); if (st == ST_IMPLIED_ENDDO) return st; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 38755fef6a2..c959f5d9514 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -40,7 +40,7 @@ typedef enum seq_type seq_type; /* Stack to keep track of the nesting of blocks as we move through the - code. See resolve_branch() and resolve_code(). */ + code. See resolve_branch() and gfc_resolve_code(). */ typedef struct code_stack { @@ -2887,7 +2887,8 @@ resolve_function (gfc_expr *expr) /* See if function is already resolved. */ - if (expr->value.function.name != NULL) + if (expr->value.function.name != NULL + || expr->value.function.isym != NULL) { if (expr->ts.type == BT_UNKNOWN) expr->ts = sym->ts; @@ -4884,7 +4885,7 @@ resolve_variable (gfc_expr *e) if (check_assumed_size_reference (sym, e)) return false; - /* Deal with forward references to entries during resolve_code, to + /* Deal with forward references to entries during gfc_resolve_code, to satisfy, at least partially, 12.5.2.5. */ if (gfc_current_ns->entries && current_entry_id == sym->entry_id @@ -8926,8 +8927,6 @@ resolve_block_construct (gfc_code* code) /* Resolve lists of blocks found in IF, SELECT CASE, WHERE, FORALL, GOTO and DO code nodes. */ -static void resolve_code (gfc_code *, gfc_namespace *); - void gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) { @@ -8979,18 +8978,39 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_ATOMIC: case EXEC_OMP_CRITICAL: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: break; @@ -8998,7 +9018,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) gfc_internal_error ("gfc_resolve_blocks(): Bad block type"); } - resolve_code (b->next, ns); + gfc_resolve_code (b->next, ns); } } @@ -9411,7 +9431,7 @@ nonscalar_typebound_assign (gfc_symbol *derived, int depth) The pointer assignments are taken care of by the intrinsic assignment of the structure itself. This function recursively adds defined assignments where required. The recursion is accomplished - by calling resolve_code. + by calling gfc_resolve_code. When the lhs in a defined assignment has intent INOUT, we need a temporary for the lhs. In pseudo-code: @@ -9529,9 +9549,9 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) comp1, comp2, (*code)->loc); /* Convert the assignment if there is a defined assignment for - this type. Otherwise, using the call from resolve_code, + this type. Otherwise, using the call from gfc_resolve_code, recurse into its components. */ - resolve_code (this_code, ns); + gfc_resolve_code (this_code, ns); if (this_code->op == EXEC_ASSIGN_CALL) { @@ -9695,8 +9715,8 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) /* Given a block of code, recursively resolve everything pointed to by this code block. */ -static void -resolve_code (gfc_code *code, gfc_namespace *ns) +void +gfc_resolve_code (gfc_code *code, gfc_namespace *ns) { int omp_workshare_save; int forall_save, do_concurrent_save; @@ -9733,13 +9753,28 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_TASK: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: omp_workshare_save = omp_workshare_flag; omp_workshare_flag = 0; gfc_resolve_omp_parallel_blocks (code, ns); break; + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: + case EXEC_OMP_SIMD: gfc_resolve_omp_do_blocks (code, ns); break; case EXEC_SELECT_TYPE: @@ -9960,7 +9995,8 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_DO_WHILE: if (code->expr1 == NULL) - gfc_internal_error ("resolve_code(): No expression on DO WHILE"); + gfc_internal_error ("gfc_resolve_code(): No expression on " + "DO WHILE"); if (t && (code->expr1->rank != 0 || code->expr1->ts.type != BT_LOGICAL)) @@ -10054,24 +10090,47 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_CRITICAL: case EXEC_OMP_FLUSH: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: + case EXEC_OMP_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: gfc_resolve_omp_directive (code, ns); break; case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: - case EXEC_OMP_TASK: omp_workshare_save = omp_workshare_flag; omp_workshare_flag = 0; gfc_resolve_omp_directive (code, ns); @@ -10079,7 +10138,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; default: - gfc_internal_error ("resolve_code(): Bad statement code"); + gfc_internal_error ("gfc_resolve_code(): Bad statement code"); } } @@ -10779,7 +10838,10 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) } /* Constraints on deferred type parameter. */ - if (sym->ts.deferred && !(sym->attr.pointer || sym->attr.allocatable)) + if (sym->ts.deferred + && !(sym->attr.pointer + || sym->attr.allocatable + || sym->attr.omp_udr_artificial_var)) { gfc_error ("Entity '%s' at %L has a deferred type parameter and " "requires either the pointer or allocatable attribute", @@ -10794,7 +10856,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) dummy arguments. */ e = sym->ts.u.cl->length; if (e == NULL && !sym->attr.dummy && !sym->attr.result - && !sym->ts.deferred && !sym->attr.select_type_temporary) + && !sym->ts.deferred && !sym->attr.select_type_temporary + && !sym->attr.omp_udr_artificial_var) { gfc_error ("Entity with assumed character length at %L must be a " "dummy argument or a PARAMETER", &sym->declared_at); @@ -13429,6 +13492,18 @@ resolve_symbol (gfc_symbol *sym) || sym->ns->proc_name->attr.flavor != FL_MODULE))) gfc_error ("Threadprivate at %L isn't SAVEd", &sym->declared_at); + /* Check omp declare target restrictions. */ + if (sym->attr.omp_declare_target + && sym->attr.flavor == FL_VARIABLE + && !sym->attr.save + && !sym->ns->save_all + && (!sym->attr.in_common + && sym->module == NULL + && (sym->ns->proc_name == NULL + || sym->ns->proc_name->attr.flavor != FL_MODULE))) + gfc_error ("!$OMP DECLARE TARGET variable '%s' at %L isn't SAVEd", + sym->name, &sym->declared_at); + /* If we have come this far we can apply default-initializers, as described in 14.7.5, to those variables that have not already been assigned one. */ @@ -14526,7 +14601,7 @@ gfc_resolve_uops (gfc_symtree *symtree) assign types to all intermediate expressions, make sure that all assignments are to compatible types and figure out which names refer to which functions or subroutines. It doesn't check code - block, which is handled by resolve_code. */ + block, which is handled by gfc_resolve_code. */ static void resolve_types (gfc_namespace *ns) @@ -14607,11 +14682,15 @@ resolve_types (gfc_namespace *ns) gfc_resolve_uops (ns->uop_root); + gfc_resolve_omp_declare_simd (ns); + + gfc_resolve_omp_udrs (ns->omp_udr_root); + gfc_current_ns = old_ns; } -/* Call resolve_code recursively. */ +/* Call gfc_resolve_code recursively. */ static void resolve_codes (gfc_namespace *ns) @@ -14637,7 +14716,7 @@ resolve_codes (gfc_namespace *ns) old_obstack = labels_obstack; bitmap_obstack_initialize (&labels_obstack); - resolve_code (ns->code, ns); + gfc_resolve_code (ns->code, ns); bitmap_obstack_release (&labels_obstack); labels_obstack = old_obstack; diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 8f517342129..8934924d876 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -752,7 +752,8 @@ skip_free_comments (void) 2) handle OpenMP conditional compilation, where !$ should be treated as 2 spaces (for initial lines only if followed by space). */ - if (gfc_option.gfc_flag_openmp && at_bol) + if ((gfc_option.gfc_flag_openmp + || gfc_option.gfc_flag_openmp_simd) && at_bol) { locus old_loc = gfc_current_locus; if (next_char () == '$') @@ -878,7 +879,7 @@ skip_fixed_comments (void) && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); - if (gfc_option.gfc_flag_openmp) + if (gfc_option.gfc_flag_openmp || gfc_option.gfc_flag_openmp_simd) { if (next_char () == '$') { @@ -1821,7 +1822,7 @@ include_line (gfc_char_t *line) c = line; - if (gfc_option.gfc_flag_openmp) + if (gfc_option.gfc_flag_openmp || gfc_option.gfc_flag_openmp_simd) { if (gfc_current_form == FORM_FREE) { diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 0e1cc705eb4..0f18f787231 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -185,14 +185,36 @@ gfc_free_statement (gfc_code *p) gfc_free_forall_iterator (p->ext.forall_iterator); break; + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_END_SINGLE: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: case EXEC_OMP_PARALLEL_WORKSHARE: gfc_free_omp_clauses (p->ext.omp_clauses); @@ -203,7 +225,7 @@ gfc_free_statement (gfc_code *p) break; case EXEC_OMP_FLUSH: - gfc_free_namelist (p->ext.omp_namelist); + gfc_free_omp_namelist (p->ext.omp_namelist); break; case EXEC_OMP_ATOMIC: @@ -211,6 +233,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_END_NOWAIT: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: break; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 19d792e0862..8edd6931f97 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -367,6 +367,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) *asynchronous = "ASYNCHRONOUS", *codimension = "CODIMENSION", *contiguous = "CONTIGUOUS", *generic = "GENERIC"; static const char *threadprivate = "THREADPRIVATE"; + static const char *omp_declare_target = "OMP DECLARE TARGET"; const char *a1, *a2; int standard; @@ -453,6 +454,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (dummy, entry); conf (dummy, intrinsic); conf (dummy, threadprivate); + conf (dummy, omp_declare_target); conf (pointer, target); conf (pointer, intrinsic); conf (pointer, elemental); @@ -495,6 +497,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (in_equivalence, entry); conf (in_equivalence, allocatable); conf (in_equivalence, threadprivate); + conf (in_equivalence, omp_declare_target); conf (dummy, result); conf (entry, result); @@ -543,6 +546,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (cray_pointee, in_common); conf (cray_pointee, in_equivalence); conf (cray_pointee, threadprivate); + conf (cray_pointee, omp_declare_target); conf (data, dummy); conf (data, function); @@ -596,6 +600,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (proc_pointer, abstract) + conf (entry, omp_declare_target) + a1 = gfc_code2string (flavors, attr->flavor); if (attr->in_namelist @@ -631,6 +637,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (function); conf2 (subroutine); conf2 (threadprivate); + conf2 (omp_declare_target); if (attr->access == ACCESS_PUBLIC || attr->access == ACCESS_PRIVATE) { @@ -712,6 +719,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (subroutine); conf2 (threadprivate); conf2 (result); + conf2 (omp_declare_target); if (attr->intent != INTENT_UNKNOWN) { @@ -1207,6 +1215,22 @@ gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where) bool +gfc_add_omp_declare_target (symbol_attribute *attr, const char *name, + locus *where) +{ + + if (check_used (attr, name, where)) + return false; + + if (attr->omp_declare_target) + return true; + + attr->omp_declare_target = 1; + return check_conflict (attr, name, where); +} + + +bool gfc_add_target (symbol_attribute *attr, locus *where) { @@ -1761,6 +1785,9 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) if (src->threadprivate && !gfc_add_threadprivate (dest, NULL, where)) goto fail; + if (src->omp_declare_target + && !gfc_add_omp_declare_target (dest, NULL, where)) + goto fail; if (src->target && !gfc_add_target (dest, where)) goto fail; if (src->dummy && !gfc_add_dummy (dest, NULL, where)) @@ -2450,17 +2477,20 @@ gfc_get_uop (const char *name) { gfc_user_op *uop; gfc_symtree *st; + gfc_namespace *ns = gfc_current_ns; - st = gfc_find_symtree (gfc_current_ns->uop_root, name); + if (ns->omp_udr_ns) + ns = ns->parent; + st = gfc_find_symtree (ns->uop_root, name); if (st != NULL) return st->n.uop; - st = gfc_new_symtree (&gfc_current_ns->uop_root, name); + st = gfc_new_symtree (&ns->uop_root, name); uop = st->n.uop = XCNEW (gfc_user_op); uop->name = gfc_get_string (name); uop->access = ACCESS_UNKNOWN; - uop->ns = gfc_current_ns; + uop->ns = ns; return uop; } @@ -2771,6 +2801,12 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result, /* Try to find the symbol in ns. */ st = gfc_find_symtree (ns->sym_root, name); + if (st == NULL && ns->omp_udr_ns) + { + ns = ns->parent; + st = gfc_find_symtree (ns->sym_root, name); + } + if (st == NULL) { /* If not there, create a new symbol. */ @@ -3269,6 +3305,23 @@ free_common_tree (gfc_symtree * common_tree) } +/* Recursive function that deletes an entire tree and all the common + head structures it points to. */ + +static void +free_omp_udr_tree (gfc_symtree * omp_udr_tree) +{ + if (omp_udr_tree == NULL) + return; + + free_omp_udr_tree (omp_udr_tree->left); + free_omp_udr_tree (omp_udr_tree->right); + + gfc_free_omp_udr (omp_udr_tree->n.omp_udr); + free (omp_udr_tree); +} + + /* Recursive function that deletes an entire tree and all the user operator nodes that it contains. */ @@ -3465,9 +3518,11 @@ gfc_free_namespace (gfc_namespace *ns) free_sym_tree (ns->sym_root); free_uop_tree (ns->uop_root); free_common_tree (ns->common_root); + free_omp_udr_tree (ns->omp_udr_root); free_tb_tree (ns->tb_sym_root); free_tb_tree (ns->tb_uop_root); gfc_free_finalizer_list (ns->finalizers); + gfc_free_omp_declare_simd_list (ns->omp_declare_simd); gfc_free_charlen (ns->cl_list, NULL); free_st_labels (ns->st_labels); diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 850277747c1..a36db45c0a7 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7389,8 +7389,8 @@ gfc_trans_dealloc_allocated (tree descriptor, bool coarray, gfc_expr *expr) /* This helper function calculates the size in words of a full array. */ -static tree -get_full_array_size (stmtblock_t *block, tree decl, int rank) +tree +gfc_full_array_size (stmtblock_t *block, tree decl, int rank) { tree idx; tree nelems; @@ -7416,7 +7416,7 @@ get_full_array_size (stmtblock_t *block, tree decl, int rank) static tree duplicate_allocatable (tree dest, tree src, tree type, int rank, - bool no_malloc, tree str_sz) + bool no_malloc, bool no_memcpy, tree str_sz) { tree tmp; tree size; @@ -7450,9 +7450,13 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, gfc_add_expr_to_block (&block, tmp); } - tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); - tmp = build_call_expr_loc (input_location, tmp, 3, dest, src, - fold_convert (size_type_node, size)); + if (!no_memcpy) + { + tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); + tmp = build_call_expr_loc (input_location, tmp, 3, dest, src, + fold_convert (size_type_node, size)); + gfc_add_expr_to_block (&block, tmp); + } } else { @@ -7461,7 +7465,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, gfc_init_block (&block); if (rank) - nelems = get_full_array_size (&block, src, rank); + nelems = gfc_full_array_size (&block, src, rank); else nelems = gfc_index_one_node; @@ -7481,14 +7485,17 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, /* We know the temporary and the value will be the same length, so can use memcpy. */ - tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); - tmp = build_call_expr_loc (input_location, - tmp, 3, gfc_conv_descriptor_data_get (dest), - gfc_conv_descriptor_data_get (src), - fold_convert (size_type_node, size)); + if (!no_memcpy) + { + tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); + tmp = build_call_expr_loc (input_location, tmp, 3, + gfc_conv_descriptor_data_get (dest), + gfc_conv_descriptor_data_get (src), + fold_convert (size_type_node, size)); + gfc_add_expr_to_block (&block, tmp); + } } - gfc_add_expr_to_block (&block, tmp); tmp = gfc_finish_block (&block); /* Null the destination if the source is null; otherwise do @@ -7510,7 +7517,8 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank) { - return duplicate_allocatable (dest, src, type, rank, false, NULL_TREE); + return duplicate_allocatable (dest, src, type, rank, false, false, + NULL_TREE); } @@ -7519,7 +7527,16 @@ gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank) tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank) { - return duplicate_allocatable (dest, src, type, rank, true, NULL_TREE); + return duplicate_allocatable (dest, src, type, rank, true, false, + NULL_TREE); +} + +/* Allocate dest to the same size as src, but don't copy anything. */ + +tree +gfc_duplicate_allocatable_nocopy (tree dest, tree src, tree type, int rank) +{ + return duplicate_allocatable (dest, src, type, rank, false, true, NULL_TREE); } @@ -7579,7 +7596,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, /* Use the descriptor for an allocatable array. Since this is a full array reference, we only need the descriptor information from dimension = rank. */ - tmp = get_full_array_size (&fnblock, decl, rank); + tmp = gfc_full_array_size (&fnblock, decl, rank); tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, tmp, gfc_index_one_node); @@ -7938,7 +7955,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_add_expr_to_block (&fnblock, tmp); size = size_of_string_in_bytes (c->ts.kind, len); tmp = duplicate_allocatable (dcmp, comp, ctype, rank, - false, size); + false, false, size); gfc_add_expr_to_block (&fnblock, tmp); } else if (c->attr.allocatable && !c->attr.proc_pointer diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index c4c09c1c51e..e0bb82071fa 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -44,10 +44,14 @@ void gfc_trans_g77_array (gfc_symbol *, gfc_wrapped_block *); /* Generate code to deallocate an array, if it is allocated. */ tree gfc_trans_dealloc_allocated (tree, bool, gfc_expr *); +tree gfc_full_array_size (stmtblock_t *, tree, int); + tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank); tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank); +tree gfc_duplicate_allocatable_nocopy (tree, tree, tree, int); + tree gfc_nullify_alloc_comp (gfc_symbol *, tree, int); tree gfc_deallocate_alloc_comp (gfc_symbol *, tree, int); diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 19eaddae2ce..bb66abc3665 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -456,6 +456,11 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) if (com->threadprivate) DECL_TLS_MODEL (decl) = decl_default_tls_model (decl); + if (com->omp_declare_target) + DECL_ATTRIBUTES (decl) + = tree_cons (get_identifier ("omp declare target"), + NULL_TREE, DECL_ATTRIBUTES (decl)); + /* Place the back end declaration for this common block in GLOBAL_BINDING_LEVEL. */ gfc_map_of_all_commons[identifier] = pushdecl_top_level (decl); @@ -705,6 +710,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv) TREE_ADDRESSABLE (var_decl) = 1; /* Fake variables are not visible from other translation units. */ TREE_PUBLIC (var_decl) = 0; + gfc_finish_decl_attrs (var_decl, &s->sym->attr); /* To preserve identifier names in COMMON, chain to procedure scope unless at top level in a module definition. */ diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b1f66c01982..2b0667960f3 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -496,6 +496,29 @@ gfc_finish_decl (tree decl) } +/* Handle setting of GFC_DECL_SCALAR* on DECL. */ + +void +gfc_finish_decl_attrs (tree decl, symbol_attribute *attr) +{ + if (!attr->dimension && !attr->codimension) + { + /* Handle scalar allocatable variables. */ + if (attr->allocatable) + { + gfc_allocate_lang_decl (decl); + GFC_DECL_SCALAR_ALLOCATABLE (decl) = 1; + } + /* Handle scalar pointer variables. */ + if (attr->pointer) + { + gfc_allocate_lang_decl (decl); + GFC_DECL_SCALAR_POINTER (decl) = 1; + } + } +} + + /* Apply symbol attributes to a variable, and add it to the function scope. */ static void @@ -607,6 +630,8 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) if (sym->attr.threadprivate && (TREE_STATIC (decl) || DECL_EXTERNAL (decl))) DECL_TLS_MODEL (decl) = decl_default_tls_model (decl); + + gfc_finish_decl_attrs (decl, &sym->attr); } @@ -615,8 +640,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) void gfc_allocate_lang_decl (tree decl) { - DECL_LANG_SPECIFIC (decl) = ggc_alloc_cleared_lang_decl(sizeof - (struct lang_decl)); + if (DECL_LANG_SPECIFIC (decl) == NULL) + DECL_LANG_SPECIFIC (decl) + = ggc_alloc_cleared_lang_decl (sizeof (struct lang_decl)); } /* Remember a symbol to generate initialization/cleanup code at function @@ -1192,6 +1218,10 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) list = chainon (list, attr); } + if (sym_attr.omp_declare_target) + list = tree_cons (get_identifier ("omp declare target"), + NULL_TREE, list); + return list; } @@ -1518,6 +1548,9 @@ gfc_get_symbol_decl (gfc_symbol * sym) && !sym->attr.select_type_temporary) DECL_BY_REFERENCE (decl) = 1; + if (sym->attr.associate_var) + GFC_DECL_ASSOCIATE_VAR_P (decl) = 1; + if (sym->attr.vtab || (sym->name[0] == '_' && strncmp ("__def_init", sym->name, 10) == 0)) TREE_READONLY (decl) = 1; @@ -1850,6 +1883,11 @@ module_sym: if (DECL_CONTEXT (fndecl) == NULL_TREE) pushdecl_top_level (fndecl); + if (sym->formal_ns + && sym->formal_ns->proc_name == sym + && sym->formal_ns->omp_declare_simd) + gfc_trans_omp_declare_simd (sym->formal_ns); + return fndecl; } @@ -2232,6 +2270,7 @@ create_function_arglist (gfc_symbol * sym) DECL_BY_REFERENCE (parm) = 1; gfc_finish_decl (parm); + gfc_finish_decl_attrs (parm, &f->sym->attr); f->sym->backend_decl = parm; @@ -2544,6 +2583,9 @@ gfc_create_function_decl (gfc_namespace * ns, bool global) /* Now create the read argument list. */ create_function_arglist (ns->proc_name); + + if (ns->omp_declare_simd) + gfc_trans_omp_declare_simd (ns); } /* Return the decl used to hold the function return value. If @@ -2672,6 +2714,7 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) TREE_ADDRESSABLE (decl) = 1; layout_decl (decl, 0); + gfc_finish_decl_attrs (decl, &sym->attr); if (parent_flag) gfc_add_decl_to_parent_function (decl); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 955102b042e..dbfde1bdce3 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6472,6 +6472,20 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr) /* Take the address of that value. */ se->expr = gfc_build_addr_expr (NULL_TREE, var); + if (expr->ts.type == BT_DERIVED && expr->rank + && !gfc_is_finalizable (expr->ts.u.derived, NULL) + && expr->ts.u.derived->attr.alloc_comp + && expr->expr_type != EXPR_VARIABLE) + { + tree tmp; + + tmp = build_fold_indirect_ref_loc (input_location, se->expr); + tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank); + + /* The components shall be deallocated before + their containing entity. */ + gfc_prepend_expr_to_block (&se->post, tmp); + } } @@ -7251,7 +7265,7 @@ fcncall_realloc_result (gfc_se *se, int rank) res_desc = gfc_evaluate_now (desc, &se->pre); gfc_conv_descriptor_data_set (&se->pre, res_desc, null_pointer_node); - se->expr = gfc_build_addr_expr (TREE_TYPE (se->expr), res_desc); + se->expr = gfc_build_addr_expr (NULL_TREE, res_desc); /* Free the lhs after the function call and copy the result data to the lhs descriptor. */ diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 41020a836a7..da01a9034cb 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -53,9 +53,13 @@ gfc_omp_privatize_by_reference (const_tree decl) if (TREE_CODE (type) == POINTER_TYPE) { /* Array POINTER/ALLOCATABLE have aggregate types, all user variables - that have POINTER_TYPE type and don't have GFC_POINTER_TYPE_P - set are supposed to be privatized by reference. */ - if (GFC_POINTER_TYPE_P (type)) + that have POINTER_TYPE type and aren't scalar pointers, scalar + allocatables, Cray pointees or C pointers are supposed to be + privatized by reference. */ + if (GFC_DECL_GET_SCALAR_POINTER (decl) + || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl) + || GFC_DECL_CRAY_POINTEE (decl) + || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))) return false; if (!DECL_ARTIFICIAL (decl) @@ -77,6 +81,19 @@ gfc_omp_privatize_by_reference (const_tree decl) enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree decl) { + /* Associate names preserve the association established during ASSOCIATE. + As they are implemented either as pointers to the selector or array + descriptor and shouldn't really change in the ASSOCIATE region, + this decl can be either shared or firstprivate. If it is a pointer, + use firstprivate, as it is cheaper that way, otherwise make it shared. */ + if (GFC_DECL_ASSOCIATE_VAR_P (decl)) + { + if (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE) + return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE; + else + return OMP_CLAUSE_DEFAULT_SHARED; + } + if (DECL_ARTIFICIAL (decl) && ! GFC_DECL_RESULT (decl) && ! (DECL_LANG_SPECIFIC (decl) @@ -135,6 +152,41 @@ gfc_omp_report_decl (tree decl) return decl; } +/* Return true if TYPE has any allocatable components. */ + +static bool +gfc_has_alloc_comps (tree type, tree decl) +{ + tree field, ftype; + + if (POINTER_TYPE_P (type)) + { + if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)) + type = TREE_TYPE (type); + else if (GFC_DECL_GET_SCALAR_POINTER (decl)) + return false; + } + + while (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type)) + type = gfc_get_element_type (type); + + if (TREE_CODE (type) != RECORD_TYPE) + return false; + + for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field)) + { + ftype = TREE_TYPE (field); + if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field)) + return true; + if (GFC_DESCRIPTOR_TYPE_P (ftype) + && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE) + return true; + if (gfc_has_alloc_comps (ftype, field)) + return true; + } + return false; +} + /* Return true if DECL in private clause needs OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause. */ bool @@ -146,68 +198,335 @@ gfc_omp_private_outer_ref (tree decl) && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) return true; + if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)) + return true; + + if (gfc_omp_privatize_by_reference (decl)) + type = TREE_TYPE (type); + + if (gfc_has_alloc_comps (type, decl)) + return true; + return false; } +/* Callback for gfc_omp_unshare_expr. */ + +static tree +gfc_omp_unshare_expr_r (tree *tp, int *walk_subtrees, void *) +{ + tree t = *tp; + enum tree_code code = TREE_CODE (t); + + /* Stop at types, decls, constants like copy_tree_r. */ + if (TREE_CODE_CLASS (code) == tcc_type + || TREE_CODE_CLASS (code) == tcc_declaration + || TREE_CODE_CLASS (code) == tcc_constant + || code == BLOCK) + *walk_subtrees = 0; + else if (handled_component_p (t) + || TREE_CODE (t) == MEM_REF) + { + *tp = unshare_expr (t); + *walk_subtrees = 0; + } + + return NULL_TREE; +} + +/* Unshare in expr anything that the FE which normally doesn't + care much about tree sharing (because during gimplification + everything is unshared) could cause problems with tree sharing + at omp-low.c time. */ + +static tree +gfc_omp_unshare_expr (tree expr) +{ + walk_tree (&expr, gfc_omp_unshare_expr_r, NULL, NULL); + return expr; +} + +enum walk_alloc_comps +{ + WALK_ALLOC_COMPS_DTOR, + WALK_ALLOC_COMPS_DEFAULT_CTOR, + WALK_ALLOC_COMPS_COPY_CTOR +}; + +/* Handle allocatable components in OpenMP clauses. */ + +static tree +gfc_walk_alloc_comps (tree decl, tree dest, tree var, + enum walk_alloc_comps kind) +{ + stmtblock_t block, tmpblock; + tree type = TREE_TYPE (decl), then_b, tem, field; + gfc_init_block (&block); + + if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type)) + { + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + gfc_init_block (&tmpblock); + tem = gfc_full_array_size (&tmpblock, decl, + GFC_TYPE_ARRAY_RANK (type)); + then_b = gfc_finish_block (&tmpblock); + gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (then_b)); + tem = gfc_omp_unshare_expr (tem); + tem = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, tem, + gfc_index_one_node); + } + else + { + if (!TYPE_DOMAIN (type) + || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE + || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node + || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node) + { + tem = fold_build2 (EXACT_DIV_EXPR, sizetype, + TYPE_SIZE_UNIT (type), + TYPE_SIZE_UNIT (TREE_TYPE (type))); + tem = size_binop (MINUS_EXPR, tem, size_one_node); + } + else + tem = array_type_nelts (type); + tem = fold_convert (gfc_array_index_type, tem); + } + + tree nelems = gfc_evaluate_now (tem, &block); + tree index = gfc_create_var (gfc_array_index_type, "S"); + + gfc_init_block (&tmpblock); + tem = gfc_conv_array_data (decl); + tree declvar = build_fold_indirect_ref_loc (input_location, tem); + tree declvref = gfc_build_array_ref (declvar, index, NULL); + tree destvar, destvref = NULL_TREE; + if (dest) + { + tem = gfc_conv_array_data (dest); + destvar = build_fold_indirect_ref_loc (input_location, tem); + destvref = gfc_build_array_ref (destvar, index, NULL); + } + gfc_add_expr_to_block (&tmpblock, + gfc_walk_alloc_comps (declvref, destvref, + var, kind)); + + gfc_loopinfo loop; + gfc_init_loopinfo (&loop); + loop.dimen = 1; + loop.from[0] = gfc_index_zero_node; + loop.loopvar[0] = index; + loop.to[0] = nelems; + gfc_trans_scalarizing_loops (&loop, &tmpblock); + gfc_add_block_to_block (&block, &loop.pre); + return gfc_finish_block (&block); + } + else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (var)) + { + decl = build_fold_indirect_ref_loc (input_location, decl); + if (dest) + dest = build_fold_indirect_ref_loc (input_location, dest); + type = TREE_TYPE (decl); + } + + gcc_assert (TREE_CODE (type) == RECORD_TYPE); + for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field)) + { + tree ftype = TREE_TYPE (field); + tree declf, destf = NULL_TREE; + bool has_alloc_comps = gfc_has_alloc_comps (ftype, field); + if ((!GFC_DESCRIPTOR_TYPE_P (ftype) + || GFC_TYPE_ARRAY_AKIND (ftype) != GFC_ARRAY_ALLOCATABLE) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (field) + && !has_alloc_comps) + continue; + declf = fold_build3_loc (input_location, COMPONENT_REF, ftype, + decl, field, NULL_TREE); + if (dest) + destf = fold_build3_loc (input_location, COMPONENT_REF, ftype, + dest, field, NULL_TREE); + + tem = NULL_TREE; + switch (kind) + { + case WALK_ALLOC_COMPS_DTOR: + break; + case WALK_ALLOC_COMPS_DEFAULT_CTOR: + if (GFC_DESCRIPTOR_TYPE_P (ftype) + && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE) + { + gfc_add_modify (&block, unshare_expr (destf), + unshare_expr (declf)); + tem = gfc_duplicate_allocatable_nocopy + (destf, declf, ftype, + GFC_TYPE_ARRAY_RANK (ftype)); + } + else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field)) + tem = gfc_duplicate_allocatable_nocopy (destf, declf, ftype, 0); + break; + case WALK_ALLOC_COMPS_COPY_CTOR: + if (GFC_DESCRIPTOR_TYPE_P (ftype) + && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE) + tem = gfc_duplicate_allocatable (destf, declf, ftype, + GFC_TYPE_ARRAY_RANK (ftype)); + else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field)) + tem = gfc_duplicate_allocatable (destf, declf, ftype, 0); + break; + } + if (tem) + gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem)); + if (has_alloc_comps) + { + gfc_init_block (&tmpblock); + gfc_add_expr_to_block (&tmpblock, + gfc_walk_alloc_comps (declf, destf, + field, kind)); + then_b = gfc_finish_block (&tmpblock); + if (GFC_DESCRIPTOR_TYPE_P (ftype) + && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE) + tem = gfc_conv_descriptor_data_get (unshare_expr (declf)); + else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field)) + tem = unshare_expr (declf); + else + tem = NULL_TREE; + if (tem) + { + tem = fold_convert (pvoid_type_node, tem); + tem = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, tem, + null_pointer_node); + then_b = build3_loc (input_location, COND_EXPR, void_type_node, + tem, then_b, + build_empty_stmt (input_location)); + } + gfc_add_expr_to_block (&block, then_b); + } + if (kind == WALK_ALLOC_COMPS_DTOR) + { + if (GFC_DESCRIPTOR_TYPE_P (ftype) + && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE) + { + tem = gfc_trans_dealloc_allocated (unshare_expr (declf), + false, NULL); + gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem)); + } + else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field)) + { + tem = gfc_call_free (unshare_expr (declf)); + gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem)); + } + } + } + + return gfc_finish_block (&block); +} + /* Return code to initialize DECL with its default constructor, or NULL if there's nothing to do. */ tree gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) { - tree type = TREE_TYPE (decl), rank, size, esize, ptr, cond, then_b, else_b; + tree type = TREE_TYPE (decl), size, ptr, cond, then_b, else_b; stmtblock_t block, cond_block; - if (! GFC_DESCRIPTOR_TYPE_P (type) - || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) - return NULL; + gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_PRIVATE + || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LASTPRIVATE + || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR + || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION); - if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION) - return NULL; + if ((! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))) + { + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + gcc_assert (outer); + gfc_start_block (&block); + tree tem = gfc_walk_alloc_comps (outer, decl, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_DEFAULT_CTOR); + gfc_add_expr_to_block (&block, tem); + return gfc_finish_block (&block); + } + return NULL_TREE; + } - gcc_assert (outer != NULL); - gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_PRIVATE - || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LASTPRIVATE); + gcc_assert (outer != NULL_TREE); - /* Allocatable arrays in PRIVATE clauses need to be set to + /* Allocatable arrays and scalars in PRIVATE clauses need to be set to "not currently allocated" allocation status if outer array is "not currently allocated", otherwise should be allocated. */ gfc_start_block (&block); gfc_init_block (&cond_block); - gfc_add_modify (&cond_block, decl, outer); - rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; - size = gfc_conv_descriptor_ubound_get (decl, rank); - size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - size, gfc_conv_descriptor_lbound_get (decl, rank)); - size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - size, gfc_index_one_node); - if (GFC_TYPE_ARRAY_RANK (type) > 1) - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, gfc_conv_descriptor_stride_get (decl, rank)); - esize = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, esize); - size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block); - + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + gfc_add_modify (&cond_block, decl, outer); + tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; + size = gfc_conv_descriptor_ubound_get (decl, rank); + size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + size, + gfc_conv_descriptor_lbound_get (decl, rank)); + size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + size, gfc_index_one_node); + if (GFC_TYPE_ARRAY_RANK (type) > 1) + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, + gfc_conv_descriptor_stride_get (decl, rank)); + tree esize = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + size, esize); + size = unshare_expr (size); + size = gfc_evaluate_now (fold_convert (size_type_node, size), + &cond_block); + } + else + size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type))); ptr = gfc_create_var (pvoid_type_node, NULL); gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE); - gfc_conv_descriptor_data_set (&cond_block, decl, ptr); - + if (GFC_DESCRIPTOR_TYPE_P (type)) + gfc_conv_descriptor_data_set (&cond_block, unshare_expr (decl), ptr); + else + gfc_add_modify (&cond_block, unshare_expr (decl), + fold_convert (TREE_TYPE (decl), ptr)); + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + tree tem = gfc_walk_alloc_comps (outer, decl, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_DEFAULT_CTOR); + gfc_add_expr_to_block (&cond_block, tem); + } then_b = gfc_finish_block (&cond_block); - gfc_init_block (&cond_block); - gfc_conv_descriptor_data_set (&cond_block, decl, null_pointer_node); - else_b = gfc_finish_block (&cond_block); - - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, - fold_convert (pvoid_type_node, - gfc_conv_descriptor_data_get (outer)), - null_pointer_node); - gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, - void_type_node, cond, then_b, else_b)); + /* Reduction clause requires allocated ALLOCATABLE. */ + if (OMP_CLAUSE_CODE (clause) != OMP_CLAUSE_REDUCTION) + { + gfc_init_block (&cond_block); + if (GFC_DESCRIPTOR_TYPE_P (type)) + gfc_conv_descriptor_data_set (&cond_block, unshare_expr (decl), + null_pointer_node); + else + gfc_add_modify (&cond_block, unshare_expr (decl), + build_zero_cst (TREE_TYPE (decl))); + else_b = gfc_finish_block (&cond_block); + + tree tem = fold_convert (pvoid_type_node, + GFC_DESCRIPTOR_TYPE_P (type) + ? gfc_conv_descriptor_data_get (outer) : outer); + tem = unshare_expr (tem); + cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tem, null_pointer_node); + gfc_add_expr_to_block (&block, + build3_loc (input_location, COND_EXPR, + void_type_node, cond, then_b, + else_b)); + } + else + gfc_add_expr_to_block (&block, then_b); return gfc_finish_block (&block); } @@ -217,15 +536,29 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) tree gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) { - tree type = TREE_TYPE (dest), ptr, size, esize, rank, call; + tree type = TREE_TYPE (dest), ptr, size, call; tree cond, then_b, else_b; stmtblock_t block, cond_block; - if (! GFC_DESCRIPTOR_TYPE_P (type) - || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) - return build2_v (MODIFY_EXPR, dest, src); + gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE + || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR); - gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE); + if ((! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))) + { + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + gfc_start_block (&block); + gfc_add_modify (&block, dest, src); + tree tem = gfc_walk_alloc_comps (src, dest, OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_COPY_CTOR); + gfc_add_expr_to_block (&block, tem); + return gfc_finish_block (&block); + } + else + return build2_v (MODIFY_EXPR, dest, src); + } /* Allocatable arrays in FIRSTPRIVATE clauses need to be allocated and copied from SRC. */ @@ -234,86 +567,389 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) gfc_init_block (&cond_block); gfc_add_modify (&cond_block, dest, src); - rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; - size = gfc_conv_descriptor_ubound_get (dest, rank); - size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - size, gfc_conv_descriptor_lbound_get (dest, rank)); - size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - size, gfc_index_one_node); - if (GFC_TYPE_ARRAY_RANK (type) > 1) - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, gfc_conv_descriptor_stride_get (dest, rank)); - esize = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, esize); - size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block); - + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; + size = gfc_conv_descriptor_ubound_get (dest, rank); + size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + size, + gfc_conv_descriptor_lbound_get (dest, rank)); + size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + size, gfc_index_one_node); + if (GFC_TYPE_ARRAY_RANK (type) > 1) + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, + gfc_conv_descriptor_stride_get (dest, rank)); + tree esize = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + size, esize); + size = unshare_expr (size); + size = gfc_evaluate_now (fold_convert (size_type_node, size), + &cond_block); + } + else + size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type))); ptr = gfc_create_var (pvoid_type_node, NULL); gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE); - gfc_conv_descriptor_data_set (&cond_block, dest, ptr); + if (GFC_DESCRIPTOR_TYPE_P (type)) + gfc_conv_descriptor_data_set (&cond_block, unshare_expr (dest), ptr); + else + gfc_add_modify (&cond_block, unshare_expr (dest), + fold_convert (TREE_TYPE (dest), ptr)); + tree srcptr = GFC_DESCRIPTOR_TYPE_P (type) + ? gfc_conv_descriptor_data_get (src) : src; + srcptr = unshare_expr (srcptr); + srcptr = fold_convert (pvoid_type_node, srcptr); call = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_MEMCPY), - 3, ptr, - fold_convert (pvoid_type_node, - gfc_conv_descriptor_data_get (src)), - size); + builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr, + srcptr, size); gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call)); + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + tree tem = gfc_walk_alloc_comps (src, dest, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_COPY_CTOR); + gfc_add_expr_to_block (&cond_block, tem); + } then_b = gfc_finish_block (&cond_block); gfc_init_block (&cond_block); - gfc_conv_descriptor_data_set (&cond_block, dest, null_pointer_node); + if (GFC_DESCRIPTOR_TYPE_P (type)) + gfc_conv_descriptor_data_set (&cond_block, unshare_expr (dest), + null_pointer_node); + else + gfc_add_modify (&cond_block, unshare_expr (dest), + build_zero_cst (TREE_TYPE (dest))); else_b = gfc_finish_block (&cond_block); cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, - fold_convert (pvoid_type_node, - gfc_conv_descriptor_data_get (src)), - null_pointer_node); - gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, - void_type_node, cond, then_b, else_b)); + unshare_expr (srcptr), null_pointer_node); + gfc_add_expr_to_block (&block, + build3_loc (input_location, COND_EXPR, + void_type_node, cond, then_b, else_b)); return gfc_finish_block (&block); } -/* Similarly, except use an assignment operator instead. */ +/* Similarly, except use an intrinsic or pointer assignment operator + instead. */ tree -gfc_omp_clause_assign_op (tree clause ATTRIBUTE_UNUSED, tree dest, tree src) +gfc_omp_clause_assign_op (tree clause, tree dest, tree src) { - tree type = TREE_TYPE (dest), rank, size, esize, call; - stmtblock_t block; + tree type = TREE_TYPE (dest), ptr, size, call, nonalloc; + tree cond, then_b, else_b; + stmtblock_t block, cond_block, cond_block2, inner_block; - if (! GFC_DESCRIPTOR_TYPE_P (type) - || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) - return build2_v (MODIFY_EXPR, dest, src); + if ((! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))) + { + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + gfc_start_block (&block); + /* First dealloc any allocatable components in DEST. */ + tree tem = gfc_walk_alloc_comps (dest, NULL_TREE, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_DTOR); + gfc_add_expr_to_block (&block, tem); + /* Then copy over toplevel data. */ + gfc_add_modify (&block, dest, src); + /* Finally allocate any allocatable components and copy. */ + tem = gfc_walk_alloc_comps (src, dest, OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_COPY_CTOR); + gfc_add_expr_to_block (&block, tem); + return gfc_finish_block (&block); + } + else + return build2_v (MODIFY_EXPR, dest, src); + } - /* Handle copying allocatable arrays. */ gfc_start_block (&block); - rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; - size = gfc_conv_descriptor_ubound_get (dest, rank); - size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - size, gfc_conv_descriptor_lbound_get (dest, rank)); - size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - size, gfc_index_one_node); - if (GFC_TYPE_ARRAY_RANK (type) > 1) - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, gfc_conv_descriptor_stride_get (dest, rank)); - esize = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, esize); - size = gfc_evaluate_now (fold_convert (size_type_node, size), &block); + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + then_b = gfc_walk_alloc_comps (dest, NULL_TREE, OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_DTOR); + tree tem = fold_convert (pvoid_type_node, + GFC_DESCRIPTOR_TYPE_P (type) + ? gfc_conv_descriptor_data_get (dest) : dest); + tem = unshare_expr (tem); + cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tem, null_pointer_node); + tem = build3_loc (input_location, COND_EXPR, void_type_node, cond, + then_b, build_empty_stmt (input_location)); + gfc_add_expr_to_block (&block, tem); + } + + gfc_init_block (&cond_block); + + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; + size = gfc_conv_descriptor_ubound_get (src, rank); + size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + size, + gfc_conv_descriptor_lbound_get (src, rank)); + size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + size, gfc_index_one_node); + if (GFC_TYPE_ARRAY_RANK (type) > 1) + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, + gfc_conv_descriptor_stride_get (src, rank)); + tree esize = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + size, esize); + size = unshare_expr (size); + size = gfc_evaluate_now (fold_convert (size_type_node, size), + &cond_block); + } + else + size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type))); + ptr = gfc_create_var (pvoid_type_node, NULL); + + tree destptr = GFC_DESCRIPTOR_TYPE_P (type) + ? gfc_conv_descriptor_data_get (dest) : dest; + destptr = unshare_expr (destptr); + destptr = fold_convert (pvoid_type_node, destptr); + gfc_add_modify (&cond_block, ptr, destptr); + + nonalloc = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + destptr, null_pointer_node); + cond = nonalloc; + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + int i; + for (i = 0; i < GFC_TYPE_ARRAY_RANK (type); i++) + { + tree rank = gfc_rank_cst[i]; + tree tem = gfc_conv_descriptor_ubound_get (src, rank); + tem = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, tem, + gfc_conv_descriptor_lbound_get (src, rank)); + tem = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, tem, + gfc_conv_descriptor_lbound_get (dest, rank)); + tem = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tem, gfc_conv_descriptor_ubound_get (dest, + rank)); + cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, + boolean_type_node, cond, tem); + } + } + + gfc_init_block (&cond_block2); + + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + gfc_init_block (&inner_block); + gfc_allocate_using_malloc (&inner_block, ptr, size, NULL_TREE); + then_b = gfc_finish_block (&inner_block); + + gfc_init_block (&inner_block); + gfc_add_modify (&inner_block, ptr, + gfc_call_realloc (&inner_block, ptr, size)); + else_b = gfc_finish_block (&inner_block); + + gfc_add_expr_to_block (&cond_block2, + build3_loc (input_location, COND_EXPR, + void_type_node, + unshare_expr (nonalloc), + then_b, else_b)); + gfc_add_modify (&cond_block2, dest, src); + gfc_conv_descriptor_data_set (&cond_block2, unshare_expr (dest), ptr); + } + else + { + gfc_allocate_using_malloc (&cond_block2, ptr, size, NULL_TREE); + gfc_add_modify (&cond_block2, unshare_expr (dest), + fold_convert (type, ptr)); + } + then_b = gfc_finish_block (&cond_block2); + else_b = build_empty_stmt (input_location); + + gfc_add_expr_to_block (&cond_block, + build3_loc (input_location, COND_EXPR, + void_type_node, unshare_expr (cond), + then_b, else_b)); + + tree srcptr = GFC_DESCRIPTOR_TYPE_P (type) + ? gfc_conv_descriptor_data_get (src) : src; + srcptr = unshare_expr (srcptr); + srcptr = fold_convert (pvoid_type_node, srcptr); call = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_MEMCPY), 3, - fold_convert (pvoid_type_node, - gfc_conv_descriptor_data_get (dest)), - fold_convert (pvoid_type_node, - gfc_conv_descriptor_data_get (src)), - size); - gfc_add_expr_to_block (&block, fold_convert (void_type_node, call)); + builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr, + srcptr, size); + gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call)); + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + tree tem = gfc_walk_alloc_comps (src, dest, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_COPY_CTOR); + gfc_add_expr_to_block (&cond_block, tem); + } + then_b = gfc_finish_block (&cond_block); + + if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_COPYIN) + { + gfc_init_block (&cond_block); + if (GFC_DESCRIPTOR_TYPE_P (type)) + gfc_add_expr_to_block (&cond_block, + gfc_trans_dealloc_allocated (unshare_expr (dest), + false, NULL)); + else + { + destptr = gfc_evaluate_now (destptr, &cond_block); + gfc_add_expr_to_block (&cond_block, gfc_call_free (destptr)); + gfc_add_modify (&cond_block, unshare_expr (dest), + build_zero_cst (TREE_TYPE (dest))); + } + else_b = gfc_finish_block (&cond_block); + + cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + unshare_expr (srcptr), null_pointer_node); + gfc_add_expr_to_block (&block, + build3_loc (input_location, COND_EXPR, + void_type_node, cond, + then_b, else_b)); + } + else + gfc_add_expr_to_block (&block, then_b); + + return gfc_finish_block (&block); +} + +static void +gfc_omp_linear_clause_add_loop (stmtblock_t *block, tree dest, tree src, + tree add, tree nelems) +{ + stmtblock_t tmpblock; + tree desta, srca, index = gfc_create_var (gfc_array_index_type, "S"); + nelems = gfc_evaluate_now (nelems, block); + + gfc_init_block (&tmpblock); + if (TREE_CODE (TREE_TYPE (dest)) == ARRAY_TYPE) + { + desta = gfc_build_array_ref (dest, index, NULL); + srca = gfc_build_array_ref (src, index, NULL); + } + else + { + gcc_assert (POINTER_TYPE_P (TREE_TYPE (dest))); + tree idx = fold_build2 (MULT_EXPR, sizetype, + fold_convert (sizetype, index), + TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dest)))); + desta = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR, + TREE_TYPE (dest), dest, + idx)); + srca = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR, + TREE_TYPE (src), src, + idx)); + } + gfc_add_modify (&tmpblock, desta, + fold_build2 (PLUS_EXPR, TREE_TYPE (desta), + srca, add)); + + gfc_loopinfo loop; + gfc_init_loopinfo (&loop); + loop.dimen = 1; + loop.from[0] = gfc_index_zero_node; + loop.loopvar[0] = index; + loop.to[0] = nelems; + gfc_trans_scalarizing_loops (&loop, &tmpblock); + gfc_add_block_to_block (block, &loop.pre); +} + +/* Build and return code for a constructor of DEST that initializes + it to SRC plus ADD (ADD is scalar integer). */ + +tree +gfc_omp_clause_linear_ctor (tree clause, tree dest, tree src, tree add) +{ + tree type = TREE_TYPE (dest), ptr, size, nelems = NULL_TREE; + stmtblock_t block; + + gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR); + gfc_start_block (&block); + add = gfc_evaluate_now (add, &block); + + if ((! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))) + { + gcc_assert (TREE_CODE (type) == ARRAY_TYPE); + if (!TYPE_DOMAIN (type) + || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE + || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node + || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node) + { + nelems = fold_build2 (EXACT_DIV_EXPR, sizetype, + TYPE_SIZE_UNIT (type), + TYPE_SIZE_UNIT (TREE_TYPE (type))); + nelems = size_binop (MINUS_EXPR, nelems, size_one_node); + } + else + nelems = array_type_nelts (type); + nelems = fold_convert (gfc_array_index_type, nelems); + + gfc_omp_linear_clause_add_loop (&block, dest, src, add, nelems); + return gfc_finish_block (&block); + } + + /* Allocatable arrays in LINEAR clauses need to be allocated + and copied from SRC. */ + gfc_add_modify (&block, dest, src); + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; + size = gfc_conv_descriptor_ubound_get (dest, rank); + size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + size, + gfc_conv_descriptor_lbound_get (dest, rank)); + size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + size, gfc_index_one_node); + if (GFC_TYPE_ARRAY_RANK (type) > 1) + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, + gfc_conv_descriptor_stride_get (dest, rank)); + tree esize = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + nelems = gfc_evaluate_now (unshare_expr (size), &block); + size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + nelems, unshare_expr (esize)); + size = gfc_evaluate_now (fold_convert (size_type_node, size), + &block); + nelems = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, nelems, + gfc_index_one_node); + } + else + size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type))); + ptr = gfc_create_var (pvoid_type_node, NULL); + gfc_allocate_using_malloc (&block, ptr, size, NULL_TREE); + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + gfc_conv_descriptor_data_set (&block, unshare_expr (dest), ptr); + tree etype = gfc_get_element_type (type); + ptr = fold_convert (build_pointer_type (etype), ptr); + tree srcptr = gfc_conv_descriptor_data_get (unshare_expr (src)); + srcptr = fold_convert (build_pointer_type (etype), srcptr); + gfc_omp_linear_clause_add_loop (&block, ptr, srcptr, add, nelems); + } + else + { + gfc_add_modify (&block, unshare_expr (dest), + fold_convert (TREE_TYPE (dest), ptr)); + ptr = fold_convert (TREE_TYPE (dest), ptr); + tree dstm = build_fold_indirect_ref (ptr); + tree srcm = build_fold_indirect_ref (unshare_expr (src)); + gfc_add_modify (&block, dstm, + fold_build2 (PLUS_EXPR, TREE_TYPE (add), srcm, add)); + } return gfc_finish_block (&block); } @@ -321,20 +957,161 @@ gfc_omp_clause_assign_op (tree clause ATTRIBUTE_UNUSED, tree dest, tree src) to be done. */ tree -gfc_omp_clause_dtor (tree clause ATTRIBUTE_UNUSED, tree decl) +gfc_omp_clause_dtor (tree clause, tree decl) { - tree type = TREE_TYPE (decl); + tree type = TREE_TYPE (decl), tem; + + if ((! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))) + { + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + return gfc_walk_alloc_comps (decl, NULL_TREE, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_DTOR); + return NULL_TREE; + } - if (! GFC_DESCRIPTOR_TYPE_P (type) - || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) - return NULL; + if (GFC_DESCRIPTOR_TYPE_P (type)) + /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need + to be deallocated if they were allocated. */ + tem = gfc_trans_dealloc_allocated (decl, false, NULL); + else + tem = gfc_call_free (decl); + tem = gfc_omp_unshare_expr (tem); - if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION) - return NULL; + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + stmtblock_t block; + tree then_b; + + gfc_init_block (&block); + gfc_add_expr_to_block (&block, + gfc_walk_alloc_comps (decl, NULL_TREE, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_DTOR)); + gfc_add_expr_to_block (&block, tem); + then_b = gfc_finish_block (&block); + + tem = fold_convert (pvoid_type_node, + GFC_DESCRIPTOR_TYPE_P (type) + ? gfc_conv_descriptor_data_get (decl) : decl); + tem = unshare_expr (tem); + tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tem, null_pointer_node); + tem = build3_loc (input_location, COND_EXPR, void_type_node, cond, + then_b, build_empty_stmt (input_location)); + } + return tem; +} - /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need - to be deallocated if they were allocated. */ - return gfc_trans_dealloc_allocated (decl, false, NULL); + +void +gfc_omp_finish_clause (tree c, gimple_seq *pre_p) +{ + if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP) + return; + + tree decl = OMP_CLAUSE_DECL (c); + tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE; + if (POINTER_TYPE_P (TREE_TYPE (decl))) + { + if (!gfc_omp_privatize_by_reference (decl) + && !GFC_DECL_GET_SCALAR_POINTER (decl) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (decl) + && !GFC_DECL_CRAY_POINTEE (decl) + && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))) + return; + c4 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (c4) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (c4) = decl; + OMP_CLAUSE_SIZE (c4) = size_int (0); + decl = build_fold_indirect_ref (decl); + OMP_CLAUSE_DECL (c) = decl; + OMP_CLAUSE_SIZE (c) = NULL_TREE; + } + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + { + stmtblock_t block; + gfc_start_block (&block); + tree type = TREE_TYPE (decl); + tree ptr = gfc_conv_descriptor_data_get (decl); + ptr = fold_convert (build_pointer_type (char_type_node), ptr); + ptr = build_fold_indirect_ref (ptr); + OMP_CLAUSE_DECL (c) = ptr; + c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (c2) = OMP_CLAUSE_MAP_TO_PSET; + OMP_CLAUSE_DECL (c2) = decl; + OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type); + c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (c3) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl); + OMP_CLAUSE_SIZE (c3) = size_int (0); + tree size = create_tmp_var (gfc_array_index_type, NULL); + tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER + || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT) + { + stmtblock_t cond_block; + tree tem, then_b, else_b, zero, cond; + + gfc_init_block (&cond_block); + tem = gfc_full_array_size (&cond_block, decl, + GFC_TYPE_ARRAY_RANK (type)); + gfc_add_modify (&cond_block, size, tem); + gfc_add_modify (&cond_block, size, + fold_build2 (MULT_EXPR, gfc_array_index_type, + size, elemsz)); + then_b = gfc_finish_block (&cond_block); + gfc_init_block (&cond_block); + zero = build_int_cst (gfc_array_index_type, 0); + gfc_add_modify (&cond_block, size, zero); + else_b = gfc_finish_block (&cond_block); + tem = gfc_conv_descriptor_data_get (decl); + tem = fold_convert (pvoid_type_node, tem); + cond = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, tem, null_pointer_node); + gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, + void_type_node, cond, + then_b, else_b)); + } + else + { + gfc_add_modify (&block, size, + gfc_full_array_size (&block, decl, + GFC_TYPE_ARRAY_RANK (type))); + gfc_add_modify (&block, size, + fold_build2 (MULT_EXPR, gfc_array_index_type, + size, elemsz)); + } + OMP_CLAUSE_SIZE (c) = size; + tree stmt = gfc_finish_block (&block); + gimplify_and_add (stmt, pre_p); + } + tree last = c; + if (OMP_CLAUSE_SIZE (c) == NULL_TREE) + OMP_CLAUSE_SIZE (c) + = DECL_P (decl) ? DECL_SIZE_UNIT (decl) + : TYPE_SIZE_UNIT (TREE_TYPE (decl)); + if (c2) + { + OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (last); + OMP_CLAUSE_CHAIN (last) = c2; + last = c2; + } + if (c3) + { + OMP_CLAUSE_CHAIN (c3) = OMP_CLAUSE_CHAIN (last); + OMP_CLAUSE_CHAIN (last) = c3; + last = c3; + } + if (c4) + { + OMP_CLAUSE_CHAIN (c4) = OMP_CLAUSE_CHAIN (last); + OMP_CLAUSE_CHAIN (last) = c4; + last = c4; + } } @@ -427,8 +1204,33 @@ gfc_trans_add_clause (tree node, tree tail) } static tree -gfc_trans_omp_variable (gfc_symbol *sym) +gfc_trans_omp_variable (gfc_symbol *sym, bool declare_simd) { + if (declare_simd) + { + int cnt = 0; + gfc_symbol *proc_sym; + gfc_formal_arglist *f; + + gcc_assert (sym->attr.dummy); + proc_sym = sym->ns->proc_name; + if (proc_sym->attr.entry_master) + ++cnt; + if (gfc_return_by_reference (proc_sym)) + { + ++cnt; + if (proc_sym->ts.type == BT_CHARACTER) + ++cnt; + } + for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next) + if (f->sym == sym) + break; + else if (f->sym) + ++cnt; + gcc_assert (f); + return build_int_cst (integer_type_node, cnt); + } + tree t = gfc_get_symbol_decl (sym); tree parent_decl; int parent_flag; @@ -442,7 +1244,8 @@ gfc_trans_omp_variable (gfc_symbol *sym) entry_master = sym->attr.result && sym->ns->proc_name->attr.entry_master && !gfc_return_by_reference (sym->ns->proc_name); - parent_decl = DECL_CONTEXT (current_function_decl); + parent_decl = current_function_decl + ? DECL_CONTEXT (current_function_decl) : NULL_TREE; if ((t == parent_decl && return_value) || (sym->ns && sym->ns->proc_name @@ -481,13 +1284,14 @@ gfc_trans_omp_variable (gfc_symbol *sym) } static tree -gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist, - tree list) +gfc_trans_omp_variable_list (enum omp_clause_code code, + gfc_omp_namelist *namelist, tree list, + bool declare_simd) { for (; namelist != NULL; namelist = namelist->next) - if (namelist->sym->attr.referenced) + if (namelist->sym->attr.referenced || declare_simd) { - tree t = gfc_trans_omp_variable (namelist->sym); + tree t = gfc_trans_omp_variable (namelist->sym, declare_simd); if (t != error_mark_node) { tree node = build_omp_clause (input_location, code); @@ -498,18 +1302,39 @@ gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist, return list; } +struct omp_udr_find_orig_data +{ + gfc_omp_udr *omp_udr; + bool omp_orig_seen; +}; + +static int +omp_udr_find_orig (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data) +{ + struct omp_udr_find_orig_data *cd = (struct omp_udr_find_orig_data *) data; + if ((*e)->expr_type == EXPR_VARIABLE + && (*e)->symtree->n.sym == cd->omp_udr->omp_orig) + cd->omp_orig_seen = true; + + return 0; +} + static void -gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) +gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) { + gfc_symbol *sym = n->sym; gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL; gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL; gfc_symbol init_val_sym, outer_sym, intrinsic_sym; + gfc_symbol omp_var_copy[4]; gfc_expr *e1, *e2, *e3, *e4; gfc_ref *ref; tree decl, backend_decl, stmt, type, outer_decl; locus old_loc = gfc_current_locus; const char *iname; bool t; + gfc_omp_udr *udr = n->udr ? n->udr->udr : NULL; decl = OMP_CLAUSE_DECL (c); gfc_current_locus = where; @@ -532,12 +1357,29 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) init_val_sym.attr.referenced = 1; init_val_sym.declared_at = where; init_val_sym.attr.flavor = FL_VARIABLE; - backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym)); + if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK) + backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym)); + else if (udr->initializer_ns) + backend_decl = NULL; + else + switch (sym->ts.type) + { + case BT_LOGICAL: + case BT_INTEGER: + case BT_REAL: + case BT_COMPLEX: + backend_decl = build_zero_cst (gfc_sym_type (&init_val_sym)); + break; + default: + backend_decl = NULL_TREE; + break; + } init_val_sym.backend_decl = backend_decl; /* Create a fake symbol for the outer array reference. */ outer_sym = *sym; - outer_sym.as = gfc_copy_array_spec (sym->as); + if (sym->as) + outer_sym.as = gfc_copy_array_spec (sym->as); outer_sym.attr.dummy = 0; outer_sym.attr.result = 0; outer_sym.attr.flavor = FL_VARIABLE; @@ -558,28 +1400,75 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) symtree3->n.sym = &outer_sym; gcc_assert (symtree3 == root3); + memset (omp_var_copy, 0, sizeof omp_var_copy); + if (udr) + { + omp_var_copy[0] = *udr->omp_out; + omp_var_copy[1] = *udr->omp_in; + *udr->omp_out = outer_sym; + *udr->omp_in = *sym; + if (udr->initializer_ns) + { + omp_var_copy[2] = *udr->omp_priv; + omp_var_copy[3] = *udr->omp_orig; + *udr->omp_priv = *sym; + *udr->omp_orig = outer_sym; + } + } + /* Create expressions. */ e1 = gfc_get_expr (); e1->expr_type = EXPR_VARIABLE; e1->where = where; e1->symtree = symtree1; e1->ts = sym->ts; - e1->ref = ref = gfc_get_ref (); - ref->type = REF_ARRAY; - ref->u.ar.where = where; - ref->u.ar.as = sym->as; - ref->u.ar.type = AR_FULL; - ref->u.ar.dimen = 0; + if (sym->attr.dimension) + { + e1->ref = ref = gfc_get_ref (); + ref->type = REF_ARRAY; + ref->u.ar.where = where; + ref->u.ar.as = sym->as; + ref->u.ar.type = AR_FULL; + ref->u.ar.dimen = 0; + } t = gfc_resolve_expr (e1); gcc_assert (t); - e2 = gfc_get_expr (); - e2->expr_type = EXPR_VARIABLE; - e2->where = where; - e2->symtree = symtree2; - e2->ts = sym->ts; - t = gfc_resolve_expr (e2); - gcc_assert (t); + e2 = NULL; + if (backend_decl != NULL_TREE) + { + e2 = gfc_get_expr (); + e2->expr_type = EXPR_VARIABLE; + e2->where = where; + e2->symtree = symtree2; + e2->ts = sym->ts; + t = gfc_resolve_expr (e2); + gcc_assert (t); + } + else if (udr->initializer_ns == NULL) + { + gcc_assert (sym->ts.type == BT_DERIVED); + e2 = gfc_default_initializer (&sym->ts); + gcc_assert (e2); + t = gfc_resolve_expr (e2); + gcc_assert (t); + } + else if (n->udr->initializer->op == EXEC_ASSIGN) + { + e2 = gfc_copy_expr (n->udr->initializer->expr2); + t = gfc_resolve_expr (e2); + gcc_assert (t); + } + if (udr && udr->initializer_ns) + { + struct omp_udr_find_orig_data cd; + cd.omp_udr = udr; + cd.omp_orig_seen = false; + gfc_code_walker (&n->udr->initializer, + gfc_dummy_code_callback, omp_udr_find_orig, &cd); + if (cd.omp_orig_seen) + OMP_CLAUSE_REDUCTION_OMP_ORIG_REF (c) = 1; + } e3 = gfc_copy_expr (e1); e3->symtree = symtree3; @@ -587,6 +1476,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) gcc_assert (t); iname = NULL; + e4 = NULL; switch (OMP_CLAUSE_REDUCTION_CODE (c)) { case PLUS_EXPR: @@ -623,6 +1513,18 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) case BIT_XOR_EXPR: iname = "ieor"; break; + case ERROR_MARK: + if (n->udr->combiner->op == EXEC_ASSIGN) + { + gfc_free_expr (e3); + e3 = gfc_copy_expr (n->udr->combiner->expr1); + e4 = gfc_copy_expr (n->udr->combiner->expr2); + t = gfc_resolve_expr (e3); + gcc_assert (t); + t = gfc_resolve_expr (e4); + gcc_assert (t); + } + break; default: gcc_unreachable (); } @@ -646,58 +1548,27 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) e4->expr_type = EXPR_FUNCTION; e4->where = where; e4->symtree = symtree4; - e4->value.function.isym = gfc_find_function (iname); e4->value.function.actual = gfc_get_actual_arglist (); e4->value.function.actual->expr = e3; e4->value.function.actual->next = gfc_get_actual_arglist (); e4->value.function.actual->next->expr = e1; } - /* e1 and e3 have been stored as arguments of e4, avoid sharing. */ - e1 = gfc_copy_expr (e1); - e3 = gfc_copy_expr (e3); - t = gfc_resolve_expr (e4); - gcc_assert (t); + if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK) + { + /* e1 and e3 have been stored as arguments of e4, avoid sharing. */ + e1 = gfc_copy_expr (e1); + e3 = gfc_copy_expr (e3); + t = gfc_resolve_expr (e4); + gcc_assert (t); + } /* Create the init statement list. */ pushlevel (); - if (GFC_DESCRIPTOR_TYPE_P (type) - && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) - { - /* If decl is an allocatable array, it needs to be allocated - with the same bounds as the outer var. */ - tree rank, size, esize, ptr; - stmtblock_t block; - - gfc_start_block (&block); - - gfc_add_modify (&block, decl, outer_sym.backend_decl); - rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; - size = gfc_conv_descriptor_ubound_get (decl, rank); - size = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, size, - gfc_conv_descriptor_lbound_get (decl, rank)); - size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - size, gfc_index_one_node); - if (GFC_TYPE_ARRAY_RANK (type) > 1) - size = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, size, - gfc_conv_descriptor_stride_get (decl, rank)); - esize = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, esize); - size = gfc_evaluate_now (fold_convert (size_type_node, size), &block); - - ptr = gfc_create_var (pvoid_type_node, NULL); - gfc_allocate_using_malloc (&block, ptr, size, NULL_TREE); - gfc_conv_descriptor_data_set (&block, decl, ptr); - - gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false, - false)); - stmt = gfc_finish_block (&block); - } - else + if (e2) stmt = gfc_trans_assignment (e1, e2, false, false); + else + stmt = gfc_trans_call (n->udr->initializer, false, + NULL_TREE, NULL_TREE, false); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else @@ -706,22 +1577,11 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) /* Create the merge statement list. */ pushlevel (); - if (GFC_DESCRIPTOR_TYPE_P (type) - && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) - { - /* If decl is an allocatable array, it needs to be deallocated - afterwards. */ - stmtblock_t block; - - gfc_start_block (&block); - gfc_add_expr_to_block (&block, gfc_trans_assignment (e3, e4, false, - true)); - gfc_add_expr_to_block (&block, gfc_trans_dealloc_allocated (decl, false, - NULL)); - stmt = gfc_finish_block (&block); - } - else + if (e4) stmt = gfc_trans_assignment (e3, e4, false, true); + else + stmt = gfc_trans_call (n->udr->combiner, false, + NULL_TREE, NULL_TREE, false); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else @@ -734,32 +1594,91 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) gfc_current_locus = old_loc; gfc_free_expr (e1); - gfc_free_expr (e2); + if (e2) + gfc_free_expr (e2); gfc_free_expr (e3); - gfc_free_expr (e4); + if (e4) + gfc_free_expr (e4); free (symtree1); free (symtree2); free (symtree3); free (symtree4); - gfc_free_array_spec (outer_sym.as); + if (outer_sym.as) + gfc_free_array_spec (outer_sym.as); + + if (udr) + { + *udr->omp_out = omp_var_copy[0]; + *udr->omp_in = omp_var_copy[1]; + if (udr->initializer_ns) + { + *udr->omp_priv = omp_var_copy[2]; + *udr->omp_orig = omp_var_copy[3]; + } + } } static tree -gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list, - enum tree_code reduction_code, locus where) +gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list, + locus where) { for (; namelist != NULL; namelist = namelist->next) if (namelist->sym->attr.referenced) { - tree t = gfc_trans_omp_variable (namelist->sym); + tree t = gfc_trans_omp_variable (namelist->sym, false); if (t != error_mark_node) { tree node = build_omp_clause (where.lb->location, OMP_CLAUSE_REDUCTION); OMP_CLAUSE_DECL (node) = t; - OMP_CLAUSE_REDUCTION_CODE (node) = reduction_code; - if (namelist->sym->attr.dimension) - gfc_trans_omp_array_reduction (node, namelist->sym, where); + switch (namelist->u.reduction_op) + { + case OMP_REDUCTION_PLUS: + OMP_CLAUSE_REDUCTION_CODE (node) = PLUS_EXPR; + break; + case OMP_REDUCTION_MINUS: + OMP_CLAUSE_REDUCTION_CODE (node) = MINUS_EXPR; + break; + case OMP_REDUCTION_TIMES: + OMP_CLAUSE_REDUCTION_CODE (node) = MULT_EXPR; + break; + case OMP_REDUCTION_AND: + OMP_CLAUSE_REDUCTION_CODE (node) = TRUTH_ANDIF_EXPR; + break; + case OMP_REDUCTION_OR: + OMP_CLAUSE_REDUCTION_CODE (node) = TRUTH_ORIF_EXPR; + break; + case OMP_REDUCTION_EQV: + OMP_CLAUSE_REDUCTION_CODE (node) = EQ_EXPR; + break; + case OMP_REDUCTION_NEQV: + OMP_CLAUSE_REDUCTION_CODE (node) = NE_EXPR; + break; + case OMP_REDUCTION_MAX: + OMP_CLAUSE_REDUCTION_CODE (node) = MAX_EXPR; + break; + case OMP_REDUCTION_MIN: + OMP_CLAUSE_REDUCTION_CODE (node) = MIN_EXPR; + break; + case OMP_REDUCTION_IAND: + OMP_CLAUSE_REDUCTION_CODE (node) = BIT_AND_EXPR; + break; + case OMP_REDUCTION_IOR: + OMP_CLAUSE_REDUCTION_CODE (node) = BIT_IOR_EXPR; + break; + case OMP_REDUCTION_IEOR: + OMP_CLAUSE_REDUCTION_CODE (node) = BIT_XOR_EXPR; + break; + case OMP_REDUCTION_USER: + OMP_CLAUSE_REDUCTION_CODE (node) = ERROR_MARK; + break; + default: + gcc_unreachable (); + } + if (namelist->sym->attr.dimension + || namelist->u.reduction_op == OMP_REDUCTION_USER + || namelist->sym->attr.allocatable) + gfc_trans_omp_array_reduction_or_udr (node, namelist, where); list = gfc_trans_add_clause (node, list); } } @@ -768,7 +1687,7 @@ gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list, static tree gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, - locus where) + locus where, bool declare_simd = false) { tree omp_clauses = NULL_TREE, chunk_size, c; int list; @@ -780,62 +1699,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, for (list = 0; list < OMP_LIST_NUM; list++) { - gfc_namelist *n = clauses->lists[list]; + gfc_omp_namelist *n = clauses->lists[list]; if (n == NULL) continue; - if (list >= OMP_LIST_REDUCTION_FIRST - && list <= OMP_LIST_REDUCTION_LAST) - { - enum tree_code reduction_code; - switch (list) - { - case OMP_LIST_PLUS: - reduction_code = PLUS_EXPR; - break; - case OMP_LIST_MULT: - reduction_code = MULT_EXPR; - break; - case OMP_LIST_SUB: - reduction_code = MINUS_EXPR; - break; - case OMP_LIST_AND: - reduction_code = TRUTH_ANDIF_EXPR; - break; - case OMP_LIST_OR: - reduction_code = TRUTH_ORIF_EXPR; - break; - case OMP_LIST_EQV: - reduction_code = EQ_EXPR; - break; - case OMP_LIST_NEQV: - reduction_code = NE_EXPR; - break; - case OMP_LIST_MAX: - reduction_code = MAX_EXPR; - break; - case OMP_LIST_MIN: - reduction_code = MIN_EXPR; - break; - case OMP_LIST_IAND: - reduction_code = BIT_AND_EXPR; - break; - case OMP_LIST_IOR: - reduction_code = BIT_IOR_EXPR; - break; - case OMP_LIST_IEOR: - reduction_code = BIT_XOR_EXPR; - break; - default: - gcc_unreachable (); - } - omp_clauses - = gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code, - where); - continue; - } switch (list) { + case OMP_LIST_REDUCTION: + omp_clauses = gfc_trans_omp_reduction_list (n, omp_clauses, where); + break; case OMP_LIST_PRIVATE: clause_code = OMP_CLAUSE_PRIVATE; goto add_clause; @@ -853,10 +1725,411 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, goto add_clause; case OMP_LIST_COPYPRIVATE: clause_code = OMP_CLAUSE_COPYPRIVATE; + goto add_clause; + case OMP_LIST_UNIFORM: + clause_code = OMP_CLAUSE_UNIFORM; /* FALLTHROUGH */ add_clause: omp_clauses - = gfc_trans_omp_variable_list (clause_code, n, omp_clauses); + = gfc_trans_omp_variable_list (clause_code, n, omp_clauses, + declare_simd); + break; + case OMP_LIST_ALIGNED: + for (; n != NULL; n = n->next) + if (n->sym->attr.referenced || declare_simd) + { + tree t = gfc_trans_omp_variable (n->sym, declare_simd); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_ALIGNED); + OMP_CLAUSE_DECL (node) = t; + if (n->expr) + { + tree alignment_var; + + if (block == NULL) + alignment_var = gfc_conv_constant_to_tree (n->expr); + else + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, n->expr); + gfc_add_block_to_block (block, &se.pre); + alignment_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + } + OMP_CLAUSE_ALIGNED_ALIGNMENT (node) = alignment_var; + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + break; + case OMP_LIST_LINEAR: + { + gfc_expr *last_step_expr = NULL; + tree last_step = NULL_TREE; + + for (; n != NULL; n = n->next) + { + if (n->expr) + { + last_step_expr = n->expr; + last_step = NULL_TREE; + } + if (n->sym->attr.referenced || declare_simd) + { + tree t = gfc_trans_omp_variable (n->sym, declare_simd); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_LINEAR); + OMP_CLAUSE_DECL (node) = t; + if (last_step_expr && last_step == NULL_TREE) + { + if (block == NULL) + last_step + = gfc_conv_constant_to_tree (last_step_expr); + else + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, last_step_expr); + gfc_add_block_to_block (block, &se.pre); + last_step = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + } + } + OMP_CLAUSE_LINEAR_STEP (node) + = fold_convert (gfc_typenode_for_spec (&n->sym->ts), + last_step); + if (n->sym->attr.dimension || n->sym->attr.allocatable) + OMP_CLAUSE_LINEAR_ARRAY (node) = 1; + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + } + } + break; + case OMP_LIST_DEPEND: + for (; n != NULL; n = n->next) + { + if (!n->sym->attr.referenced) + continue; + + tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND); + if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) + { + tree decl = gfc_get_symbol_decl (n->sym); + if (gfc_omp_privatize_by_reference (decl)) + decl = build_fold_indirect_ref (decl); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + { + decl = gfc_conv_descriptor_data_get (decl); + decl = fold_convert (build_pointer_type (char_type_node), + decl); + decl = build_fold_indirect_ref (decl); + } + else if (DECL_P (decl)) + TREE_ADDRESSABLE (decl) = 1; + OMP_CLAUSE_DECL (node) = decl; + } + else + { + tree ptr; + gfc_init_se (&se, NULL); + if (n->expr->ref->u.ar.type == AR_ELEMENT) + { + gfc_conv_expr_reference (&se, n->expr); + ptr = se.expr; + } + else + { + gfc_conv_expr_descriptor (&se, n->expr); + ptr = gfc_conv_array_data (se.expr); + } + gfc_add_block_to_block (block, &se.pre); + gfc_add_block_to_block (block, &se.post); + ptr = fold_convert (build_pointer_type (char_type_node), + ptr); + OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); + } + switch (n->u.depend_op) + { + case OMP_DEPEND_IN: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN; + break; + case OMP_DEPEND_OUT: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT; + break; + case OMP_DEPEND_INOUT: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT; + break; + default: + gcc_unreachable (); + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + break; + case OMP_LIST_MAP: + for (; n != NULL; n = n->next) + { + if (!n->sym->attr.referenced) + continue; + + tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP); + tree node2 = NULL_TREE; + tree node3 = NULL_TREE; + tree node4 = NULL_TREE; + tree decl = gfc_get_symbol_decl (n->sym); + if (DECL_P (decl)) + TREE_ADDRESSABLE (decl) = 1; + if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) + { + if (POINTER_TYPE_P (TREE_TYPE (decl))) + { + node4 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node4) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (node4) = decl; + OMP_CLAUSE_SIZE (node4) = size_int (0); + decl = build_fold_indirect_ref (decl); + } + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + { + tree type = TREE_TYPE (decl); + tree ptr = gfc_conv_descriptor_data_get (decl); + ptr = fold_convert (build_pointer_type (char_type_node), + ptr); + ptr = build_fold_indirect_ref (ptr); + OMP_CLAUSE_DECL (node) = ptr; + node2 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node2) = OMP_CLAUSE_MAP_TO_PSET; + OMP_CLAUSE_DECL (node2) = decl; + OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type); + node3 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node3) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (node3) + = gfc_conv_descriptor_data_get (decl); + OMP_CLAUSE_SIZE (node3) = size_int (0); + if (n->sym->attr.pointer) + { + stmtblock_t cond_block; + tree size + = gfc_create_var (gfc_array_index_type, NULL); + tree tem, then_b, else_b, zero, cond; + + gfc_init_block (&cond_block); + tem + = gfc_full_array_size (&cond_block, decl, + GFC_TYPE_ARRAY_RANK (type)); + gfc_add_modify (&cond_block, size, tem); + then_b = gfc_finish_block (&cond_block); + gfc_init_block (&cond_block); + zero = build_int_cst (gfc_array_index_type, 0); + gfc_add_modify (&cond_block, size, zero); + else_b = gfc_finish_block (&cond_block); + tem = gfc_conv_descriptor_data_get (decl); + tem = fold_convert (pvoid_type_node, tem); + cond = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, + tem, null_pointer_node); + gfc_add_expr_to_block (block, + build3_loc (input_location, + COND_EXPR, + void_type_node, + cond, then_b, + else_b)); + OMP_CLAUSE_SIZE (node) = size; + } + else + OMP_CLAUSE_SIZE (node) + = gfc_full_array_size (block, decl, + GFC_TYPE_ARRAY_RANK (type)); + tree elemsz + = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + OMP_CLAUSE_SIZE (node) + = fold_build2 (MULT_EXPR, gfc_array_index_type, + OMP_CLAUSE_SIZE (node), elemsz); + } + else + OMP_CLAUSE_DECL (node) = decl; + } + else + { + tree ptr, ptr2; + gfc_init_se (&se, NULL); + if (n->expr->ref->u.ar.type == AR_ELEMENT) + { + gfc_conv_expr_reference (&se, n->expr); + gfc_add_block_to_block (block, &se.pre); + ptr = se.expr; + OMP_CLAUSE_SIZE (node) + = TYPE_SIZE_UNIT (TREE_TYPE (ptr)); + } + else + { + gfc_conv_expr_descriptor (&se, n->expr); + ptr = gfc_conv_array_data (se.expr); + tree type = TREE_TYPE (se.expr); + gfc_add_block_to_block (block, &se.pre); + OMP_CLAUSE_SIZE (node) + = gfc_full_array_size (block, se.expr, + GFC_TYPE_ARRAY_RANK (type)); + tree elemsz + = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + OMP_CLAUSE_SIZE (node) + = fold_build2 (MULT_EXPR, gfc_array_index_type, + OMP_CLAUSE_SIZE (node), elemsz); + } + gfc_add_block_to_block (block, &se.post); + ptr = fold_convert (build_pointer_type (char_type_node), + ptr); + OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); + + if (POINTER_TYPE_P (TREE_TYPE (decl)) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))) + { + node4 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node4) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (node4) = decl; + OMP_CLAUSE_SIZE (node4) = size_int (0); + decl = build_fold_indirect_ref (decl); + } + ptr = fold_convert (sizetype, ptr); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + { + tree type = TREE_TYPE (decl); + ptr2 = gfc_conv_descriptor_data_get (decl); + node2 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node2) = OMP_CLAUSE_MAP_TO_PSET; + OMP_CLAUSE_DECL (node2) = decl; + OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type); + node3 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node3) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (node3) + = gfc_conv_descriptor_data_get (decl); + } + else + { + if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE) + ptr2 = build_fold_addr_expr (decl); + else + { + gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl))); + ptr2 = decl; + } + node3 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node3) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (node3) = decl; + } + ptr2 = fold_convert (sizetype, ptr2); + OMP_CLAUSE_SIZE (node3) + = fold_build2 (MINUS_EXPR, sizetype, ptr, ptr2); + } + switch (n->u.map_op) + { + case OMP_MAP_ALLOC: + OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_ALLOC; + break; + case OMP_MAP_TO: + OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_TO; + break; + case OMP_MAP_FROM: + OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FROM; + break; + case OMP_MAP_TOFROM: + OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_TOFROM; + break; + default: + gcc_unreachable (); + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + if (node2) + omp_clauses = gfc_trans_add_clause (node2, omp_clauses); + if (node3) + omp_clauses = gfc_trans_add_clause (node3, omp_clauses); + if (node4) + omp_clauses = gfc_trans_add_clause (node4, omp_clauses); + } + break; + case OMP_LIST_TO: + case OMP_LIST_FROM: + for (; n != NULL; n = n->next) + { + if (!n->sym->attr.referenced) + continue; + + tree node = build_omp_clause (input_location, + list == OMP_LIST_TO + ? OMP_CLAUSE_TO : OMP_CLAUSE_FROM); + if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) + { + tree decl = gfc_get_symbol_decl (n->sym); + if (gfc_omp_privatize_by_reference (decl)) + decl = build_fold_indirect_ref (decl); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + { + tree type = TREE_TYPE (decl); + tree ptr = gfc_conv_descriptor_data_get (decl); + ptr = fold_convert (build_pointer_type (char_type_node), + ptr); + ptr = build_fold_indirect_ref (ptr); + OMP_CLAUSE_DECL (node) = ptr; + OMP_CLAUSE_SIZE (node) + = gfc_full_array_size (block, decl, + GFC_TYPE_ARRAY_RANK (type)); + tree elemsz + = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + OMP_CLAUSE_SIZE (node) + = fold_build2 (MULT_EXPR, gfc_array_index_type, + OMP_CLAUSE_SIZE (node), elemsz); + } + else + OMP_CLAUSE_DECL (node) = decl; + } + else + { + tree ptr; + gfc_init_se (&se, NULL); + if (n->expr->ref->u.ar.type == AR_ELEMENT) + { + gfc_conv_expr_reference (&se, n->expr); + ptr = se.expr; + gfc_add_block_to_block (block, &se.pre); + OMP_CLAUSE_SIZE (node) + = TYPE_SIZE_UNIT (TREE_TYPE (ptr)); + } + else + { + gfc_conv_expr_descriptor (&se, n->expr); + ptr = gfc_conv_array_data (se.expr); + tree type = TREE_TYPE (se.expr); + gfc_add_block_to_block (block, &se.pre); + OMP_CLAUSE_SIZE (node) + = gfc_full_array_size (block, se.expr, + GFC_TYPE_ARRAY_RANK (type)); + tree elemsz + = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + OMP_CLAUSE_SIZE (node) + = fold_build2 (MULT_EXPR, gfc_array_index_type, + OMP_CLAUSE_SIZE (node), elemsz); + } + gfc_add_block_to_block (block, &se.post); + ptr = fold_convert (build_pointer_type (char_type_node), + ptr); + OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } break; default: break; @@ -1000,7 +2273,146 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } - return omp_clauses; + if (clauses->inbranch) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_INBRANCH); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->notinbranch) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOTINBRANCH); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + switch (clauses->cancel) + { + case OMP_CANCEL_UNKNOWN: + break; + case OMP_CANCEL_PARALLEL: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_PARALLEL); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + case OMP_CANCEL_SECTIONS: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SECTIONS); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + case OMP_CANCEL_DO: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_FOR); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + case OMP_CANCEL_TASKGROUP: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_TASKGROUP); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + } + + if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_PROC_BIND); + switch (clauses->proc_bind) + { + case OMP_PROC_BIND_MASTER: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_MASTER; + break; + case OMP_PROC_BIND_SPREAD: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_SPREAD; + break; + case OMP_PROC_BIND_CLOSE: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_CLOSE; + break; + default: + gcc_unreachable (); + } + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->safelen_expr) + { + tree safelen_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->safelen_expr); + gfc_add_block_to_block (block, &se.pre); + safelen_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SAFELEN); + OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->simdlen_expr) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN); + OMP_CLAUSE_SIMDLEN_EXPR (c) + = gfc_conv_constant_to_tree (clauses->simdlen_expr); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->num_teams) + { + tree num_teams; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->num_teams); + gfc_add_block_to_block (block, &se.pre); + num_teams = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TEAMS); + OMP_CLAUSE_NUM_TEAMS_EXPR (c) = num_teams; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->device) + { + tree device; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->device); + gfc_add_block_to_block (block, &se.pre); + device = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEVICE); + OMP_CLAUSE_DEVICE_ID (c) = device; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->thread_limit) + { + tree thread_limit; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->thread_limit); + gfc_add_block_to_block (block, &se.pre); + thread_limit = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREAD_LIMIT); + OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = thread_limit; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + chunk_size = NULL_TREE; + if (clauses->dist_chunk_size) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->dist_chunk_size); + gfc_add_block_to_block (block, &se.pre); + chunk_size = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + } + + if (clauses->dist_sched_kind != OMP_SCHED_NONE) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_DIST_SCHEDULE); + OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (c) = chunk_size; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + return nreverse (omp_clauses); } /* Like gfc_trans_code, but force creation of a BIND_EXPR around it. */ @@ -1045,6 +2457,7 @@ gfc_trans_omp_atomic (gfc_code *code) enum tree_code op = ERROR_MARK; enum tree_code aop = OMP_ATOMIC; bool var_on_left = false; + bool seq_cst = (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST) != 0; code = code->block->next; gcc_assert (code->op == EXEC_ASSIGN); @@ -1060,7 +2473,7 @@ gfc_trans_omp_atomic (gfc_code *code) && expr2->value.function.isym->id == GFC_ISYM_CONVERSION) expr2 = expr2->value.function.actual->expr; - switch (atomic_code->ext.omp_atomic) + switch (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) { case GFC_OMP_ATOMIC_READ: gfc_conv_expr (&vse, code->expr1); @@ -1072,6 +2485,7 @@ gfc_trans_omp_atomic (gfc_code *code) lhsaddr = gfc_build_addr_expr (NULL, lse.expr); x = build1 (OMP_ATOMIC_READ, type, lhsaddr); + OMP_ATOMIC_SEQ_CST (x) = seq_cst; x = convert (TREE_TYPE (vse.expr), x); gfc_add_modify (&block, vse.expr, x); @@ -1107,7 +2521,9 @@ gfc_trans_omp_atomic (gfc_code *code) type = TREE_TYPE (lse.expr); lhsaddr = gfc_build_addr_expr (NULL, lse.expr); - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE) + if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_WRITE) + || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP)) { gfc_conv_expr (&rse, expr2); gfc_add_block_to_block (&block, &rse.pre); @@ -1229,7 +2645,9 @@ gfc_trans_omp_atomic (gfc_code *code) lhsaddr = save_expr (lhsaddr); rhs = gfc_evaluate_now (rse.expr, &block); - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE) + if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_WRITE) + || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP)) x = rhs; else { @@ -1252,6 +2670,7 @@ gfc_trans_omp_atomic (gfc_code *code) if (aop == OMP_ATOMIC) { x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x)); + OMP_ATOMIC_SEQ_CST (x) = seq_cst; gfc_add_expr_to_block (&block, x); } else @@ -1273,6 +2692,7 @@ gfc_trans_omp_atomic (gfc_code *code) gfc_add_block_to_block (&block, &lse.pre); } x = build2 (aop, type, lhsaddr, convert (type, x)); + OMP_ATOMIC_SEQ_CST (x) = seq_cst; x = convert (TREE_TYPE (vse.expr), x); gfc_add_modify (&block, vse.expr, x); } @@ -1288,6 +2708,63 @@ gfc_trans_omp_barrier (void) } static tree +gfc_trans_omp_cancel (gfc_code *code) +{ + int mask = 0; + tree ifc = boolean_true_node; + stmtblock_t block; + switch (code->ext.omp_clauses->cancel) + { + case OMP_CANCEL_PARALLEL: mask = 1; break; + case OMP_CANCEL_DO: mask = 2; break; + case OMP_CANCEL_SECTIONS: mask = 4; break; + case OMP_CANCEL_TASKGROUP: mask = 8; break; + default: gcc_unreachable (); + } + gfc_start_block (&block); + if (code->ext.omp_clauses->if_expr) + { + gfc_se se; + tree if_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, code->ext.omp_clauses->if_expr); + gfc_add_block_to_block (&block, &se.pre); + if_var = gfc_evaluate_now (se.expr, &block); + gfc_add_block_to_block (&block, &se.post); + tree type = TREE_TYPE (if_var); + ifc = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, if_var, + build_zero_cst (type)); + } + tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCEL); + tree c_bool_type = TREE_TYPE (TREE_TYPE (decl)); + ifc = fold_convert (c_bool_type, ifc); + gfc_add_expr_to_block (&block, + build_call_expr_loc (input_location, decl, 2, + build_int_cst (integer_type_node, + mask), ifc)); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_cancellation_point (gfc_code *code) +{ + int mask = 0; + switch (code->ext.omp_clauses->cancel) + { + case OMP_CANCEL_PARALLEL: mask = 1; break; + case OMP_CANCEL_DO: mask = 2; break; + case OMP_CANCEL_SECTIONS: mask = 4; break; + case OMP_CANCEL_TASKGROUP: mask = 8; break; + default: gcc_unreachable (); + } + tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCELLATION_POINT); + return build_call_expr_loc (input_location, decl, 1, + build_int_cst (integer_type_node, mask)); +} + +static tree gfc_trans_omp_critical (gfc_code *code) { tree name = NULL_TREE, stmt; @@ -1304,7 +2781,7 @@ typedef struct dovar_init_d { static tree -gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, +gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, gfc_omp_clauses *do_clauses, tree par_clauses) { gfc_se se; @@ -1344,14 +2821,16 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, if (clauses) { - gfc_namelist *n; - for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL; - n = n->next) - if (code->ext.iterator->var->symtree->n.sym == n->sym) - break; + gfc_omp_namelist *n = NULL; + if (op != EXEC_OMP_DISTRIBUTE) + for (n = clauses->lists[(op == EXEC_OMP_SIMD && collapse == 1) + ? OMP_LIST_LINEAR : OMP_LIST_LASTPRIVATE]; + n != NULL; n = n->next) + if (code->ext.iterator->var->symtree->n.sym == n->sym) + break; if (n != NULL) dovar_found = 1; - else if (n == NULL) + else if (n == NULL && op != EXEC_OMP_SIMD) for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next) if (code->ext.iterator->var->symtree->n.sym == n->sym) break; @@ -1393,7 +2872,8 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, } else dovar_decl - = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym); + = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym, + false); /* Loop body. */ if (simple) @@ -1447,11 +2927,24 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, if (!dovar_found) { - tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + if (op == EXEC_OMP_SIMD) + { + if (collapse == 1) + { + tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); + OMP_CLAUSE_LINEAR_STEP (tmp) = step; + } + else + tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE); + if (!simple) + dovar_found = 2; + } + else + tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); OMP_CLAUSE_DECL (tmp) = dovar_decl; omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } - else if (dovar_found == 2) + if (dovar_found == 2) { tree c = NULL; @@ -1475,8 +2968,14 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp; break; } + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR + && OMP_CLAUSE_DECL (c) == dovar_decl) + { + OMP_CLAUSE_LINEAR_STMT (c) = tmp; + break; + } } - if (c == NULL && par_clauses != NULL) + if (c == NULL && op == EXEC_OMP_DO && par_clauses != NULL) { for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c)) if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE @@ -1496,7 +2995,17 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, } if (!simple) { - tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + if (op != EXEC_OMP_SIMD) + tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + else if (collapse == 1) + { + tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); + OMP_CLAUSE_LINEAR_STEP (tmp) = step; + OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1; + OMP_CLAUSE_LINEAR_NO_COPYOUT (tmp) = 1; + } + else + tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE); OMP_CLAUSE_DECL (tmp) = count; omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } @@ -1538,7 +3047,13 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, } /* End of loop body. */ - stmt = make_node (OMP_FOR); + switch (op) + { + case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break; + case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break; + case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break; + default: gcc_unreachable (); + } TREE_TYPE (stmt) = void_type_node; OMP_FOR_BODY (stmt) = gfc_finish_block (&body); @@ -1589,41 +3104,352 @@ gfc_trans_omp_parallel (gfc_code *code) return gfc_finish_block (&block); } +enum +{ + GFC_OMP_SPLIT_SIMD, + GFC_OMP_SPLIT_DO, + GFC_OMP_SPLIT_PARALLEL, + GFC_OMP_SPLIT_DISTRIBUTE, + GFC_OMP_SPLIT_TEAMS, + GFC_OMP_SPLIT_TARGET, + GFC_OMP_SPLIT_NUM +}; + +enum +{ + GFC_OMP_MASK_SIMD = (1 << GFC_OMP_SPLIT_SIMD), + GFC_OMP_MASK_DO = (1 << GFC_OMP_SPLIT_DO), + GFC_OMP_MASK_PARALLEL = (1 << GFC_OMP_SPLIT_PARALLEL), + GFC_OMP_MASK_DISTRIBUTE = (1 << GFC_OMP_SPLIT_DISTRIBUTE), + GFC_OMP_MASK_TEAMS = (1 << GFC_OMP_SPLIT_TEAMS), + GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET) +}; + +static void +gfc_split_omp_clauses (gfc_code *code, + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]) +{ + int mask = 0, innermost = 0; + memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses)); + switch (code->op) + { + case EXEC_OMP_DISTRIBUTE: + innermost = GFC_OMP_SPLIT_DISTRIBUTE; + break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_PARALLEL + | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_DISTRIBUTE_SIMD: + mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_DO: + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_DO_SIMD: + mask = GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_PARALLEL: + innermost = GFC_OMP_SPLIT_PARALLEL; + break; + case EXEC_OMP_PARALLEL_DO: + mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_SIMD: + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_TARGET: + innermost = GFC_OMP_SPLIT_TARGET; + break; + case EXEC_OMP_TARGET_TEAMS: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS; + innermost = GFC_OMP_SPLIT_TEAMS; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS + | GFC_OMP_MASK_DISTRIBUTE; + innermost = GFC_OMP_SPLIT_DISTRIBUTE; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE + | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE + | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS + | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_TEAMS: + innermost = GFC_OMP_SPLIT_TEAMS; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE: + mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE; + innermost = GFC_OMP_SPLIT_DISTRIBUTE; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE + | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE + | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + default: + gcc_unreachable (); + } + if (mask == 0) + { + clausesa[innermost] = *code->ext.omp_clauses; + return; + } + if (code->ext.omp_clauses != NULL) + { + if (mask & GFC_OMP_MASK_TARGET) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP] + = code->ext.omp_clauses->lists[OMP_LIST_MAP]; + clausesa[GFC_OMP_SPLIT_TARGET].device + = code->ext.omp_clauses->device; + } + if (mask & GFC_OMP_MASK_TEAMS) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams + = code->ext.omp_clauses->num_teams; + clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit + = code->ext.omp_clauses->thread_limit; + /* Shared and default clauses are allowed on parallel and teams. */ + clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_SHARED] + = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; + clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing + = code->ext.omp_clauses->default_sharing; + } + if (mask & GFC_OMP_MASK_DISTRIBUTE) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].dist_sched_kind + = code->ext.omp_clauses->dist_sched_kind; + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].dist_chunk_size + = code->ext.omp_clauses->dist_chunk_size; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].collapse + = code->ext.omp_clauses->collapse; + } + if (mask & GFC_OMP_MASK_PARALLEL) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_COPYIN] + = code->ext.omp_clauses->lists[OMP_LIST_COPYIN]; + clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads + = code->ext.omp_clauses->num_threads; + clausesa[GFC_OMP_SPLIT_PARALLEL].proc_bind + = code->ext.omp_clauses->proc_bind; + /* Shared and default clauses are allowed on parallel and teams. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_SHARED] + = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; + clausesa[GFC_OMP_SPLIT_PARALLEL].default_sharing + = code->ext.omp_clauses->default_sharing; + } + if (mask & GFC_OMP_MASK_DO) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_DO].ordered + = code->ext.omp_clauses->ordered; + clausesa[GFC_OMP_SPLIT_DO].sched_kind + = code->ext.omp_clauses->sched_kind; + clausesa[GFC_OMP_SPLIT_DO].chunk_size + = code->ext.omp_clauses->chunk_size; + clausesa[GFC_OMP_SPLIT_DO].nowait + = code->ext.omp_clauses->nowait; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_DO].collapse + = code->ext.omp_clauses->collapse; + } + if (mask & GFC_OMP_MASK_SIMD) + { + clausesa[GFC_OMP_SPLIT_SIMD].safelen_expr + = code->ext.omp_clauses->safelen_expr; + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LINEAR] + = code->ext.omp_clauses->lists[OMP_LIST_LINEAR]; + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED] + = code->ext.omp_clauses->lists[OMP_LIST_ALIGNED]; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_SIMD].collapse + = code->ext.omp_clauses->collapse; + } + /* Private clause is supported on all constructs but target, + it is enough to put it on the innermost one. For + !$ omp do put it on parallel though, + as that's what we did for OpenMP 3.1. */ + clausesa[innermost == GFC_OMP_SPLIT_DO + ? (int) GFC_OMP_SPLIT_PARALLEL + : innermost].lists[OMP_LIST_PRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE]; + /* Firstprivate clause is supported on all constructs but + target and simd. Put it on the outermost of those and + duplicate on parallel. */ + if (mask & GFC_OMP_MASK_TEAMS) + clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + else if (mask & GFC_OMP_MASK_DISTRIBUTE) + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + else if (mask & GFC_OMP_MASK_DO) + clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + /* Lastprivate is allowed on do and simd. In + parallel do{, simd} we actually want to put it on + parallel rather than do. */ + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + else if (mask & GFC_OMP_MASK_DO) + clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + if (mask & GFC_OMP_MASK_SIMD) + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + /* Reduction is allowed on simd, do, parallel and teams. + Duplicate it on all of them, but omit on do if + parallel is present. */ + if (mask & GFC_OMP_MASK_TEAMS) + clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_REDUCTION] + = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION]; + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_REDUCTION] + = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION]; + else if (mask & GFC_OMP_MASK_DO) + clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_REDUCTION] + = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION]; + if (mask & GFC_OMP_MASK_SIMD) + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_REDUCTION] + = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION]; + /* FIXME: This is currently being discussed. */ + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr + = code->ext.omp_clauses->if_expr; + else + clausesa[GFC_OMP_SPLIT_TARGET].if_expr + = code->ext.omp_clauses->if_expr; + } + if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + clausesa[GFC_OMP_SPLIT_DO].nowait = true; +} + static tree -gfc_trans_omp_parallel_do (gfc_code *code) +gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock, + gfc_omp_clauses *clausesa, tree omp_clauses) { - stmtblock_t block, *pblock = NULL; - gfc_omp_clauses parallel_clauses, do_clauses; - tree stmt, omp_clauses = NULL_TREE; + stmtblock_t block; + gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; + tree stmt, body, omp_do_clauses = NULL_TREE; - gfc_start_block (&block); + if (pblock == NULL) + gfc_start_block (&block); + else + gfc_init_block (&block); - memset (&do_clauses, 0, sizeof (do_clauses)); - if (code->ext.omp_clauses != NULL) + if (clausesa == NULL) + { + clausesa = clausesa_buf; + gfc_split_omp_clauses (code, clausesa); + } + if (gfc_option.gfc_flag_openmp) + omp_do_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DO], code->loc); + body = gfc_trans_omp_do (code, EXEC_OMP_SIMD, pblock ? pblock : &block, + &clausesa[GFC_OMP_SPLIT_SIMD], omp_clauses); + if (pblock == NULL) + { + if (TREE_CODE (body) != BIND_EXPR) + body = build3_v (BIND_EXPR, NULL, body, poplevel (1, 0)); + else + poplevel (0, 0); + } + else if (TREE_CODE (body) != BIND_EXPR) + body = build3_v (BIND_EXPR, NULL, body, NULL_TREE); + if (gfc_option.gfc_flag_openmp) { - memcpy (¶llel_clauses, code->ext.omp_clauses, - sizeof (parallel_clauses)); - do_clauses.sched_kind = parallel_clauses.sched_kind; - do_clauses.chunk_size = parallel_clauses.chunk_size; - do_clauses.ordered = parallel_clauses.ordered; - do_clauses.collapse = parallel_clauses.collapse; - parallel_clauses.sched_kind = OMP_SCHED_NONE; - parallel_clauses.chunk_size = NULL; - parallel_clauses.ordered = false; - parallel_clauses.collapse = 0; - omp_clauses = gfc_trans_omp_clauses (&block, ¶llel_clauses, - code->loc); - } - do_clauses.nowait = true; - if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC) - pblock = █ + stmt = make_node (OMP_FOR); + TREE_TYPE (stmt) = void_type_node; + OMP_FOR_BODY (stmt) = body; + OMP_FOR_CLAUSES (stmt) = omp_do_clauses; + } else - pushlevel (); - stmt = gfc_trans_omp_do (code, pblock, &do_clauses, omp_clauses); - if (TREE_CODE (stmt) != BIND_EXPR) - stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + stmt = body; + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock, + gfc_omp_clauses *clausesa) +{ + stmtblock_t block, *new_pblock = pblock; + gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + if (pblock == NULL) + gfc_start_block (&block); else - poplevel (0, 0); + gfc_init_block (&block); + + if (clausesa == NULL) + { + clausesa = clausesa_buf; + gfc_split_omp_clauses (code, clausesa); + } + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL], + code->loc); + if (pblock == NULL) + { + if (!clausesa[GFC_OMP_SPLIT_DO].ordered + && clausesa[GFC_OMP_SPLIT_DO].sched_kind != OMP_SCHED_STATIC) + new_pblock = █ + else + pushlevel (); + } + stmt = gfc_trans_omp_do (code, EXEC_OMP_DO, new_pblock, + &clausesa[GFC_OMP_SPLIT_DO], omp_clauses); + if (pblock == NULL) + { + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + } + else if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, NULL_TREE); stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt, omp_clauses); OMP_PARALLEL_COMBINED (stmt) = 1; @@ -1632,6 +3458,50 @@ gfc_trans_omp_parallel_do (gfc_code *code) } static tree +gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock, + gfc_omp_clauses *clausesa) +{ + stmtblock_t block; + gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + if (pblock == NULL) + gfc_start_block (&block); + else + gfc_init_block (&block); + + if (clausesa == NULL) + { + clausesa = clausesa_buf; + gfc_split_omp_clauses (code, clausesa); + } + if (gfc_option.gfc_flag_openmp) + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL], + code->loc); + if (pblock == NULL) + pushlevel (); + stmt = gfc_trans_omp_do_simd (code, pblock, clausesa, omp_clauses); + if (pblock == NULL) + { + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + } + else if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, NULL_TREE); + if (gfc_option.gfc_flag_openmp) + { + stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt, + omp_clauses); + OMP_PARALLEL_COMBINED (stmt) = 1; + } + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree gfc_trans_omp_parallel_sections (gfc_code *code) { stmtblock_t block; @@ -1743,6 +3613,13 @@ gfc_trans_omp_task (gfc_code *code) } static tree +gfc_trans_omp_taskgroup (gfc_code *code) +{ + tree stmt = gfc_trans_code (code->block->next); + return build1_loc (input_location, OMP_TASKGROUP, void_type_node, stmt); +} + +static tree gfc_trans_omp_taskwait (void) { tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT); @@ -1757,6 +3634,170 @@ gfc_trans_omp_taskyield (void) } static tree +gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa) +{ + stmtblock_t block; + gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + gfc_start_block (&block); + if (clausesa == NULL) + { + clausesa = clausesa_buf; + gfc_split_omp_clauses (code, clausesa); + } + if (gfc_option.gfc_flag_openmp) + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DISTRIBUTE], + code->loc); + switch (code->op) + { + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE: + /* This is handled in gfc_trans_omp_do. */ + gcc_unreachable (); + break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + stmt = gfc_trans_omp_parallel_do (code, &block, clausesa); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + stmt = gfc_trans_omp_parallel_do_simd (code, &block, clausesa); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + case EXEC_OMP_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block, + &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + default: + gcc_unreachable (); + } + if (gfc_option.gfc_flag_openmp) + { + tree distribute = make_node (OMP_DISTRIBUTE); + TREE_TYPE (distribute) = void_type_node; + OMP_FOR_BODY (distribute) = stmt; + OMP_FOR_CLAUSES (distribute) = omp_clauses; + stmt = distribute; + } + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa) +{ + stmtblock_t block; + gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + gfc_start_block (&block); + if (clausesa == NULL) + { + clausesa = clausesa_buf; + gfc_split_omp_clauses (code, clausesa); + } + if (gfc_option.gfc_flag_openmp) + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TEAMS], + code->loc); + switch (code->op) + { + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TEAMS: + stmt = gfc_trans_omp_code (code->block->next, true); + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE: + stmt = gfc_trans_omp_do (code, EXEC_OMP_DISTRIBUTE, NULL, + &clausesa[GFC_OMP_SPLIT_DISTRIBUTE], + NULL); + break; + default: + stmt = gfc_trans_omp_distribute (code, clausesa); + break; + } + stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt, + omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_target (gfc_code *code) +{ + stmtblock_t block; + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + gfc_start_block (&block); + gfc_split_omp_clauses (code, clausesa); + if (gfc_option.gfc_flag_openmp) + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET], + code->loc); + if (code->op == EXEC_OMP_TARGET) + stmt = gfc_trans_omp_code (code->block->next, true); + else + stmt = gfc_trans_omp_teams (code, clausesa); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, NULL_TREE); + if (gfc_option.gfc_flag_openmp) + stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt, + omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_target_data (gfc_code *code) +{ + stmtblock_t block; + tree stmt, omp_clauses; + + gfc_start_block (&block); + omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, + code->loc); + stmt = gfc_trans_omp_code (code->block->next, true); + stmt = build2_loc (input_location, OMP_TARGET_DATA, void_type_node, stmt, + omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_target_update (gfc_code *code) +{ + stmtblock_t block; + tree stmt, omp_clauses; + + gfc_start_block (&block); + omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, + code->loc); + stmt = build1_loc (input_location, OMP_TARGET_UPDATE, void_type_node, + omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses) { tree res, tmp, stmt; @@ -1923,10 +3964,23 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_atomic (code); case EXEC_OMP_BARRIER: return gfc_trans_omp_barrier (); + case EXEC_OMP_CANCEL: + return gfc_trans_omp_cancel (code); + case EXEC_OMP_CANCELLATION_POINT: + return gfc_trans_omp_cancellation_point (code); case EXEC_OMP_CRITICAL: return gfc_trans_omp_critical (code); + case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DO: - return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses, NULL); + case EXEC_OMP_SIMD: + return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses, + NULL); + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: + return gfc_trans_omp_distribute (code, NULL); + case EXEC_OMP_DO_SIMD: + return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE); case EXEC_OMP_FLUSH: return gfc_trans_omp_flush (); case EXEC_OMP_MASTER: @@ -1936,7 +3990,9 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_PARALLEL: return gfc_trans_omp_parallel (code); case EXEC_OMP_PARALLEL_DO: - return gfc_trans_omp_parallel_do (code); + return gfc_trans_omp_parallel_do (code, NULL, NULL); + case EXEC_OMP_PARALLEL_DO_SIMD: + return gfc_trans_omp_parallel_do_simd (code, NULL, NULL); case EXEC_OMP_PARALLEL_SECTIONS: return gfc_trans_omp_parallel_sections (code); case EXEC_OMP_PARALLEL_WORKSHARE: @@ -1945,15 +4001,53 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_sections (code, code->ext.omp_clauses); case EXEC_OMP_SINGLE: return gfc_trans_omp_single (code, code->ext.omp_clauses); + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + return gfc_trans_omp_target (code); + case EXEC_OMP_TARGET_DATA: + return gfc_trans_omp_target_data (code); + case EXEC_OMP_TARGET_UPDATE: + return gfc_trans_omp_target_update (code); case EXEC_OMP_TASK: return gfc_trans_omp_task (code); + case EXEC_OMP_TASKGROUP: + return gfc_trans_omp_taskgroup (code); case EXEC_OMP_TASKWAIT: return gfc_trans_omp_taskwait (); case EXEC_OMP_TASKYIELD: return gfc_trans_omp_taskyield (); + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + return gfc_trans_omp_teams (code, NULL); case EXEC_OMP_WORKSHARE: return gfc_trans_omp_workshare (code, code->ext.omp_clauses); default: gcc_unreachable (); } } + +void +gfc_trans_omp_declare_simd (gfc_namespace *ns) +{ + if (ns->entries) + return; + + gfc_omp_declare_simd *ods; + for (ods = ns->omp_declare_simd; ods; ods = ods->next) + { + tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where, true); + tree fndecl = ns->proc_name->backend_decl; + if (c != NULL_TREE) + c = tree_cons (NULL_TREE, c, NULL_TREE); + c = build_tree_list (get_identifier ("omp declare simd"), c); + TREE_CHAIN (c) = DECL_ATTRIBUTES (fndecl); + DECL_ATTRIBUTES (fndecl) = c; + } +} diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h index 8a57be4d577..087bafea4b0 100644 --- a/gcc/fortran/trans-stmt.h +++ b/gcc/fortran/trans-stmt.h @@ -63,6 +63,7 @@ tree gfc_trans_deallocate_array (tree); /* trans-openmp.c */ tree gfc_trans_omp_directive (gfc_code *); +void gfc_trans_omp_declare_simd (gfc_namespace *); /* trans-io.c */ tree gfc_trans_open (gfc_code *); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 59637f2d3cb..22f456e0283 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2162,9 +2162,6 @@ gfc_sym_type (gfc_symbol * sym) restricted); byref = 0; } - - if (sym->attr.cray_pointee) - GFC_POINTER_TYPE_P (type) = 1; } else { @@ -2183,8 +2180,6 @@ gfc_sym_type (gfc_symbol * sym) if (sym->attr.allocatable || sym->attr.pointer || gfc_is_associate_pointer (sym)) type = gfc_build_pointer_type (sym, type); - if (sym->attr.pointer || sym->attr.cray_pointee) - GFC_POINTER_TYPE_P (type) = 1; } /* We currently pass all parameters by reference. @@ -2554,6 +2549,8 @@ gfc_get_derived_type (gfc_symbol * derived) else if (derived->declared_at.lb) gfc_set_decl_location (field, &derived->declared_at); + gfc_finish_decl_attrs (field, &c->attr); + DECL_PACKED (field) |= TYPE_PACKED (typenode); gcc_assert (field); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 5961c267e8c..7c73f596100 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1848,20 +1848,43 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_CRITICAL: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_FLUSH: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: res = gfc_trans_omp_directive (code); break; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 7809bb05b92..b55460f4d02 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -547,6 +547,9 @@ void gfc_set_decl_assembler_name (tree, tree); /* Returns true if a variable of specified size should go on the stack. */ int gfc_can_put_var_on_stack (tree); +/* Set GFC_DECL_SCALAR_* on decl from sym if needed. */ +void gfc_finish_decl_attrs (tree, symbol_attribute *); + /* Allocate the lang-specific part of a decl node. */ void gfc_allocate_lang_decl (tree); @@ -666,7 +669,9 @@ tree gfc_omp_report_decl (tree); tree gfc_omp_clause_default_ctor (tree, tree, tree); tree gfc_omp_clause_copy_ctor (tree, tree, tree); tree gfc_omp_clause_assign_op (tree, tree, tree); +tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree); tree gfc_omp_clause_dtor (tree, tree); +void gfc_omp_finish_clause (tree, gimple_seq *); bool gfc_omp_disregard_value_expr (tree, bool); bool gfc_omp_private_debug_clause (tree, bool); bool gfc_omp_private_outer_ref (tree); @@ -824,6 +829,8 @@ struct GTY((variable_size)) lang_decl { tree span; /* For assumed-shape coarrays. */ tree token, caf_offset; + unsigned int scalar_allocatable : 1; + unsigned int scalar_pointer : 1; }; @@ -834,6 +841,14 @@ struct GTY((variable_size)) lang_decl { #define GFC_DECL_CAF_OFFSET(node) DECL_LANG_SPECIFIC(node)->caf_offset #define GFC_DECL_SAVED_DESCRIPTOR(node) \ (DECL_LANG_SPECIFIC(node)->saved_descriptor) +#define GFC_DECL_SCALAR_ALLOCATABLE(node) \ + (DECL_LANG_SPECIFIC (node)->scalar_allocatable) +#define GFC_DECL_SCALAR_POINTER(node) \ + (DECL_LANG_SPECIFIC (node)->scalar_pointer) +#define GFC_DECL_GET_SCALAR_ALLOCATABLE(node) \ + (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_ALLOCATABLE (node) : 0) +#define GFC_DECL_GET_SCALAR_POINTER(node) \ + (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_POINTER (node) : 0) #define GFC_DECL_PACKED_ARRAY(node) DECL_LANG_FLAG_0(node) #define GFC_DECL_PARTIAL_PACKED_ARRAY(node) DECL_LANG_FLAG_1(node) #define GFC_DECL_ASSIGN(node) DECL_LANG_FLAG_2(node) @@ -841,14 +856,13 @@ struct GTY((variable_size)) lang_decl { #define GFC_DECL_CRAY_POINTEE(node) DECL_LANG_FLAG_4(node) #define GFC_DECL_RESULT(node) DECL_LANG_FLAG_5(node) #define GFC_DECL_SUBREF_ARRAY_P(node) DECL_LANG_FLAG_6(node) +#define GFC_DECL_ASSOCIATE_VAR_P(node) DECL_LANG_FLAG_7(node) #define GFC_DECL_CLASS(node) DECL_LANG_FLAG_8(node) /* An array descriptor. */ #define GFC_DESCRIPTOR_TYPE_P(node) TYPE_LANG_FLAG_1(node) /* An array without a descriptor. */ #define GFC_ARRAY_TYPE_P(node) TYPE_LANG_FLAG_2(node) -/* Fortran POINTER type. */ -#define GFC_POINTER_TYPE_P(node) TYPE_LANG_FLAG_3(node) /* Fortran CLASS type. */ #define GFC_CLASS_TYPE_P(node) TYPE_LANG_FLAG_4(node) /* The GFC_TYPE_ARRAY_* members are present in both descriptor and diff --git a/gcc/gimplify.c b/gcc/gimplify.c index 9eaaaa86913..4121bf3cff4 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -2170,7 +2170,7 @@ maybe_with_size_expr (tree *expr_p) Store any side-effects in PRE_P. CALL_LOCATION is the location of the CALL_EXPR. */ -static enum gimplify_status +enum gimplify_status gimplify_arg (tree *arg_p, gimple_seq *pre_p, location_t call_location) { bool (*test) (tree); @@ -5643,6 +5643,7 @@ omp_notice_variable (struct gimplify_omp_ctx *ctx, tree decl, bool in_code) n = splay_tree_lookup (ctx->variables, (splay_tree_key)decl); if (ctx->region_type == ORT_TARGET) { + ret = lang_hooks.decls.omp_disregard_value_expr (decl, true); if (n == NULL) { if (!lang_hooks.types.omp_mappable_type (TREE_TYPE (decl))) @@ -5655,8 +5656,12 @@ omp_notice_variable (struct gimplify_omp_ctx *ctx, tree decl, bool in_code) omp_add_variable (ctx, decl, GOVD_MAP | flags); } else - n->value |= flags; - ret = lang_hooks.decls.omp_disregard_value_expr (decl, true); + { + /* If nothing changed, there's nothing left to do. */ + if ((n->value & flags) == flags) + return ret; + n->value |= flags; + } goto do_outer; } @@ -5942,14 +5947,21 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, goto do_add; case OMP_CLAUSE_MAP: - if (OMP_CLAUSE_SIZE (c) - && gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p, - NULL, is_gimple_val, fb_rvalue) == GS_ERROR) + decl = OMP_CLAUSE_DECL (c); + if (error_operand_p (decl)) + { + remove = true; + break; + } + if (OMP_CLAUSE_SIZE (c) == NULL_TREE) + OMP_CLAUSE_SIZE (c) = DECL_P (decl) ? DECL_SIZE_UNIT (decl) + : TYPE_SIZE_UNIT (TREE_TYPE (decl)); + if (gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p, + NULL, is_gimple_val, fb_rvalue) == GS_ERROR) { remove = true; break; } - decl = OMP_CLAUSE_DECL (c); if (!DECL_P (decl)) { if (gimplify_expr (&OMP_CLAUSE_DECL (c), pre_p, @@ -5987,15 +5999,17 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, case OMP_CLAUSE_TO: case OMP_CLAUSE_FROM: - if (OMP_CLAUSE_SIZE (c) - && gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p, - NULL, is_gimple_val, fb_rvalue) == GS_ERROR) + decl = OMP_CLAUSE_DECL (c); + if (error_operand_p (decl)) { remove = true; break; } - decl = OMP_CLAUSE_DECL (c); - if (error_operand_p (decl)) + if (OMP_CLAUSE_SIZE (c) == NULL_TREE) + OMP_CLAUSE_SIZE (c) = DECL_P (decl) ? DECL_SIZE_UNIT (decl) + : TYPE_SIZE_UNIT (TREE_TYPE (decl)); + if (gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p, + NULL, is_gimple_val, fb_rvalue) == GS_ERROR) { remove = true; break; @@ -6067,6 +6081,27 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, gimplify_omp_ctxp = outer_ctx; } + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR + && OMP_CLAUSE_LINEAR_STMT (c)) + { + gimplify_omp_ctxp = ctx; + push_gimplify_context (); + if (TREE_CODE (OMP_CLAUSE_LINEAR_STMT (c)) != BIND_EXPR) + { + tree bind = build3 (BIND_EXPR, void_type_node, NULL, + NULL, NULL); + TREE_SIDE_EFFECTS (bind) = 1; + BIND_EXPR_BODY (bind) = OMP_CLAUSE_LINEAR_STMT (c); + OMP_CLAUSE_LINEAR_STMT (c) = bind; + } + gimplify_and_add (OMP_CLAUSE_LINEAR_STMT (c), + &OMP_CLAUSE_LINEAR_GIMPLE_SEQ (c)); + pop_gimplify_context + (gimple_seq_first_stmt (OMP_CLAUSE_LINEAR_GIMPLE_SEQ (c))); + OMP_CLAUSE_LINEAR_STMT (c) = NULL_TREE; + + gimplify_omp_ctxp = outer_ctx; + } if (notice_outer) goto do_notice; break; @@ -6149,6 +6184,12 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, remove = true; break; } + if (gimplify_expr (&OMP_CLAUSE_ALIGNED_ALIGNMENT (c), pre_p, NULL, + is_gimple_val, fb_rvalue) == GS_ERROR) + { + remove = true; + break; + } if (!is_global_var (decl) && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE) omp_add_variable (ctx, decl, GOVD_ALIGNED); @@ -6171,13 +6212,21 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, gimplify_omp_ctxp = ctx; } +struct gimplify_adjust_omp_clauses_data +{ + tree *list_p; + gimple_seq *pre_p; +}; + /* For all variables that were not actually used within the context, remove PRIVATE, SHARED, and FIRSTPRIVATE clauses. */ static int gimplify_adjust_omp_clauses_1 (splay_tree_node n, void *data) { - tree *list_p = (tree *) data; + tree *list_p = ((struct gimplify_adjust_omp_clauses_data *) data)->list_p; + gimple_seq *pre_p + = ((struct gimplify_adjust_omp_clauses_data *) data)->pre_p; tree decl = (tree) n->key; unsigned flags = n->value; enum omp_clause_code code; @@ -6270,6 +6319,8 @@ gimplify_adjust_omp_clauses_1 (splay_tree_node n, void *data) OMP_CLAUSE_CHAIN (nc) = OMP_CLAUSE_CHAIN (clause); OMP_CLAUSE_CHAIN (clause) = nc; } + else + OMP_CLAUSE_SIZE (clause) = DECL_SIZE_UNIT (decl); } if (code == OMP_CLAUSE_FIRSTPRIVATE && (flags & GOVD_LASTPRIVATE) != 0) { @@ -6278,15 +6329,21 @@ gimplify_adjust_omp_clauses_1 (splay_tree_node n, void *data) OMP_CLAUSE_LASTPRIVATE_FIRSTPRIVATE (nc) = 1; OMP_CLAUSE_CHAIN (nc) = *list_p; OMP_CLAUSE_CHAIN (clause) = nc; - lang_hooks.decls.omp_finish_clause (nc); + struct gimplify_omp_ctx *ctx = gimplify_omp_ctxp; + gimplify_omp_ctxp = ctx->outer_context; + lang_hooks.decls.omp_finish_clause (nc, pre_p); + gimplify_omp_ctxp = ctx; } *list_p = clause; - lang_hooks.decls.omp_finish_clause (clause); + struct gimplify_omp_ctx *ctx = gimplify_omp_ctxp; + gimplify_omp_ctxp = ctx->outer_context; + lang_hooks.decls.omp_finish_clause (clause, pre_p); + gimplify_omp_ctxp = ctx; return 0; } static void -gimplify_adjust_omp_clauses (tree *list_p) +gimplify_adjust_omp_clauses (gimple_seq *pre_p, tree *list_p) { struct gimplify_omp_ctx *ctx = gimplify_omp_ctxp; tree c, decl; @@ -6432,6 +6489,8 @@ gimplify_adjust_omp_clauses (tree *list_p) OMP_CLAUSE_CHAIN (c) = nc; c = nc; } + else if (OMP_CLAUSE_SIZE (c) == NULL_TREE) + OMP_CLAUSE_SIZE (c) = DECL_SIZE_UNIT (decl); break; case OMP_CLAUSE_TO: @@ -6456,6 +6515,8 @@ gimplify_adjust_omp_clauses (tree *list_p) OMP_CLAUSE_SIZE (c), true); } } + else if (OMP_CLAUSE_SIZE (c) == NULL_TREE) + OMP_CLAUSE_SIZE (c) = DECL_SIZE_UNIT (decl); break; case OMP_CLAUSE_REDUCTION: @@ -6491,7 +6552,10 @@ gimplify_adjust_omp_clauses (tree *list_p) } /* Add in any implicit data sharing. */ - splay_tree_foreach (ctx->variables, gimplify_adjust_omp_clauses_1, list_p); + struct gimplify_adjust_omp_clauses_data data; + data.list_p = list_p; + data.pre_p = pre_p; + splay_tree_foreach (ctx->variables, gimplify_adjust_omp_clauses_1, &data); gimplify_omp_ctxp = ctx->outer_context; delete_omp_context (ctx); @@ -6522,7 +6586,7 @@ gimplify_omp_parallel (tree *expr_p, gimple_seq *pre_p) else pop_gimplify_context (NULL); - gimplify_adjust_omp_clauses (&OMP_PARALLEL_CLAUSES (expr)); + gimplify_adjust_omp_clauses (pre_p, &OMP_PARALLEL_CLAUSES (expr)); g = gimple_build_omp_parallel (body, OMP_PARALLEL_CLAUSES (expr), @@ -6558,7 +6622,7 @@ gimplify_omp_task (tree *expr_p, gimple_seq *pre_p) else pop_gimplify_context (NULL); - gimplify_adjust_omp_clauses (&OMP_TASK_CLAUSES (expr)); + gimplify_adjust_omp_clauses (pre_p, &OMP_TASK_CLAUSES (expr)); g = gimple_build_omp_task (body, OMP_TASK_CLAUSES (expr), @@ -6803,8 +6867,8 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p) case POSTINCREMENT_EXPR: { tree decl = TREE_OPERAND (t, 0); - // c_omp_for_incr_canonicalize_ptr() should have been - // called to massage things appropriately. + /* c_omp_for_incr_canonicalize_ptr() should have been + called to massage things appropriately. */ gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl))); if (orig_for_stmt != for_stmt) @@ -6820,6 +6884,9 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p) case PREDECREMENT_EXPR: case POSTDECREMENT_EXPR: + /* c_omp_for_incr_canonicalize_ptr() should have been + called to massage things appropriately. */ + gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl))); if (orig_for_stmt != for_stmt) break; t = build_int_cst (TREE_TYPE (decl), -1); @@ -6860,12 +6927,16 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p) ret = MIN (ret, tret); if (c) { - OMP_CLAUSE_LINEAR_STEP (c) = TREE_OPERAND (t, 1); + tree step = TREE_OPERAND (t, 1); + tree stept = TREE_TYPE (decl); + if (POINTER_TYPE_P (stept)) + stept = sizetype; + step = fold_convert (stept, step); if (TREE_CODE (t) == MINUS_EXPR) + step = fold_build1 (NEGATE_EXPR, stept, step); + OMP_CLAUSE_LINEAR_STEP (c) = step; + if (step != TREE_OPERAND (t, 1)) { - t = TREE_OPERAND (t, 1); - OMP_CLAUSE_LINEAR_STEP (c) - = fold_build1 (NEGATE_EXPR, TREE_TYPE (t), t); tret = gimplify_expr (&OMP_CLAUSE_LINEAR_STEP (c), &for_pre_body, NULL, is_gimple_val, fb_rvalue); @@ -6932,7 +7003,7 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p) TREE_OPERAND (TREE_OPERAND (t, 1), 0) = var; } - gimplify_adjust_omp_clauses (&OMP_FOR_CLAUSES (orig_for_stmt)); + gimplify_adjust_omp_clauses (pre_p, &OMP_FOR_CLAUSES (orig_for_stmt)); int kind; switch (TREE_CODE (orig_for_stmt)) @@ -7032,7 +7103,7 @@ gimplify_omp_workshare (tree *expr_p, gimple_seq *pre_p) } else gimplify_and_add (OMP_BODY (expr), &body); - gimplify_adjust_omp_clauses (&OMP_CLAUSES (expr)); + gimplify_adjust_omp_clauses (pre_p, &OMP_CLAUSES (expr)); switch (TREE_CODE (expr)) { @@ -7071,7 +7142,7 @@ gimplify_omp_target_update (tree *expr_p, gimple_seq *pre_p) gimplify_scan_omp_clauses (&OMP_TARGET_UPDATE_CLAUSES (expr), pre_p, ORT_WORKSHARE); - gimplify_adjust_omp_clauses (&OMP_TARGET_UPDATE_CLAUSES (expr)); + gimplify_adjust_omp_clauses (pre_p, &OMP_TARGET_UPDATE_CLAUSES (expr)); stmt = gimple_build_omp_target (NULL, GF_OMP_TARGET_KIND_UPDATE, OMP_TARGET_UPDATE_CLAUSES (expr)); diff --git a/gcc/gimplify.h b/gcc/gimplify.h index 47e72130add..5085ccfe554 100644 --- a/gcc/gimplify.h +++ b/gcc/gimplify.h @@ -77,6 +77,7 @@ extern enum gimplify_status gimplify_expr (tree *, gimple_seq *, gimple_seq *, extern void gimplify_type_sizes (tree, gimple_seq *); extern void gimplify_one_sizepos (tree *, gimple_seq *); extern gimple gimplify_body (tree, bool); +extern enum gimplify_status gimplify_arg (tree *, gimple_seq *, location_t); extern void gimplify_function_tree (tree); extern enum gimplify_status gimplify_va_arg_expr (tree *, gimple_seq *, gimple_seq *); diff --git a/gcc/go/gofrontend/lex.cc b/gcc/go/gofrontend/lex.cc index 16169634733..3404cedb5f6 100644 --- a/gcc/go/gofrontend/lex.cc +++ b/gcc/go/gofrontend/lex.cc @@ -598,7 +598,7 @@ Lex::next_token() } else if (p[1] == '*') { - this->lineoff_ = p - this->linebuf_; + this->lineoff_ = p + 2 - this->linebuf_; Location location = this->location(); if (!this->skip_c_comment()) return Token::make_invalid_token(location); diff --git a/gcc/ipa-cp.c b/gcc/ipa-cp.c index 93b60d62b35..52d37fb3bdf 100644 --- a/gcc/ipa-cp.c +++ b/gcc/ipa-cp.c @@ -1589,15 +1589,7 @@ ipa_get_indirect_edge_target_1 (struct cgraph_edge *ie, && DECL_FUNCTION_CODE (target) == BUILT_IN_UNREACHABLE) || !possible_polymorphic_call_target_p (ie, cgraph_get_node (target))) - { - if (dump_file) - fprintf (dump_file, - "Type inconsident devirtualization: %s/%i->%s\n", - ie->caller->name (), ie->caller->order, - IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (target))); - target = builtin_decl_implicit (BUILT_IN_UNREACHABLE); - cgraph_get_create_node (target); - } + target = ipa_impossible_devirt_target (ie, target); return target; } } @@ -1631,7 +1623,7 @@ ipa_get_indirect_edge_target_1 (struct cgraph_edge *ie, if (targets.length () == 1) target = targets[0]->decl; else - target = builtin_decl_implicit (BUILT_IN_UNREACHABLE); + target = ipa_impossible_devirt_target (ie, NULL_TREE); } else { @@ -1645,15 +1637,7 @@ ipa_get_indirect_edge_target_1 (struct cgraph_edge *ie, if (target && !possible_polymorphic_call_target_p (ie, cgraph_get_node (target))) - { - if (dump_file) - fprintf (dump_file, - "Type inconsident devirtualization: %s/%i->%s\n", - ie->caller->name (), ie->caller->order, - IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (target))); - target = builtin_decl_implicit (BUILT_IN_UNREACHABLE); - cgraph_get_create_node (target); - } + target = ipa_impossible_devirt_target (ie, target); return target; } diff --git a/gcc/ipa-prop.c b/gcc/ipa-prop.c index a8ec291ce87..c3890f74bfb 100644 --- a/gcc/ipa-prop.c +++ b/gcc/ipa-prop.c @@ -2704,14 +2704,14 @@ try_make_edge_direct_simple_call (struct cgraph_edge *ie, /* Return the target to be used in cases of impossible devirtualization. IE and target (the latter can be NULL) are dumped when dumping is enabled. */ -static tree -impossible_devirt_target (struct cgraph_edge *ie, tree target) +tree +ipa_impossible_devirt_target (struct cgraph_edge *ie, tree target) { if (dump_file) { if (target) fprintf (dump_file, - "Type inconsident devirtualization: %s/%i->%s\n", + "Type inconsistent devirtualization: %s/%i->%s\n", ie->caller->name (), ie->caller->order, IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (target))); else @@ -2758,7 +2758,7 @@ try_make_edge_direct_virtual_call (struct cgraph_edge *ie, && DECL_FUNCTION_CODE (target) == BUILT_IN_UNREACHABLE) || !possible_polymorphic_call_target_p (ie, cgraph_get_node (target))) - target = impossible_devirt_target (ie, target); + target = ipa_impossible_devirt_target (ie, target); return ipa_make_edge_direct_to_target (ie, target); } } @@ -2788,7 +2788,7 @@ try_make_edge_direct_virtual_call (struct cgraph_edge *ie, if (targets.length () == 1) target = targets[0]->decl; else - target = impossible_devirt_target (ie, NULL_TREE); + target = ipa_impossible_devirt_target (ie, NULL_TREE); } else { @@ -2804,7 +2804,7 @@ try_make_edge_direct_virtual_call (struct cgraph_edge *ie, if (target) { if (!possible_polymorphic_call_target_p (ie, cgraph_get_node (target))) - target = impossible_devirt_target (ie, target); + target = ipa_impossible_devirt_target (ie, target); return ipa_make_edge_direct_to_target (ie, target); } else diff --git a/gcc/ipa-prop.h b/gcc/ipa-prop.h index 8fdd92c14ef..70185b2f4ac 100644 --- a/gcc/ipa-prop.h +++ b/gcc/ipa-prop.h @@ -585,6 +585,7 @@ tree ipa_get_indirect_edge_target (struct cgraph_edge *ie, struct cgraph_edge *ipa_make_edge_direct_to_target (struct cgraph_edge *, tree); tree ipa_binfo_from_known_type_jfunc (struct ipa_jump_func *); tree ipa_intraprocedural_devirtualization (gimple); +tree ipa_impossible_devirt_target (struct cgraph_edge *, tree); /* Functions related to both. */ void ipa_analyze_node (struct cgraph_node *); diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h index 95bd3793329..20cb12acf08 100644 --- a/gcc/langhooks-def.h +++ b/gcc/langhooks-def.h @@ -74,6 +74,7 @@ extern bool lhd_handle_option (size_t, const char *, int, int, location_t, extern int lhd_gimplify_expr (tree *, gimple_seq *, gimple_seq *); extern enum omp_clause_default_kind lhd_omp_predetermined_sharing (tree); extern tree lhd_omp_assignment (tree, tree, tree); +extern void lhd_omp_finish_clause (tree, gimple_seq *); struct gimplify_omp_ctx; extern void lhd_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree); @@ -211,8 +212,9 @@ extern tree lhd_make_node (enum tree_code); #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR hook_tree_tree_tree_tree_null #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR lhd_omp_assignment #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP lhd_omp_assignment +#define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR NULL #define LANG_HOOKS_OMP_CLAUSE_DTOR hook_tree_tree_tree_null -#define LANG_HOOKS_OMP_FINISH_CLAUSE hook_void_tree +#define LANG_HOOKS_OMP_FINISH_CLAUSE lhd_omp_finish_clause #define LANG_HOOKS_DECLS { \ LANG_HOOKS_GLOBAL_BINDINGS_P, \ @@ -234,6 +236,7 @@ extern tree lhd_make_node (enum tree_code); LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR, \ LANG_HOOKS_OMP_CLAUSE_COPY_CTOR, \ LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP, \ + LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR, \ LANG_HOOKS_OMP_CLAUSE_DTOR, \ LANG_HOOKS_OMP_FINISH_CLAUSE \ } diff --git a/gcc/langhooks.c b/gcc/langhooks.c index d00ebd8a08c..307af4467f6 100644 --- a/gcc/langhooks.c +++ b/gcc/langhooks.c @@ -515,6 +515,13 @@ lhd_omp_assignment (tree clause ATTRIBUTE_UNUSED, tree dst, tree src) return build2 (MODIFY_EXPR, TREE_TYPE (dst), dst, src); } +/* Finalize clause C. */ + +void +lhd_omp_finish_clause (tree, gimple_seq *) +{ +} + /* Register language specific type size variables as potentially OpenMP firstprivate variables. */ diff --git a/gcc/langhooks.h b/gcc/langhooks.h index c848b0c5911..b5997ee2fe3 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -219,12 +219,16 @@ struct lang_hooks_for_decls /* Similarly, except use an assignment operator instead. */ tree (*omp_clause_assign_op) (tree clause, tree dst, tree src); + /* Build and return code for a constructor of DST that sets it to + SRC + ADD. */ + tree (*omp_clause_linear_ctor) (tree clause, tree dst, tree src, tree add); + /* Build and return code destructing DECL. Return NULL if nothing to be done. */ tree (*omp_clause_dtor) (tree clause, tree decl); /* Do language specific checking on an implicitly determined clause. */ - void (*omp_finish_clause) (tree clause); + void (*omp_finish_clause) (tree clause, gimple_seq *pre_p); }; /* Language hooks related to LTO serialization. */ diff --git a/gcc/omp-low.c b/gcc/omp-low.c index 580a8ba94ad..a605c45f016 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -1678,6 +1678,11 @@ scan_sharing_clauses (tree clauses, omp_context *ctx) } else { + if (ctx->outer) + { + scan_omp_op (&OMP_CLAUSE_DECL (c), ctx->outer); + decl = OMP_CLAUSE_DECL (c); + } gcc_assert (!splay_tree_lookup (ctx->field_map, (splay_tree_key) decl)); tree field @@ -2011,6 +2016,7 @@ scan_omp_parallel (gimple_stmt_iterator *gsi, omp_context *outer_ctx) tree temp = create_tmp_var (type, NULL); tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE__LOOPTEMP_); + insert_decl_map (&outer_ctx->cb, temp, temp); OMP_CLAUSE_DECL (c) = temp; OMP_CLAUSE_CHAIN (c) = gimple_omp_parallel_clauses (stmt); gimple_omp_parallel_set_clauses (stmt, c); @@ -2508,6 +2514,23 @@ check_omp_nesting_restrictions (gimple stmt, omp_context *ctx) return false; } break; + case GIMPLE_OMP_TARGET: + for (; ctx != NULL; ctx = ctx->outer) + if (gimple_code (ctx->stmt) == GIMPLE_OMP_TARGET + && gimple_omp_target_kind (ctx->stmt) == GF_OMP_TARGET_KIND_REGION) + { + const char *name; + switch (gimple_omp_target_kind (stmt)) + { + case GF_OMP_TARGET_KIND_REGION: name = "target"; break; + case GF_OMP_TARGET_KIND_DATA: name = "target data"; break; + case GF_OMP_TARGET_KIND_UPDATE: name = "target update"; break; + default: gcc_unreachable (); + } + warning_at (gimple_location (stmt), 0, + "%s construct inside of target region", name); + } + break; default: break; } @@ -2975,8 +2998,10 @@ lower_rec_simd_input_clauses (tree new_var, omp_context *ctx, int &max_vf, { tree c = find_omp_clause (gimple_omp_for_clauses (ctx->stmt), OMP_CLAUSE_SAFELEN); - if (c - && compare_tree_int (OMP_CLAUSE_SAFELEN_EXPR (c), max_vf) == -1) + if (c && TREE_CODE (OMP_CLAUSE_SAFELEN_EXPR (c)) != INTEGER_CST) + max_vf = 1; + else if (c && compare_tree_int (OMP_CLAUSE_SAFELEN_EXPR (c), + max_vf) == -1) max_vf = tree_to_shwi (OMP_CLAUSE_SAFELEN_EXPR (c)); } if (max_vf > 1) @@ -3060,11 +3085,14 @@ lower_rec_input_clauses (tree clauses, gimple_seq *ilist, gimple_seq *dlist, for (c = clauses; c ; c = OMP_CLAUSE_CHAIN (c)) switch (OMP_CLAUSE_CODE (c)) { + case OMP_CLAUSE_LINEAR: + if (OMP_CLAUSE_LINEAR_ARRAY (c)) + max_vf = 1; + /* FALLTHRU */ case OMP_CLAUSE_REDUCTION: case OMP_CLAUSE_PRIVATE: case OMP_CLAUSE_FIRSTPRIVATE: case OMP_CLAUSE_LASTPRIVATE: - case OMP_CLAUSE_LINEAR: if (is_variable_sized (OMP_CLAUSE_DECL (c))) max_vf = 1; break; @@ -3120,6 +3148,13 @@ lower_rec_input_clauses (tree clauses, gimple_seq *ilist, gimple_seq *dlist, if (pass != 0) continue; } + /* Even without corresponding firstprivate, if + decl is Fortran allocatable, it needs outer var + reference. */ + else if (pass == 0 + && lang_hooks.decls.omp_private_outer_ref + (OMP_CLAUSE_DECL (c))) + lastprivate_firstprivate = true; break; case OMP_CLAUSE_ALIGNED: if (pass == 0) @@ -3383,14 +3418,12 @@ lower_rec_input_clauses (tree clauses, gimple_seq *ilist, gimple_seq *dlist, if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR && gimple_omp_for_combined_into_p (ctx->stmt)) { - tree stept = POINTER_TYPE_P (TREE_TYPE (x)) - ? sizetype : TREE_TYPE (x); - tree t = fold_convert (stept, - OMP_CLAUSE_LINEAR_STEP (c)); - tree c = find_omp_clause (clauses, - OMP_CLAUSE__LOOPTEMP_); - gcc_assert (c); - tree l = OMP_CLAUSE_DECL (c); + tree t = OMP_CLAUSE_LINEAR_STEP (c); + tree stept = TREE_TYPE (t); + tree ct = find_omp_clause (clauses, + OMP_CLAUSE__LOOPTEMP_); + gcc_assert (ct); + tree l = OMP_CLAUSE_DECL (ct); tree n1 = fd->loop.n1; tree step = fd->loop.step; tree itype = TREE_TYPE (l); @@ -3407,6 +3440,15 @@ lower_rec_input_clauses (tree clauses, gimple_seq *ilist, gimple_seq *dlist, l = fold_build2 (TRUNC_DIV_EXPR, itype, l, step); t = fold_build2 (MULT_EXPR, stept, fold_convert (stept, l), t); + + if (OMP_CLAUSE_LINEAR_ARRAY (c)) + { + x = lang_hooks.decls.omp_clause_linear_ctor + (c, new_var, x, t); + gimplify_and_add (x, ilist); + goto do_dtor; + } + if (POINTER_TYPE_P (TREE_TYPE (x))) x = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (x), x, t); @@ -3430,10 +3472,7 @@ lower_rec_input_clauses (tree clauses, gimple_seq *ilist, gimple_seq *dlist, = gimple_build_assign (unshare_expr (lvar), iv); gsi_insert_before_without_update (&gsi, g, GSI_SAME_STMT); - tree stept = POINTER_TYPE_P (TREE_TYPE (x)) - ? sizetype : TREE_TYPE (x); - tree t = fold_convert (stept, - OMP_CLAUSE_LINEAR_STEP (c)); + tree t = OMP_CLAUSE_LINEAR_STEP (c); enum tree_code code = PLUS_EXPR; if (POINTER_TYPE_P (TREE_TYPE (new_var))) code = POINTER_PLUS_EXPR; @@ -3551,7 +3590,8 @@ lower_rec_input_clauses (tree clauses, gimple_seq *ilist, gimple_seq *dlist, else if (is_reference (var) && is_simd) handle_simd_reference (clause_loc, new_vard, ilist); x = lang_hooks.decls.omp_clause_default_ctor - (c, new_var, unshare_expr (x)); + (c, unshare_expr (new_var), + build_outer_var_ref (var, ctx)); if (x) gimplify_and_add (x, ilist); if (OMP_CLAUSE_REDUCTION_GIMPLE_INIT (c)) @@ -3712,8 +3752,9 @@ lower_rec_input_clauses (tree clauses, gimple_seq *ilist, gimple_seq *dlist, tree c = find_omp_clause (gimple_omp_for_clauses (ctx->stmt), OMP_CLAUSE_SAFELEN); if (c == NULL_TREE - || compare_tree_int (OMP_CLAUSE_SAFELEN_EXPR (c), - max_vf) == 1) + || (TREE_CODE (OMP_CLAUSE_SAFELEN_EXPR (c)) == INTEGER_CST + && compare_tree_int (OMP_CLAUSE_SAFELEN_EXPR (c), + max_vf) == 1)) { c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_SAFELEN); OMP_CLAUSE_SAFELEN_EXPR (c) = build_int_cst (integer_type_node, @@ -6877,8 +6918,10 @@ expand_omp_simd (struct omp_region *region, struct omp_for_data *fd) else { safelen = OMP_CLAUSE_SAFELEN_EXPR (safelen); - if (!tree_fits_uhwi_p (safelen) - || tree_to_uhwi (safelen) > INT_MAX) + if (TREE_CODE (safelen) != INTEGER_CST) + loop->safelen = 0; + else if (!tree_fits_uhwi_p (safelen) + || tree_to_uhwi (safelen) > INT_MAX) loop->safelen = INT_MAX; else loop->safelen = tree_to_uhwi (safelen); @@ -8444,10 +8487,14 @@ maybe_add_implicit_barrier_cancel (omp_context *ctx, gimple_seq *body) && gimple_code (ctx->outer->stmt) == GIMPLE_OMP_PARALLEL && ctx->outer->cancellable) { - tree lhs = create_tmp_var (boolean_type_node, NULL); + tree fndecl = builtin_decl_explicit (BUILT_IN_GOMP_CANCEL); + tree c_bool_type = TREE_TYPE (TREE_TYPE (fndecl)); + tree lhs = create_tmp_var (c_bool_type, NULL); gimple_omp_return_set_lhs (omp_return, lhs); tree fallthru_label = create_artificial_label (UNKNOWN_LOCATION); - gimple g = gimple_build_cond (NE_EXPR, lhs, boolean_false_node, + gimple g = gimple_build_cond (NE_EXPR, lhs, + fold_convert (c_bool_type, + boolean_false_node), ctx->outer->cancel_label, fallthru_label); gimple_seq_add_stmt (body, g); gimple_seq_add_stmt (body, gimple_build_label (fallthru_label)); @@ -9044,7 +9091,10 @@ lower_omp_for (gimple_stmt_iterator *gsi_p, omp_context *ctx) OMP_CLAUSE__LOOPTEMP_); } else - temp = create_tmp_var (type, NULL); + { + temp = create_tmp_var (type, NULL); + insert_decl_map (&ctx->outer->cb, temp, temp); + } *pc = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE__LOOPTEMP_); OMP_CLAUSE_DECL (*pc) = temp; pc = &OMP_CLAUSE_CHAIN (*pc); @@ -10153,21 +10203,23 @@ lower_omp_1 (gimple_stmt_iterator *gsi_p, omp_context *ctx) } break; } - tree lhs; - lhs = create_tmp_var (boolean_type_node, NULL); if (DECL_FUNCTION_CODE (fndecl) == BUILT_IN_GOMP_BARRIER) { fndecl = builtin_decl_explicit (BUILT_IN_GOMP_BARRIER_CANCEL); gimple_call_set_fndecl (stmt, fndecl); gimple_call_set_fntype (stmt, TREE_TYPE (fndecl)); } + tree lhs; + lhs = create_tmp_var (TREE_TYPE (TREE_TYPE (fndecl)), NULL); gimple_call_set_lhs (stmt, lhs); tree fallthru_label; fallthru_label = create_artificial_label (UNKNOWN_LOCATION); gimple g; g = gimple_build_label (fallthru_label); gsi_insert_after (gsi_p, g, GSI_SAME_STMT); - g = gimple_build_cond (NE_EXPR, lhs, boolean_false_node, + g = gimple_build_cond (NE_EXPR, lhs, + fold_convert (TREE_TYPE (lhs), + boolean_false_node), cctx->cancel_label, fallthru_label); gsi_insert_after (gsi_p, g, GSI_SAME_STMT); break; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 694e4a21d9a..0e5d7474de5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,314 @@ +2014-07-09 Edward Smith-Rowland <3dw4rd@verizon.net> + + PR c++/58155 - -Wliteral-suffix warns about tokens which are skipped + g++.dg/cpp0x/pr58155.C: New. + +2014-07-09 Alan Lawrence <alan.lawrence@arm.com> + + Backport r211369 from trunk. + 2014-06-09 Alan Lawrence <alan.lawrence@arm.com> + + PR target/61062 + * gcc.target/arm/pr48252.c (main): Expect same result as endian-neutral. + +2014-07-08 Jakub Jelinek <jakub@redhat.com> + + PR rtl-optimization/61673 + * gcc.c-torture/execute/pr61673.c: New test. + +2014-07-08 Richard Biener <rguenther@suse.de> + + PR tree-optimization/61680 + * gcc.dg/vect/pr61680.c: New testcase. + + PR tree-optimization/61681 + * gcc.dg/torture/pr61681.c: New testcase. + +2014-07-08 Alan Lawrence <alan.lawrence@arm.com> + + Backport r211502 from mainline. + 2014-06-10 Alan Lawrence <alan.lawrence@arm.com> + + PR target/59843 + * gcc.dg/vect/vect-singleton_1.c: New file. + +2014-07-08 Jakub Jelinek <jakub@redhat.com> + + PR tree-optimization/61725 + * gcc.dg/tree-ssa/vrp93.c: New test. + * gcc.c-torture/execute/pr61725.c: New test. + +2014-07-07 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/61459 + PR fortran/58883 + * gfortran.dg/allocatable_function_8.f90 : New test + +2014-07-07 Dominique d'Humieres <dominiq@lps.ens.fr> + Mikael Morin <mikael@gcc.gnu.org> + + PR fortran/41936 + * gfortran.dg/class_array_15.f03: Check memory leaks. + +2014-07-06 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + Backport from mainline. + PR libgfortran/61640 + * gfortran.dg/arrayio_16.f90: New test. + +2014-07-04 Jakub Jelinek <jakub@redhat.com> + + PR middle-end/61654 + * g++.dg/opt/pr61654.C: New test. + + PR tree-optimization/61684 + * gcc.c-torture/compile/pr61684.c: New test. + + PR c++/61382 + Backport from mainline + 2014-06-05 Andreas Schwab <schwab@suse.de> + + * g++.dg/cpp0x/initlist86.C (main): Initialize i. + +2014-07-02 Jakub Jelinek <jakub@redhat.com> + Fritz Reese <Reese-Fritz@zai.com> + + * gfortran.dg/oldstyle_5.f: New test. + +2014-07-01 Paul Pluzhnikov <ppluzhnikov@google.com> + + PR c++/58753 + PR c++/58930 + PR c++/58704 + + Backported from mainline + 2014-05-20 Paolo Carlini <paolo.carlini@oracle.com> + + * g++.dg/cpp0x/nsdmi-template11.C: New. + * g++.dg/cpp0x/nsdmi-template12.C: Likewise. + * g++.dg/cpp0x/nsdmi-template13.C: Likewise. + +2014-06-28 Edward Smith-Rowland <3dw4rd@verizon.net> + + PR c++/58781 + PR c++/60249 + PR c++/59867 + * testsuite/g++.dg/cpp0x/pr58781.C: New. + * testsuite/g++.dg/cpp0x/pr60249.C: New. + * testsuite/g++.dg/cpp1y/pr59867.C: New. + +2014-06-30 Bill Schmidt <wschmidt@linux.vnet.ibm.com> + + * gfortran.dg/round_4.f90: Skip for powerpc*-*-linux* since the + test requires greater precision than the current PowerPC long + double implementation supports. + +2014-06-30 Jakub Jelinek <jakub@redhat.com> + + Backported from mainline + 2014-06-27 Jakub Jelinek <jakub@redhat.com> + + PR tree-optimization/57233 + PR tree-optimization/61299 + * gcc.dg/pr57233.c: New test. + * gcc.target/i386/pr57233.c: New test. + * gcc.target/i386/sse2-pr57233.c: New test. + * gcc.target/i386/avx-pr57233.c: New test. + * gcc.target/i386/avx2-pr57233.c: New test. + * gcc.target/i386/avx512f-pr57233.c: New test. + * gcc.target/i386/xop-pr57233.c: New test. + + 2014-06-24 Jakub Jelinek <jakub@redhat.com> + + * gfortran.dg/gomp/udr2.f90 (f7, f9): Add !$omp parallel with + reduction clause. + * gfortran.dg/gomp/udr4.f90 (f4): Likewise. + Remove Label is never defined expected error. + * gfortran.dg/gomp/udr8.f90: New test. + + 2014-06-18 Jakub Jelinek <jakub@redhat.com> + + * gfortran.dg/gomp/declare-simd-1.f90: New test. + * gfortran.dg/gomp/depend-1.f90: New test. + * gfortran.dg/gomp/target1.f90: New test. + * gfortran.dg/gomp/target2.f90: New test. + * gfortran.dg/gomp/target3.f90: New test. + * gfortran.dg/gomp/udr4.f90: Adjust expected diagnostics. + * gfortran.dg/openmp-define-3.f90: Expect _OPENMP 201307 instead of + 201107. + + 2014-06-10 Jakub Jelinek <jakub@redhat.com> + + PR fortran/60928 + * gfortran.dg/gomp/allocatable_components_1.f90: Remove dg-error + directives. + * gfortran.dg/gomp/associate1.f90: New test. + * gfortran.dg/gomp/intentin1.f90: New test. + * gfortran.dg/gomp/openmp-simd-1.f90: New test. + * gfortran.dg/gomp/openmp-simd-2.f90: New test. + * gfortran.dg/gomp/openmp-simd-3.f90: New test. + * gfortran.dg/gomp/proc_ptr_2.f90: New test. + + 2014-06-09 Jakub Jelinek <jakub@redhat.com> + + * gfortran.dg/gomp/udr6.f90 (f1, f2, f3): Use complex(kind=8) + instead of complex(kind=16). + + 2014-06-06 Jakub Jelinek <jakub@redhat.com> + + * gfortran.dg/gomp/allocatable_components_1.f90: Adjust for + reduction clause diagnostic changes. + * gfortran.dg/gomp/appendix-a/a.31.3.f90: Likewise. + * gfortran.dg/gomp/reduction1.f90: Likewise. + * gfortran.dg/gomp/reduction3.f90: Likewise. + * gfortran.dg/gomp/udr1.f90: New test. + * gfortran.dg/gomp/udr2.f90: New test. + * gfortran.dg/gomp/udr3.f90: New test. + * gfortran.dg/gomp/udr4.f90: New test. + * gfortran.dg/gomp/udr5.f90: New test. + * gfortran.dg/gomp/udr6.f90: New test. + * gfortran.dg/gomp/udr7.f90: New test. + + 2014-05-12 Tobias Burnus <burnus@net-b.de> + + PR fortran/60127 + * gfortran.dg/gomp/omp_do_concurrent.f90: New. + + 2014-05-11 Jakub Jelinek <jakub@redhat.com> + + * gfortran.dg/gomp/affinity-1.f90: New test. + +2014-06-30 Sebastian Huber <sebastian.huber@embedded-brains.de> + + * gcc.dg/typeof-2.c: New testcase. + +2014-06-30 Kyrylo Tkachov <kyrylo.tkachov@arm.com> + + * gcc.target/aarch64/vqdmulhh_lane_s16.c: New test. + * gcc.target/aarch64/vqdmulhs_lane_s32.c: Likewise. + * gcc.target/aarch64/vqrdmulhh_lane_s16.c: Likewise. + * gcc.target/aarch64/vqrdmulhs_lane_s32.c: Likewise. + * gcc.target/aarch64/vqdmlal_high_lane_s16.c: New test. + * gcc.target/aarch64/vqdmlal_high_lane_s32.c: Likewise. + * gcc.target/aarch64/vqdmlal_high_laneq_s16.c: Likewise. + * gcc.target/aarch64/vqdmlal_high_laneq_s32.c: Likewise. + * gcc.target/aarch64/vqdmlal_lane_s16.c: Likewise. + * gcc.target/aarch64/vqdmlal_lane_s32.c: Likewise. + * gcc.target/aarch64/vqdmlal_laneq_s16.c: Likewise. + * gcc.target/aarch64/vqdmlal_laneq_s32.c: Likewise. + * gcc.target/aarch64/vqdmlalh_lane_s16.c: Likewise. + * gcc.target/aarch64/vqdmlals_lane_s32.c: Likewise. + * gcc.target/aarch64/vqdmlsl_high_lane_s16.c: Likewise. + * gcc.target/aarch64/vqdmlsl_high_lane_s32.c: Likewise. + * gcc.target/aarch64/vqdmlsl_high_laneq_s16.c: Likewise. + * gcc.target/aarch64/vqdmlsl_high_laneq_s32.c: Likewise. + * gcc.target/aarch64/vqdmlsl_lane_s16.c: Likewise. + * gcc.target/aarch64/vqdmlsl_lane_s32.c: Likewise. + * gcc.target/aarch64/vqdmlsl_laneq_s32.c: Likewise. + * gcc.target/aarch64/vqdmlslh_lane_s16.c: Likewise. + * gcc.target/aarch64/vqdmlsls_lane_s32.c: Likewise. + * gcc.target/aarch64/vqdmulh_laneq_s16.c: Likewise. + * gcc.target/aarch64/vqdmulh_laneq_s32.c: Likewise. + * gcc.target/aarch64/vqdmulhq_laneq_s16.c: Likewise. + * gcc.target/aarch64/vqdmulhq_laneq_s32.c: Likewise. + * gcc.target/aarch64/vqdmull_high_lane_s16.c: Likewise. + * gcc.target/aarch64/vqdmull_high_lane_s32.c: Likewise. + * gcc.target/aarch64/vqdmull_high_laneq_s16.c: Likewise. + * gcc.target/aarch64/vqdmull_high_laneq_s32.c: Likewise. + * gcc.target/aarch64/vqdmull_lane_s16.c: Likewise. + * gcc.target/aarch64/vqdmull_lane_s32.c: Likewise. + * gcc.target/aarch64/vqdmull_laneq_s16.c: Likewise. + * gcc.target/aarch64/vqdmull_laneq_s32.c: Likewise. + * gcc.target/aarch64/vqdmullh_lane_s16.c: Likewise. + * gcc.target/aarch64/vqdmulls_lane_s32.c: Likewise. + * gcc.target/aarch64/vqrdmulh_laneq_s16.c: Likewise. + * gcc.target/aarch64/vqrdmulh_laneq_s32.c: Likewise. + * gcc.target/aarch64/vqrdmulhq_laneq_s16.c: Likewise. + * gcc.target/aarch64/vqrdmulhq_laneq_s32.c: Likewise. + * gcc.target/aarch64/vector_intrinsics.c: Simplify arm_neon.h include. + (test_vqdmlal_high_lane_s16): Fix parameter type. + (test_vqdmlal_high_lane_s32): Likewise. + (test_vqdmull_high_lane_s16): Likewise. + (test_vqdmull_high_lane_s32): Likewise. + (test_vqdmlsl_high_lane_s32): Likewise. + (test_vqdmlsl_high_lane_s16): Likewise. + * gcc.target/aarch64/scalar_intrinsics.c (test_vqdmlalh_lane_s16): + Fix argument type. + (test_vqdmlals_lane_s32): Likewise. + (test_vqdmlslh_lane_s16): Likewise. + (test_vqdmlsls_lane_s32): Likewise. + (test_vqdmulhh_lane_s16): Likewise. + (test_vqdmulhs_lane_s32): Likewise. + (test_vqdmullh_lane_s16): Likewise. + (test_vqdmulls_lane_s32): Likewise. + (test_vqrdmulhh_lane_s16): Likewise. + (test_vqrdmulhs_lane_s32): Likewise. + +2014-06-30 Igor Zamyatin <igor.zamyatin@intel.com> + + PR middle-end/57541 + * c-c++-common/cilk-plus/AN/pr57541.c: New case added. + * c-c++-common/cilk-plus/AN/pr57541-2.c: New test. + +2014-06-30 Thomas Preud'homme <thomas.preudhomme@arm.com> + + Backport from mainline + 2014-06-11 Thomas Preud'homme <thomas.preudhomme@arm.com> + + PR tree-optimization/61306 + * gcc.c-torture/execute/pr61306-1.c: New test. + * gcc.c-torture/execute/pr61306-2.c: Likewise. + * gcc.c-torture/execute/pr61306-3.c: Likewise. + +2014-06-27 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + Backport from mainline. + PR libgfortran/61499 + * gfortran.dg/arrayio_15.f90: New test. + +2014-06-27 Bill Schmidt <wschmidt@linux.vnet.ibm.com> + + * gfortran.dg/nint_2.f90: Don't XFAIL for powerpc64le-*-linux*. + +2014-06-27 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/61614 + * g++.dg/ext/complit14.C: New. + +2014-06-27 Martin Jambor <mjambor@suse.cz> + + PR ipa/61160 + * g++.dg/ipa/pr61160-2.C: New test. + * g++.dg/ipa/pr61160-3.C: Likewise. + +2014-06-27 Uros Bizjak <ubizjak@gmail.com> + + Backport from mainline + 2014-06-26 Uros Bizjak <ubizjak@gmail.com> + + PR target/61586 + * gcc.target/alpha/pr61586.c: New test. + +2014-06-26 Adam Butcher <adam@jessamine.co.uk> + + PR c++/61537 + * g++.dg/template/pr61537.C: New testcase. + +2014-06-26 Martin Jambor <mjambor@suse.cz> + + * g++.dg/ipa/pr60600.C: Fix typo. + * g++.dg/ipa/devirt-25.C: Likewise. + * g++.dg/ipa/pr61540.C: Likewise. + +2014-06-26 Martin Jambor <mjambor@suse.cz> + + * g++.dg/ipa/pr61540.C: Remove dumping test. + +2014-06-25 Bill Schmidt <wschmidt@linux.vnet.ibm.com> + + * gfortran.dg/default_format_denormal_2.f90: Remove xfail for + powerpc*-*-linux*. + 2014-06-23 Alan Modra <amodra@gmail.com> * gcc.dg/pr61583.c: New. @@ -5,7 +316,7 @@ 2014-06-20 Martin Jambor <mjambor@suse.cz> PR ipa/61540 - * g++.dg/ipa/pr61540.C: New test. + * g++.dg/ipa/pr61540.C: New test. 2014-06-17 Yufeng Zhang <yufeng.zhang@arm.com> diff --git a/gcc/testsuite/c-c++-common/cilk-plus/AN/pr57541-2.c b/gcc/testsuite/c-c++-common/cilk-plus/AN/pr57541-2.c new file mode 100644 index 00000000000..83325a77501 --- /dev/null +++ b/gcc/testsuite/c-c++-common/cilk-plus/AN/pr57541-2.c @@ -0,0 +1,15 @@ +/* PR middle-end/57541 */ +/* { dg-do compile } */ +/* { dg-options "-fcilkplus" } */ + +int foo1 () +{ + int a; + a = __sec_reduce_add (1); /* { dg-error "Invalid builtin arguments" } */ +} + +int foo2 () +{ + int a; + a = __sec_reduce_add (); /* { dg-error "Invalid builtin arguments" } */ +} diff --git a/gcc/testsuite/c-c++-common/cilk-plus/AN/pr57541.c b/gcc/testsuite/c-c++-common/cilk-plus/AN/pr57541.c index 9bff07991a9..f379e461c5a 100755 --- a/gcc/testsuite/c-c++-common/cilk-plus/AN/pr57541.c +++ b/gcc/testsuite/c-c++-common/cilk-plus/AN/pr57541.c @@ -1,9 +1,10 @@ +/* PR middle-end/57541 */ /* { dg-do compile } */ /* { dg-options "-fcilkplus" } */ int A[10]; -int main () { +int foo () { /* C compiler uses the term "undeclared" whereas C++ compiler uses "not declared". Thus, grepping for declared seem to be the easiest. */ @@ -13,5 +14,13 @@ int main () { A[l:s:c]; } -/* { dg-message "note: each" "defined" { target c } 10 } */ +int foo1 (int N) { + + char c = (char)N; + short s = (short)N; + A[l:s:c]; /* { dg-error "declared" } */ +} + + +/* { dg-message "note: each" "defined" { target c } 11 } */ diff --git a/gcc/testsuite/g++.dg/cpp0x/initlist84.C b/gcc/testsuite/g++.dg/cpp0x/initlist84.C new file mode 100644 index 00000000000..4d46746c52f --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/initlist84.C @@ -0,0 +1,17 @@ +// PR c++/61242 +// { dg-do compile { target c++11 } } + +struct Foo +{ + struct A + { + const int &container; + const int &args; + }; + static void Create (const A &); +}; + +int main () +{ + Foo::Create ({{}, {}}); +} diff --git a/gcc/testsuite/g++.dg/cpp0x/initlist86.C b/gcc/testsuite/g++.dg/cpp0x/initlist86.C new file mode 100644 index 00000000000..ace2ef92871 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/initlist86.C @@ -0,0 +1,18 @@ +// PR c++/61382 +// { dg-do run { target c++11 } } + +struct A +{ + int i,j; + A(int i,int j):i(i),j(j){} +}; + +extern "C" int printf (const char *, ...); + +int main() +{ + int i = 0; + A a{i++,i++}; + if (a.i != 0 || a.j != 1) + __builtin_abort(); +} diff --git a/gcc/testsuite/g++.dg/cpp0x/lambda/lambda-template13.C b/gcc/testsuite/g++.dg/cpp0x/lambda/lambda-template13.C new file mode 100644 index 00000000000..adbb4dbcaac --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/lambda/lambda-template13.C @@ -0,0 +1,20 @@ +// PR c++/61566 +// { dg-do compile { target c++11 } } + +struct function +{ + template < typename _Functor> + function (_Functor); +}; + +struct C +{ + template <typename T> + void foo (T, function = [] {}); +}; + +void bar () +{ + C c; + c.foo (1); +} diff --git a/gcc/testsuite/g++.dg/cpp0x/nsdmi-template11.C b/gcc/testsuite/g++.dg/cpp0x/nsdmi-template11.C new file mode 100644 index 00000000000..60e53c4190a --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/nsdmi-template11.C @@ -0,0 +1,15 @@ +// PR c++/58930 +// { dg-do compile { target c++11 } } + +struct SampleModule +{ + explicit SampleModule (int); +}; + +template < typename > +struct BaseHandler +{ + SampleModule module_ { 0 }; +}; + +BaseHandler<int> a; diff --git a/gcc/testsuite/g++.dg/cpp0x/nsdmi-template12.C b/gcc/testsuite/g++.dg/cpp0x/nsdmi-template12.C new file mode 100644 index 00000000000..52ae257200f --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/nsdmi-template12.C @@ -0,0 +1,17 @@ +// PR c++/58753 +// { dg-do compile { target c++11 } } + +#include <initializer_list> + +template <class T> +struct X {X(std::initializer_list<int>) {}}; + +template <class zomg> +class T { + X<T> x{1}; +}; + +int main() +{ + T<int> t; +} diff --git a/gcc/testsuite/g++.dg/cpp0x/nsdmi-template13.C b/gcc/testsuite/g++.dg/cpp0x/nsdmi-template13.C new file mode 100644 index 00000000000..65ccd0aaa7f --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/nsdmi-template13.C @@ -0,0 +1,11 @@ +// PR c++/58704 +// { dg-do compile { target c++11 } } + +struct A {}; + +template<typename> struct B +{ + A a[1] = { }; +}; + +B<int> b; diff --git a/gcc/testsuite/g++.dg/cpp0x/pr58155.C b/gcc/testsuite/g++.dg/cpp0x/pr58155.C new file mode 100644 index 00000000000..60b02ab657d --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/pr58155.C @@ -0,0 +1,13 @@ +// { dg-do compile { target c++11 } } + +#define BAZ "baz" + +#if 0 + +"bar"BAZ + +R"( + bar +)"BAZ + +#endif diff --git a/gcc/testsuite/g++.dg/cpp0x/pr58781.C b/gcc/testsuite/g++.dg/cpp0x/pr58781.C new file mode 100644 index 00000000000..58c972f90f3 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/pr58781.C @@ -0,0 +1,18 @@ +// PR c++/58781 +// { dg-do compile { target c++11 } } + +#include <cstddef> + +int +operator""_s(const char32_t *a, size_t b) +{ + return 0; +} + +int +f() +{ + using a = decltype(U"\x1181"_s); + using b = decltype(U"\x8111"_s); + using c = decltype(U" \x1181"_s); +} diff --git a/gcc/testsuite/g++.dg/cpp0x/pr60249.C b/gcc/testsuite/g++.dg/cpp0x/pr60249.C new file mode 100644 index 00000000000..e650dcb452b --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/pr60249.C @@ -0,0 +1,6 @@ +// PR c++/60249 +// { dg-do compile { target c++11 } } + +decltype(""_) x; // { dg-error "unable to find string literal operator" } + +// { dg-error "invalid type in declaration before" "invalid" { target *-*-* } 4 } diff --git a/gcc/testsuite/g++.dg/cpp0x/variadic160.C b/gcc/testsuite/g++.dg/cpp0x/variadic160.C new file mode 100644 index 00000000000..20fcd5b4fe7 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/variadic160.C @@ -0,0 +1,49 @@ +// PR c++/61539 +// { dg-do compile { target c++11 } } + +template <typename _CharT> class A; +template <typename> class B; +template <class charT> class C; +template <> class C<char> +{ + virtual void xparse (int &, const B<A<char> > &) const; +}; +template <class T, class charT = char> class G : C<charT> +{ +public: + G (void *) {} + void default_value (const T &); + void xparse (int &, const B<A<charT> > &) const; +}; +template <class T, class charT> +void validate (int &, const B<A<charT> > &, T *, int); +template <class T, class charT> +void G<T, charT>::xparse (int &p1, const B<A<charT> > &p2) const +{ + validate (p1, p2, (T *)0, 0); +} +template <class T> G<T> *value (T *) { return new G<T>(0); } +namespace Eigen +{ +template <typename T> struct D; +template <typename, int, int, int = 0, int = 0, int = 0 > class F; +template <typename _Scalar, int _Rows, int _Cols, int _Options, int _MaxRows, + int _MaxCols> +struct D<F<_Scalar, _Rows, _Cols, _Options, _MaxRows, _MaxCols> > +{ + typedef _Scalar Scalar; +}; +template <typename, int, int, int, int, int _MaxCols> class F +{ +public: + typedef typename Eigen::D<F>::Scalar Scalar; + F (const Scalar &, const Scalar &, const Scalar &); +}; +template <class... T> +void validate (int &, const B<A<char> > &, Eigen::F<T...> *); +} +int main (int, char *[]) +{ + Eigen::F<double, 3, 1> a (0, 0, 0); + value (&a)->default_value (Eigen::F<double, 3, 1>(0, 0, 0)); +} diff --git a/gcc/testsuite/g++.dg/cpp1y/pr59867.C b/gcc/testsuite/g++.dg/cpp1y/pr59867.C new file mode 100644 index 00000000000..91d025964c0 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp1y/pr59867.C @@ -0,0 +1,52 @@ +// PR c++/59867 +// { dg-do compile { target c++1y } } + +#include <iostream> +using namespace std; + +// constant +template<typename T, T x> + struct meta_value + { + typedef meta_value type; + typedef T value_type; + static const T value = x; + }; + +// array +template<typename T, T... data> + struct meta_array + { + typedef meta_array type; + typedef T item_type; + }; + +// static array -> runtime array conversion utility +template<typename T> + struct array_gen; + +template<typename T, T... xs> + struct array_gen<meta_array<T, xs...>> + { + static const T value[sizeof...(xs)]; + }; + +template<typename T, T... xs> + const T + array_gen<meta_array<T, xs...>>::value[sizeof...(xs)] = {xs...}; + +// static string +template<typename T, T... xs> + constexpr meta_array<T, xs...> + operator""_s() + { + static_assert(sizeof...(xs) == 3, "What's wrong with you?"); + return meta_array<T, xs...>(); + } + +int +main() +{ + auto a = "123"_s; + const char (& xs)[3] = array_gen<decltype("123"_s)>::value; +} diff --git a/gcc/testsuite/g++.dg/debug/dwarf2/pr61433.C b/gcc/testsuite/g++.dg/debug/dwarf2/pr61433.C new file mode 100644 index 00000000000..a63b8a9ef2f --- /dev/null +++ b/gcc/testsuite/g++.dg/debug/dwarf2/pr61433.C @@ -0,0 +1,23 @@ +// PR c++/61433 +// { dg-do compile { target c++11 } } +// { dg-options "-O -fcompare-debug -fno-inline -fno-ipa-pure-const -fipa-sra" } + +template <class T> +struct A +{ + template <class V> + struct B + { + int MEM; + }; +}; +struct D {}; +struct C: public A<int>::B<D> +{}; +template <class T, class U, class V> +auto k(T t, U u, V v) -> decltype (t.U::template B<V>::MEM) +{} +int main() +{ + k( C(), A<int>(), D() ); +} diff --git a/gcc/testsuite/g++.dg/ext/complit14.C b/gcc/testsuite/g++.dg/ext/complit14.C new file mode 100644 index 00000000000..aed765dc55d --- /dev/null +++ b/gcc/testsuite/g++.dg/ext/complit14.C @@ -0,0 +1,11 @@ +// PR c++/61614 +// { dg-options "" } + +int Fn (...); + +void +Test () +{ + int j = Fn ((const int[]) { 0 }); // OK + unsigned long sz = sizeof Fn ((const int[]) { 0 }); // Error +} diff --git a/gcc/testsuite/g++.dg/ipa/devirt-25.C b/gcc/testsuite/g++.dg/ipa/devirt-25.C index 751647957fa..1da44f5d114 100644 --- a/gcc/testsuite/g++.dg/ipa/devirt-25.C +++ b/gcc/testsuite/g++.dg/ipa/devirt-25.C @@ -22,5 +22,5 @@ void dpr_run(ebs_Object& objectA) { dpr_Job jobL; dpr_run(jobL); } -/* { dg-final { scan-ipa-dump "Type inconsident devirtualization" "cp" } } */ +/* { dg-final { scan-ipa-dump "Type inconsistent devirtualization" "cp" } } */ /* { dg-final { cleanup-ipa-dump "cp" } } */ diff --git a/gcc/testsuite/g++.dg/ipa/pr60600.C b/gcc/testsuite/g++.dg/ipa/pr60600.C index 00c368e6329..07539319307 100644 --- a/gcc/testsuite/g++.dg/ipa/pr60600.C +++ b/gcc/testsuite/g++.dg/ipa/pr60600.C @@ -30,5 +30,5 @@ void test(top& t) test(d); } -/* { dg-final { scan-ipa-dump "Type inconsident devirtualization" "cp" } } */ +/* { dg-final { scan-ipa-dump "Type inconsistent devirtualization" "cp" } } */ /* { dg-final { cleanup-ipa-dump "cp" } } */ diff --git a/gcc/testsuite/g++.dg/ipa/pr61160-2.C b/gcc/testsuite/g++.dg/ipa/pr61160-2.C new file mode 100644 index 00000000000..1011bd1efab --- /dev/null +++ b/gcc/testsuite/g++.dg/ipa/pr61160-2.C @@ -0,0 +1,43 @@ +/* { dg-do run } */ +/* { dg-options "-O3 --param ipa-cp-eval-threshold=1" } */ + +extern "C" void abort (void); + +struct CBase { + virtual void BaseFunc () {} +}; + +struct MMixin { + virtual void * MixinFunc (int, void *) = 0; +}; + +struct CExample: CBase, public MMixin +{ + int stuff, magic, more_stuff; + + CExample () + { + stuff = 0; + magic = 0xbeef; + more_stuff = 0; + } + void *MixinFunc (int arg, void *arg2) + { + if (arg != 1 || arg2) + return 0; + if (magic != 0xbeef) + abort(); + return this; + } +}; + +void *test (MMixin & anExample) +{ + return anExample.MixinFunc (1, 0); +} + +int main () +{ + CExample c; + return (test (c) != &c); +} diff --git a/gcc/testsuite/g++.dg/ipa/pr61160-3.C b/gcc/testsuite/g++.dg/ipa/pr61160-3.C new file mode 100644 index 00000000000..8184ec2cd3d --- /dev/null +++ b/gcc/testsuite/g++.dg/ipa/pr61160-3.C @@ -0,0 +1,37 @@ +/* { dg-do run } */ +/* { dg-options "-O3" } */ + +struct A { + void *p; + A (void *q) : p (q) {} + A (const A &) : p () {} +}; + +struct CBase { + virtual void BaseFunc () {} +}; + +struct MMixin { + virtual A MixinFunc (int, A) = 0; +}; + +struct CExample: CBase, public MMixin +{ + A MixinFunc (int arg, A arg2) + { + if (arg != 1 || arg2.p) + return 0; + return this; + } +}; + +void *test (MMixin & anExample) +{ + return anExample.MixinFunc (1, (0)).p; +} + +int main () +{ + CExample c; + return (test (c) != &c); +} diff --git a/gcc/testsuite/g++.dg/ipa/pr61540.C b/gcc/testsuite/g++.dg/ipa/pr61540.C index d298964bf22..e7dee7262c1 100644 --- a/gcc/testsuite/g++.dg/ipa/pr61540.C +++ b/gcc/testsuite/g++.dg/ipa/pr61540.C @@ -1,5 +1,5 @@ /* { dg-do compile } */ -/* { dg-options "-O3 -fno-early-inlining -fdump-ipa-cp" } */ +/* { dg-options "-O3 -fno-early-inlining" } */ struct data { data(int) {} @@ -36,6 +36,3 @@ int main (int argc, char **argv) test (c); return 0; } - -/* { dg-final { scan-ipa-dump "Type inconsident devirtualization" "cp" } } */ -/* { dg-final { cleanup-ipa-dump "cp" } } */ diff --git a/gcc/testsuite/g++.dg/opt/pr61654.C b/gcc/testsuite/g++.dg/opt/pr61654.C new file mode 100644 index 00000000000..78dc0c14cfd --- /dev/null +++ b/gcc/testsuite/g++.dg/opt/pr61654.C @@ -0,0 +1,27 @@ +// PR middle-end/61654 +// { dg-do compile } + +class A +{ + virtual int a (int, int = 0) = 0; + int b (const int &); + int c; +}; + +class B : virtual A +{ + int d; + int a (int, int); +}; + +int +A::b (const int &) +{ + return a ('\0'); +} + +int +B::a (int, int) +{ + return 0 ? 0 : d; +} diff --git a/gcc/testsuite/g++.dg/template/conv14.C b/gcc/testsuite/g++.dg/template/conv14.C new file mode 100644 index 00000000000..509ae6a6546 --- /dev/null +++ b/gcc/testsuite/g++.dg/template/conv14.C @@ -0,0 +1,30 @@ +// PR c++/61647 + +class XX; + +template<typename Container, typename Key> +struct Accessor; + +template<typename Container, typename Key, typename KeyStore = Key> +class Variant { +protected: + KeyStore index; + Container state; +public: + Variant(Container st, const Key& i) : index(i), state(st) {} + + template<typename T> + operator T() const { + return Accessor<Container, KeyStore>::template get<T>(state, index); + } +}; + +class AutoCleanVariant : public Variant<XX*, int> { +public: + AutoCleanVariant(XX* st, int i) : Variant<XX*,int>(st,i) {} + + template<typename T> + operator T() const { + return Variant<XX*, int>::operator T(); + } +}; diff --git a/gcc/testsuite/g++.dg/template/pr61537.C b/gcc/testsuite/g++.dg/template/pr61537.C new file mode 100644 index 00000000000..12aaf58ef62 --- /dev/null +++ b/gcc/testsuite/g++.dg/template/pr61537.C @@ -0,0 +1,23 @@ +// PR c++/61537 +// { dg-do compile } + +struct A {}; + +template <typename T> +struct B +{ + template <typename U> + void f(U, struct A); +}; + +template <typename T> +template <typename U> +void B<T>::f(U, struct A) +{ +} + +int main() +{ + B<char> b; + b.f(42, A()); +} diff --git a/gcc/testsuite/g++.dg/template/ptrmem27.C b/gcc/testsuite/g++.dg/template/ptrmem27.C new file mode 100644 index 00000000000..8c63f9c2974 --- /dev/null +++ b/gcc/testsuite/g++.dg/template/ptrmem27.C @@ -0,0 +1,22 @@ +// PR c++/61500 + +struct X { + int i; + int j; + + int foo(int X::* ptr); + + template <int X::* ptr> + int bar(); +}; + +int X::foo(int X::* ptr) { + int* p = &(this->*ptr); // OK. + return *p; +} + +template <int X::* ptr> +int X::bar() { + int* p = &(this->*ptr); // gcc 4.9.0: OK in C++98 mode, fails in C++11 mode. + return *p; +} diff --git a/gcc/testsuite/g++.dg/template/ptrmem28.C b/gcc/testsuite/g++.dg/template/ptrmem28.C new file mode 100644 index 00000000000..037996087b2 --- /dev/null +++ b/gcc/testsuite/g++.dg/template/ptrmem28.C @@ -0,0 +1,10 @@ +// PR c++/61488 + +struct A { + typedef int (A::*cont_func)(); + template <A::cont_func> void wait(int); + int notify(); + + void fix() { wait<&A::notify>(0); } // OK + template <int> void repair() { wait<&A::notify>(0); } +}; diff --git a/gcc/testsuite/gcc.c-torture/compile/pr61684.c b/gcc/testsuite/gcc.c-torture/compile/pr61684.c new file mode 100644 index 00000000000..f5b53b73a0d --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/pr61684.c @@ -0,0 +1,15 @@ +/* PR tree-optimization/61684 */ + +int a, c; +static int *b = 0; +short d; +static short **e = 0; + +void +foo () +{ + for (; c < 1; c++) + ; + *e = &d; + a = d && (c && 1) & *b; +} diff --git a/gcc/testsuite/gcc.c-torture/execute/pr61306-1.c b/gcc/testsuite/gcc.c-torture/execute/pr61306-1.c new file mode 100644 index 00000000000..ebc90a32f98 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/pr61306-1.c @@ -0,0 +1,39 @@ +#ifdef __INT32_TYPE__ +typedef __INT32_TYPE__ int32_t; +#else +typedef int int32_t; +#endif + +#ifdef __UINT32_TYPE__ +typedef __UINT32_TYPE__ uint32_t; +#else +typedef unsigned uint32_t; +#endif + +#define __fake_const_swab32(x) ((uint32_t)( \ + (((uint32_t)(x) & (uint32_t)0x000000ffUL) << 24) | \ + (((uint32_t)(x) & (uint32_t)0x0000ff00UL) << 8) | \ + (((uint32_t)(x) & (uint32_t)0x00ff0000UL) >> 8) | \ + (( (int32_t)(x) & (int32_t)0xff000000UL) >> 24))) + +/* Previous version of bswap optimization failed to consider sign extension + and as a result would replace an expression *not* doing a bswap by a + bswap. */ + +__attribute__ ((noinline, noclone)) uint32_t +fake_bswap32 (uint32_t in) +{ + return __fake_const_swab32 (in); +} + +int +main(void) +{ + if (sizeof (int32_t) * __CHAR_BIT__ != 32) + return 0; + if (sizeof (uint32_t) * __CHAR_BIT__ != 32) + return 0; + if (fake_bswap32 (0x87654321) != 0xffffff87) + __builtin_abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.c-torture/execute/pr61306-2.c b/gcc/testsuite/gcc.c-torture/execute/pr61306-2.c new file mode 100644 index 00000000000..886ecfd29da --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/pr61306-2.c @@ -0,0 +1,40 @@ +#ifdef __INT16_TYPE__ +typedef __INT16_TYPE__ int16_t; +#else +typedef short int16_t; +#endif + +#ifdef __UINT32_TYPE__ +typedef __UINT32_TYPE__ uint32_t; +#else +typedef unsigned uint32_t; +#endif + +#define __fake_const_swab32(x) ((uint32_t)( \ + (((uint32_t) (x) & (uint32_t)0x000000ffUL) << 24) | \ + (((uint32_t)(int16_t)(x) & (uint32_t)0x00ffff00UL) << 8) | \ + (((uint32_t) (x) & (uint32_t)0x00ff0000UL) >> 8) | \ + (((uint32_t) (x) & (uint32_t)0xff000000UL) >> 24))) + + +/* Previous version of bswap optimization failed to consider sign extension + and as a result would replace an expression *not* doing a bswap by a + bswap. */ + +__attribute__ ((noinline, noclone)) uint32_t +fake_bswap32 (uint32_t in) +{ + return __fake_const_swab32 (in); +} + +int +main(void) +{ + if (sizeof (uint32_t) * __CHAR_BIT__ != 32) + return 0; + if (sizeof (int16_t) * __CHAR_BIT__ != 16) + return 0; + if (fake_bswap32 (0x81828384) != 0xff838281) + __builtin_abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.c-torture/execute/pr61306-3.c b/gcc/testsuite/gcc.c-torture/execute/pr61306-3.c new file mode 100644 index 00000000000..6086e278627 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/pr61306-3.c @@ -0,0 +1,13 @@ +short a = -1; +int b; +char c; + +int +main () +{ + c = a; + b = a | c; + if (b != -1) + __builtin_abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.c-torture/execute/pr61673.c b/gcc/testsuite/gcc.c-torture/execute/pr61673.c new file mode 100644 index 00000000000..b3e243da527 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/pr61673.c @@ -0,0 +1,50 @@ +/* PR rtl-optimization/61673 */ + +char e; + +__attribute__((noinline, noclone)) void +bar (char x) +{ + if (x != 0x54 && x != (char) 0x87) + __builtin_abort (); +} + +__attribute__((noinline, noclone)) void +foo (const char *x) +{ + char d = x[0]; + int c = d; + if ((c >= 0 && c <= 0x7f) == 0) + e = d; + bar (d); +} + +__attribute__((noinline, noclone)) void +baz (const char *x) +{ + char d = x[0]; + int c = d; + if ((c >= 0 && c <= 0x7f) == 0) + e = d; +} + +int +main () +{ + const char c[] = { 0x54, 0x87 }; + e = 0x21; + foo (c); + if (e != 0x21) + __builtin_abort (); + foo (c + 1); + if (e != (char) 0x87) + __builtin_abort (); + e = 0x21; + baz (c); + if (e != 0x21) + __builtin_abort (); + baz (c + 1); + if (e != (char) 0x87) + __builtin_abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.c-torture/execute/pr61725.c b/gcc/testsuite/gcc.c-torture/execute/pr61725.c new file mode 100644 index 00000000000..0aa6dafa218 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/pr61725.c @@ -0,0 +1,14 @@ +/* PR tree-optimization/61725 */ + +int +main () +{ + int x; + for (x = -128; x <= 128; x++) + { + int a = __builtin_ffs (x); + if (x == 0 && a != 0) + __builtin_abort (); + } + return 0; +} diff --git a/gcc/testsuite/gcc.dg/pr57233.c b/gcc/testsuite/gcc.dg/pr57233.c new file mode 100644 index 00000000000..58c05348b85 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr57233.c @@ -0,0 +1,171 @@ +/* PR tree-optimization/57233 */ +/* { dg-do run { target { ilp32 || lp64 } } } */ +/* { dg-options "-O2" } */ + +typedef unsigned V4 __attribute__((vector_size(4 * sizeof (int)))); +typedef unsigned V8 __attribute__((vector_size(8 * sizeof (int)))); +typedef unsigned V16 __attribute__((vector_size(16 * sizeof (int)))); +V4 a, b, g; +V8 c, d, h; +V16 e, f, j; + +__attribute__((noinline)) void +f1 (void) +{ + a = (a << 2) | (a >> 30); +} + +__attribute__((noinline)) void +f2 (void) +{ + a = (a << 30) | (a >> 2); +} + +__attribute__((noinline)) void +f3 (void) +{ + a = (a << b) | (a >> (32 - b)); +} + +__attribute__((noinline, noclone)) void +f4 (int x) +{ + a = (a << x) | (a >> (32 - x)); +} + +__attribute__((noinline)) void +f5 (void) +{ + c = (c << 2) | (c >> 30); +} + +__attribute__((noinline)) void +f6 (void) +{ + c = (c << 30) | (c >> 2); +} + +__attribute__((noinline)) void +f7 (void) +{ + c = (c << d) | (c >> (32 - d)); +} + +__attribute__((noinline, noclone)) void +f8 (int x) +{ + c = (c << x) | (c >> (32 - x)); +} + +__attribute__((noinline)) void +f9 (void) +{ + e = (e << 2) | (e >> 30); +} + +__attribute__((noinline)) void +f10 (void) +{ + e = (e << 30) | (e >> 2); +} + +__attribute__((noinline)) void +f11 (void) +{ + e = (e << f) | (e >> (32 - f)); +} + +__attribute__((noinline, noclone)) void +f12 (int x) +{ + e = (e << x) | (e >> (32 - x)); +} + +unsigned +r (void) +{ + static unsigned x = 0xdeadbeefU; + static unsigned y = 0x12347654U; + static unsigned z = 0x1a2b3c4dU; + static unsigned w = 0x87654321U; + unsigned t = x ^ (x << 11); + x = y; + y = z; + z = w; + w = w ^ (w >> 19) ^ t ^ (t >> 8); + return w; +} + +void +init (unsigned int *p, int count, int mod) +{ + int i; + for (i = 0; i < count; i++) + { + unsigned int v = r (); + if (mod) + v = (v % 31) + 1; + p[i] = v; + } +} + +void +check (unsigned int *p, unsigned int *q, int count, unsigned int *s, int ss) +{ + int i; + for (i = 0; i < count; i++) + { + if (s) + ss = s[i]; + if (p[i] != ((q[i] << ss) | (q[i] >> (32 - ss)))) + __builtin_abort (); + } +} + +int +main () +{ + init ((unsigned int *) &a, 4, 0); + init ((unsigned int *) &b, 4, 1); + init ((unsigned int *) &c, 8, 0); + init ((unsigned int *) &d, 8, 1); + init ((unsigned int *) &e, 16, 0); + init ((unsigned int *) &f, 16, 1); + g = a; + h = c; + j = e; + f1 (); + f5 (); + f9 (); + check ((unsigned int *) &a, (unsigned int *) &g, 4, 0, 2); + check ((unsigned int *) &c, (unsigned int *) &h, 8, 0, 2); + check ((unsigned int *) &e, (unsigned int *) &j, 16, 0, 2); + g = a; + h = c; + j = e; + f2 (); + f6 (); + f10 (); + check ((unsigned int *) &a, (unsigned int *) &g, 4, 0, 30); + check ((unsigned int *) &c, (unsigned int *) &h, 8, 0, 30); + check ((unsigned int *) &e, (unsigned int *) &j, 16, 0, 30); + g = a; + h = c; + j = e; + f3 (); + f7 (); + f11 (); + check ((unsigned int *) &a, (unsigned int *) &g, 4, (unsigned int *) &b, 0); + check ((unsigned int *) &c, (unsigned int *) &h, 8, (unsigned int *) &d, 0); + check ((unsigned int *) &e, (unsigned int *) &j, 16, (unsigned int *) &f, 0); + g = a; + h = c; + j = e; + f4 (5); + f8 (5); + f12 (5); + check ((unsigned int *) &a, (unsigned int *) &g, 4, 0, 5); + check ((unsigned int *) &c, (unsigned int *) &h, 8, 0, 5); + check ((unsigned int *) &e, (unsigned int *) &j, 16, 0, 5); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/torture/pr61681.c b/gcc/testsuite/gcc.dg/torture/pr61681.c new file mode 100644 index 00000000000..226de0c1aa7 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr61681.c @@ -0,0 +1,37 @@ +/* { dg-do run } */ + +extern void abort (void); + +int a = 1, *e = &a, **f = &e, *l, *p, j; +static int b; +long d; +short g; + +void +fn1 (int *p) +{ + int m; + if (!(*p & j)) + { + int *n = &m; + for (d = 6; d; d--) + { + for (g = 0; g < 1; g++) + { + n = l = *f; + b = *p; + } + *n = 0; + } + } +} + +int +main () +{ + p = *f; + fn1 (p); + if (b != 0) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/vrp93.c b/gcc/testsuite/gcc.dg/tree-ssa/vrp93.c new file mode 100644 index 00000000000..d78c399c3e1 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/vrp93.c @@ -0,0 +1,36 @@ +/* PR target/29776 */ +/* PR tree-optimization/61725 */ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-vrp1" } */ +/* { dg-final { scan-tree-dump-not "link_error" "vrp1"} } */ +/* { dg-final { cleanup-tree-dump "vrp1" } } */ + +#define A(fn, arg, min, max) \ + if (__builtin_##fn (arg) < min || __builtin_##fn (arg) > max) \ + link_error (); +#define B(fn, min, max) \ + A (fn, a, min, max) A (fn##l, b, min, max) A (fn##ll, c, min, max) +#define C(fn, min, sub) \ + A (fn, a, min, ((int) sizeof (a) * __CHAR_BIT__ - sub)) \ + A (fn##l, b, min, ((int) sizeof (b) * __CHAR_BIT__ - sub)) \ + A (fn##ll, c, min, ((int) sizeof (c) * __CHAR_BIT__ - sub)) + +extern void link_error (void); + +unsigned int d; +unsigned long e; +unsigned long long f; + +void +foo (int a, long b, long long c) +{ + C (ffs, 0, 0) + a &= 63; b &= 63; c &= 63; + B (ffs, 0, 6) + a++; b++; c++; + B (ffs, 1, 7) + a -= 2; b -= 2; c -= 2; + C (ffs, 0, 0) + a -= 63; b -= 63; c -= 63; + C (ffs, 1, 0) +} diff --git a/gcc/testsuite/gcc.dg/typeof-2.c b/gcc/testsuite/gcc.dg/typeof-2.c new file mode 100644 index 00000000000..e9169003a9b --- /dev/null +++ b/gcc/testsuite/gcc.dg/typeof-2.c @@ -0,0 +1,28 @@ +/* Test qualifier discard of typeof for atomic types. */ +/* { dg-do compile } */ +/* { dg-options "-std=c11" } */ + +extern int i; + +extern int * p; + +extern int _Atomic const ci; +extern __typeof (ci) i; + +extern int _Atomic volatile vi; +extern __typeof (vi) i; + +extern int * _Atomic restrict ri; +extern __typeof (ri) p; + +void f(void) +{ + __auto_type aci = ci; + int *paci = &aci; + + __auto_type avi = vi; + int *pavi = &avi; + + __auto_type ari = ri; + int **pari = &ari; +} diff --git a/gcc/testsuite/gcc.dg/vect/pr61680.c b/gcc/testsuite/gcc.dg/vect/pr61680.c new file mode 100644 index 00000000000..605a651aa3b --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/pr61680.c @@ -0,0 +1,51 @@ +/* { dg-do run } */ + +#include "tree-vect.h" + +double v[4096][4]; + +__attribute__((noinline, noclone)) void +bar (double p[][4]) +{ + int i; + double d = 172.0; + for (i = 0; i < 4096; i++) + { + if (p[i][0] != 6.0 || p[i][1] != 6.0 || p[i][2] != 10.0) + __builtin_abort (); + if (__builtin_fabs (p[i][3] - d) > 0.25) + __builtin_abort (); + } +} + +__attribute__((noinline, noclone)) void +foo (void) +{ + int i; + double w[4096][4], t; + for (i = 0; i < 4096; i++) + { + w[i][0] = v[i][0] + 2.0; + w[i][1] = v[i][1] + 1.0; + w[i][2] = v[i][2] + 4.0; + w[i][3] = (w[i][0] * w[i][0] + w[i][1] * w[i][1] + w[i][2] * w[i][2]); + } + bar (w); +} + +int +main () +{ + int i; + + check_vect (); + + for (i = 0; i < 4096; i++) + { + v[i][0] = 4.0; + v[i][1] = 5.0; + v[i][2] = 6.0; + } + foo (); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/vect/vect-singleton_1.c b/gcc/testsuite/gcc.dg/vect/vect-singleton_1.c new file mode 100644 index 00000000000..6c2ff49cdab --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/vect-singleton_1.c @@ -0,0 +1,38 @@ +/* PR target/59843 ICE on function taking/returning vector of one float64_t. */ + +/* { dg-do compile } */ +/* { dg-options "-Warray-bounds -O2 -fno-inline -std=c99" } */ + +#define TEST(BASETYPE, VECTYPE, SUFFIX) \ + typedef BASETYPE VECTYPE \ + __attribute__ ((__vector_size__ (sizeof (BASETYPE)))); \ + VECTYPE \ + test_vadd_##SUFFIX (VECTYPE a, VECTYPE b) \ + { \ + return a + b; \ + } \ + \ + void \ + test_##SUFFIX (BASETYPE val) \ + { \ + VECTYPE var = { val }; \ + BASETYPE v0 = var[0]; \ + BASETYPE v1 = var[1]; /* { dg-warning "index value is out of bound" } */ \ + } + +TEST (double, float64x1_t, f64) + +/* Original bug was for above type; + in a nod to completeness, test other types too. */ + +TEST (long long, int64x1_t, s64) + +TEST (float, float32x1_t, f32) + +TEST (long, longx1_t, l) + +TEST (int, intx1_t, i) + +TEST (short, int16x1_t, s16) + +TEST (char, int8x1_t, s8) diff --git a/gcc/testsuite/gcc.target/aarch64/scalar_intrinsics.c b/gcc/testsuite/gcc.target/aarch64/scalar_intrinsics.c index aa041cc2c20..782f6d194ca 100644 --- a/gcc/testsuite/gcc.target/aarch64/scalar_intrinsics.c +++ b/gcc/testsuite/gcc.target/aarch64/scalar_intrinsics.c @@ -387,7 +387,7 @@ test_vqdmlalh_s16 (int32x1_t a, int16x1_t b, int16x1_t c) /* { dg-final { scan-assembler-times "\\tsqdmlal\\ts\[0-9\]+, h\[0-9\]+, v" 1 } } */ int32x1_t -test_vqdmlalh_lane_s16 (int32x1_t a, int16x1_t b, int16x8_t c) +test_vqdmlalh_lane_s16 (int32x1_t a, int16x1_t b, int16x4_t c) { return vqdmlalh_lane_s16 (a, b, c, 3); } @@ -403,7 +403,7 @@ test_vqdmlals_s32 (int64x1_t a, int32x1_t b, int32x1_t c) /* { dg-final { scan-assembler-times "\\tsqdmlal\\td\[0-9\]+, s\[0-9\]+, v" 1 } } */ int64x1_t -test_vqdmlals_lane_s32 (int64x1_t a, int32x1_t b, int32x4_t c) +test_vqdmlals_lane_s32 (int64x1_t a, int32x1_t b, int32x2_t c) { return vqdmlals_lane_s32 (a, b, c, 1); } @@ -419,7 +419,7 @@ test_vqdmlslh_s16 (int32x1_t a, int16x1_t b, int16x1_t c) /* { dg-final { scan-assembler-times "\\tsqdmlsl\\ts\[0-9\]+, h\[0-9\]+, v" 1 } } */ int32x1_t -test_vqdmlslh_lane_s16 (int32x1_t a, int16x1_t b, int16x8_t c) +test_vqdmlslh_lane_s16 (int32x1_t a, int16x1_t b, int16x4_t c) { return vqdmlslh_lane_s16 (a, b, c, 3); } @@ -435,7 +435,7 @@ test_vqdmlsls_s32 (int64x1_t a, int32x1_t b, int32x1_t c) /* { dg-final { scan-assembler-times "\\tsqdmlsl\\td\[0-9\]+, s\[0-9\]+, v" 1 } } */ int64x1_t -test_vqdmlsls_lane_s32 (int64x1_t a, int32x1_t b, int32x4_t c) +test_vqdmlsls_lane_s32 (int64x1_t a, int32x1_t b, int32x2_t c) { return vqdmlsls_lane_s32 (a, b, c, 1); } @@ -451,7 +451,7 @@ test_vqdmulhh_s16 (int16x1_t a, int16x1_t b) /* { dg-final { scan-assembler-times "\\tsqdmulh\\th\[0-9\]+, h\[0-9\]+, v" 1 } } */ int16x1_t -test_vqdmulhh_lane_s16 (int16x1_t a, int16x8_t b) +test_vqdmulhh_lane_s16 (int16x1_t a, int16x4_t b) { return vqdmulhh_lane_s16 (a, b, 3); } @@ -467,9 +467,9 @@ test_vqdmulhs_s32 (int32x1_t a, int32x1_t b) /* { dg-final { scan-assembler-times "\\tsqdmulh\\ts\[0-9\]+, s\[0-9\]+, v" 1 } } */ int32x1_t -test_vqdmulhs_lane_s32 (int32x1_t a, int32x4_t b) +test_vqdmulhs_lane_s32 (int32x1_t a, int32x2_t b) { - return vqdmulhs_lane_s32 (a, b, 3); + return vqdmulhs_lane_s32 (a, b, 1); } /* { dg-final { scan-assembler-times "\\tsqdmull\\ts\[0-9\]+, h\[0-9\]+, h\[0-9\]+" 1 } } */ @@ -483,7 +483,7 @@ test_vqdmullh_s16 (int16x1_t a, int16x1_t b) /* { dg-final { scan-assembler-times "\\tsqdmull\\ts\[0-9\]+, h\[0-9\]+, v" 1 } } */ int32x1_t -test_vqdmullh_lane_s16 (int16x1_t a, int16x8_t b) +test_vqdmullh_lane_s16 (int16x1_t a, int16x4_t b) { return vqdmullh_lane_s16 (a, b, 3); } @@ -499,7 +499,7 @@ test_vqdmulls_s32 (int32x1_t a, int32x1_t b) /* { dg-final { scan-assembler-times "\\tsqdmull\\td\[0-9\]+, s\[0-9\]+, v" 1 } } */ int64x1_t -test_vqdmulls_lane_s32 (int32x1_t a, int32x4_t b) +test_vqdmulls_lane_s32 (int32x1_t a, int32x2_t b) { return vqdmulls_lane_s32 (a, b, 1); } @@ -515,9 +515,9 @@ test_vqrdmulhh_s16 (int16x1_t a, int16x1_t b) /* { dg-final { scan-assembler-times "\\tsqrdmulh\\th\[0-9\]+, h\[0-9\]+, v" 1 } } */ int16x1_t -test_vqrdmulhh_lane_s16 (int16x1_t a, int16x8_t b) +test_vqrdmulhh_lane_s16 (int16x1_t a, int16x4_t b) { - return vqrdmulhh_lane_s16 (a, b, 6); + return vqrdmulhh_lane_s16 (a, b, 3); } /* { dg-final { scan-assembler-times "\\tsqrdmulh\\ts\[0-9\]+, s\[0-9\]+, s\[0-9\]+" 1 } } */ @@ -531,9 +531,9 @@ test_vqrdmulhs_s32 (int32x1_t a, int32x1_t b) /* { dg-final { scan-assembler-times "\\tsqrdmulh\\ts\[0-9\]+, s\[0-9\]+, v" 1 } } */ int32x1_t -test_vqrdmulhs_lane_s32 (int32x1_t a, int32x4_t b) +test_vqrdmulhs_lane_s32 (int32x1_t a, int32x2_t b) { - return vqrdmulhs_lane_s32 (a, b, 2); + return vqrdmulhs_lane_s32 (a, b, 1); } /* { dg-final { scan-assembler-times "\\tsuqadd\\tb\[0-9\]+" 1 } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vector_intrinsics.c b/gcc/testsuite/gcc.target/aarch64/vector_intrinsics.c index affb8a8a13a..52b0496c8db 100644 --- a/gcc/testsuite/gcc.target/aarch64/vector_intrinsics.c +++ b/gcc/testsuite/gcc.target/aarch64/vector_intrinsics.c @@ -1,7 +1,7 @@ /* { dg-do compile } */ /* { dg-options "-O2" } */ -#include "../../../config/aarch64/arm_neon.h" +#include "arm_neon.h" /* { dg-final { scan-assembler-times "\\tfmax\\tv\[0-9\]+\.2s, v\[0-9\].2s, v\[0-9\].2s" 1 } } */ @@ -305,7 +305,7 @@ test_vqdmlal_high_s16 (int32x4_t __a, int16x8_t __b, int16x8_t __c) /* { dg-final { scan-assembler-times "\\tsqdmlal2\\tv\[0-9\]+\.4s, v\[0-9\]+\.8h, v\[0-9\]+\.h" 3 } } */ int32x4_t -test_vqdmlal_high_lane_s16 (int32x4_t a, int16x8_t b, int16x8_t c) +test_vqdmlal_high_lane_s16 (int32x4_t a, int16x8_t b, int16x4_t c) { return vqdmlal_high_lane_s16 (a, b, c, 3); } @@ -361,7 +361,7 @@ test_vqdmlal_high_s32 (int64x2_t __a, int32x4_t __b, int32x4_t __c) /* { dg-final { scan-assembler-times "\\tsqdmlal2\\tv\[0-9\]+\.2d, v\[0-9\]+\.4s, v\[0-9\]+\.s" 3 } } */ int64x2_t -test_vqdmlal_high_lane_s32 (int64x2_t __a, int32x4_t __b, int32x4_t __c) +test_vqdmlal_high_lane_s32 (int64x2_t __a, int32x4_t __b, int32x2_t __c) { return vqdmlal_high_lane_s32 (__a, __b, __c, 1); } @@ -417,7 +417,7 @@ test_vqdmlsl_high_s16 (int32x4_t __a, int16x8_t __b, int16x8_t __c) /* { dg-final { scan-assembler-times "\\tsqdmlsl2\\tv\[0-9\]+\.4s, v\[0-9\]+\.8h, v\[0-9\]+\.h" 3 } } */ int32x4_t -test_vqdmlsl_high_lane_s16 (int32x4_t a, int16x8_t b, int16x8_t c) +test_vqdmlsl_high_lane_s16 (int32x4_t a, int16x8_t b, int16x4_t c) { return vqdmlsl_high_lane_s16 (a, b, c, 3); } @@ -473,7 +473,7 @@ test_vqdmlsl_high_s32 (int64x2_t __a, int32x4_t __b, int32x4_t __c) /* { dg-final { scan-assembler-times "\\tsqdmlsl2\\tv\[0-9\]+\.2d, v\[0-9\]+\.4s, v\[0-9\]+\.s" 3 } } */ int64x2_t -test_vqdmlsl_high_lane_s32 (int64x2_t __a, int32x4_t __b, int32x4_t __c) +test_vqdmlsl_high_lane_s32 (int64x2_t __a, int32x4_t __b, int32x2_t __c) { return vqdmlsl_high_lane_s32 (__a, __b, __c, 1); } @@ -529,7 +529,7 @@ test_vqdmull_high_s16 (int16x8_t __a, int16x8_t __b) /* { dg-final { scan-assembler-times "\\tsqdmull2\\tv\[0-9\]+\.4s, v\[0-9\]+\.8h, v\[0-9\]+\.h" 3 } } */ int32x4_t -test_vqdmull_high_lane_s16 (int16x8_t a, int16x8_t b) +test_vqdmull_high_lane_s16 (int16x8_t a, int16x4_t b) { return vqdmull_high_lane_s16 (a, b, 3); } @@ -585,7 +585,7 @@ test_vqdmull_high_s32 (int32x4_t __a, int32x4_t __b) /* { dg-final { scan-assembler-times "\\tsqdmull2\\tv\[0-9\]+\.2d, v\[0-9\]+\.4s, v\[0-9\]+\.s" 3 } } */ int64x2_t -test_vqdmull_high_lane_s32 (int32x4_t __a, int32x4_t __b) +test_vqdmull_high_lane_s32 (int32x4_t __a, int32x2_t __b) { return vqdmull_high_lane_s32 (__a, __b, 1); } diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlal_high_lane_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmlal_high_lane_s16.c new file mode 100644 index 00000000000..1388c3b613d --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlal_high_lane_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmlal_high_lane_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqdmlal_high_lane_s16 (int32x4_t a, int16x8_t b, int16x4_t c) +{ + return vqdmlal_high_lane_s16 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlal2\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.8\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlal_high_lane_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmlal_high_lane_s32.c new file mode 100644 index 00000000000..f90387dba89 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlal_high_lane_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmlal_high_lane_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x2_t +t_vqdmlal_high_lane_s32 (int64x2_t a, int32x4_t b, int32x2_t c) +{ + return vqdmlal_high_lane_s32 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlal2\[ \t\]+\[vV\]\[0-9\]+\.2\[dD\], ?\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlal_high_laneq_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmlal_high_laneq_s16.c new file mode 100644 index 00000000000..5399ce98538 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlal_high_laneq_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmlal_high_laneq_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqdmlal_high_laneq_s16 (int32x4_t a, int16x8_t b, int16x8_t c) +{ + return vqdmlal_high_laneq_s16 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlal2\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.8\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlal_high_laneq_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmlal_high_laneq_s32.c new file mode 100644 index 00000000000..e4b55582eab --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlal_high_laneq_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmlal_high_laneq_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x2_t +t_vqdmlal_high_laneq_s32 (int64x2_t a, int32x4_t b, int32x4_t c) +{ + return vqdmlal_high_laneq_s32 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlal2\[ \t\]+\[vV\]\[0-9\]+\.2\[dD\], ?\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlal_lane_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmlal_lane_s16.c new file mode 100644 index 00000000000..7e60c822078 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlal_lane_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmlal_lane_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqdmlal_lane_s16 (int32x4_t a, int16x4_t b, int16x4_t c) +{ + return vqdmlal_lane_s16 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlal\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.4\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlal_lane_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmlal_lane_s32.c new file mode 100644 index 00000000000..c0f508dc954 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlal_lane_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmlal_lane_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x2_t +t_vqdmlal_lane_s32 (int64x2_t a, int32x2_t b, int32x2_t c) +{ + return vqdmlal_lane_s32 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlal\[ \t\]+\[vV\]\[0-9\]+\.2\[dD\], ?\[vV\]\[0-9\]+\.2\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlal_laneq_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmlal_laneq_s16.c new file mode 100644 index 00000000000..9bf13043513 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlal_laneq_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmlal_laneq_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqdmlal_laneq_s16 (int32x4_t a, int16x4_t b, int16x8_t c) +{ + return vqdmlal_laneq_s16 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlal\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.4\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlal_laneq_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmlal_laneq_s32.c new file mode 100644 index 00000000000..5fd9c56dc89 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlal_laneq_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmlal_laneq_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x2_t +t_vqdmlal_laneq_s32 (int64x2_t a, int32x2_t b, int32x4_t c) +{ + return vqdmlal_laneq_s32 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlal\[ \t\]+\[vV\]\[0-9\]+\.2\[dD\], ?\[vV\]\[0-9\]+\.2\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlalh_lane_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmlalh_lane_s16.c new file mode 100644 index 00000000000..83f5af5960f --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlalh_lane_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmlalh_lane_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x1_t +t_vqdmlalh_lane_s16 (int32x1_t a, int16x1_t b, int16x4_t c) +{ + return vqdmlalh_lane_s16 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlal\[ \t\]+\[sS\]\[0-9\]+, ?\[hH\]\[0-9\]+, ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlals_lane_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmlals_lane_s32.c new file mode 100644 index 00000000000..ef94e95d971 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlals_lane_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmlals_lane_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x1_t +t_vqdmlals_lane_s32 (int64x1_t a, int32x1_t b, int32x2_t c) +{ + return vqdmlals_lane_s32 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlal\[ \t\]+\[dD\]\[0-9\]+, ?\[sS\]\[0-9\]+, ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlsl_high_lane_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_high_lane_s16.c new file mode 100644 index 00000000000..276a1a2a93d --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_high_lane_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmlsl_high_lane_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqdmlsl_high_lane_s16 (int32x4_t a, int16x8_t b, int16x4_t c) +{ + return vqdmlsl_high_lane_s16 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlsl2\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.8\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlsl_high_lane_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_high_lane_s32.c new file mode 100644 index 00000000000..2ae58ef0bc4 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_high_lane_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmlsl_high_lane_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x2_t +t_vqdmlsl_high_lane_s32 (int64x2_t a, int32x4_t b, int32x2_t c) +{ + return vqdmlsl_high_lane_s32 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlsl2\[ \t\]+\[vV\]\[0-9\]+\.2\[dD\], ?\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlsl_high_laneq_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_high_laneq_s16.c new file mode 100644 index 00000000000..1db5db4c962 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_high_laneq_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmlsl_high_laneq_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqdmlsl_high_laneq_s16 (int32x4_t a, int16x8_t b, int16x8_t c) +{ + return vqdmlsl_high_laneq_s16 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlsl2\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.8\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlsl_high_laneq_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_high_laneq_s32.c new file mode 100644 index 00000000000..3a72a7bca9d --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_high_laneq_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmlsl_high_laneq_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x2_t +t_vqdmlsl_high_laneq_s32 (int64x2_t a, int32x4_t b, int32x4_t c) +{ + return vqdmlsl_high_laneq_s32 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlsl2\[ \t\]+\[vV\]\[0-9\]+\.2\[dD\], ?\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlsl_lane_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_lane_s16.c new file mode 100644 index 00000000000..0535378e46a --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_lane_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmlsl_lane_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqdmlsl_lane_s16 (int32x4_t a, int16x4_t b, int16x4_t c) +{ + return vqdmlsl_lane_s16 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlsl\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.4\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlsl_lane_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_lane_s32.c new file mode 100644 index 00000000000..b52e51e1a6f --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_lane_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmlsl_lane_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x2_t +t_vqdmlsl_lane_s32 (int64x2_t a, int32x2_t b, int32x2_t c) +{ + return vqdmlsl_lane_s32 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlsl\[ \t\]+\[vV\]\[0-9\]+\.2\[dD\], ?\[vV\]\[0-9\]+\.2\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlsl_laneq_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_laneq_s32.c new file mode 100644 index 00000000000..7009a35f2c3 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlsl_laneq_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmlsl_laneq_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x2_t +t_vqdmlsl_lane_s32 (int64x2_t a, int32x2_t b, int32x4_t c) +{ + return vqdmlsl_laneq_s32 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlsl\[ \t\]+\[vV\]\[0-9\]+\.2\[dD\], ?\[vV\]\[0-9\]+\.2\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlslh_lane_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmlslh_lane_s16.c new file mode 100644 index 00000000000..056dfbb11f0 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlslh_lane_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmlslh_lane_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x1_t +t_vqdmlslh_lane_s16 (int32x1_t a, int16x1_t b, int16x4_t c) +{ + return vqdmlslh_lane_s16 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlsl\[ \t\]+\[sS\]\[0-9\]+, ?\[hH\]\[0-9\]+, ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmlsls_lane_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmlsls_lane_s32.c new file mode 100644 index 00000000000..9e351bc360f --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmlsls_lane_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmlsls_lane_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x1_t +t_vqdmlsls_lane_s32 (int64x1_t a, int32x1_t b, int32x2_t c) +{ + return vqdmlsls_lane_s32 (a, b, c, 0); +} + +/* { dg-final { scan-assembler-times "sqdmlsl\[ \t\]+\[dD\]\[0-9\]+, ?\[sS\]\[0-9\]+, ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmulh_laneq_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmulh_laneq_s16.c new file mode 100644 index 00000000000..d3c699bd337 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmulh_laneq_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmulh_laneq_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int16x4_t +t_vqdmulh_laneq_s16 (int16x4_t a, int16x8_t b) +{ + return vqdmulh_laneq_s16 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmulh\[ \t\]+\[vV\]\[0-9\]+\.4\[hH\], ?\[vV\]\[0-9\]+\.4\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmulh_laneq_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmulh_laneq_s32.c new file mode 100644 index 00000000000..c6202ce19b7 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmulh_laneq_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmulh_laneq_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x2_t +t_vqdmulh_laneq_s32 (int32x2_t a, int32x4_t b) +{ + return vqdmulh_laneq_s32 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmulh\[ \t\]+\[vV\]\[0-9\]+\.2\[sS\], ?\[vV\]\[0-9\]+\.2\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmulhh_lane_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmulhh_lane_s16.c new file mode 100644 index 00000000000..76358510060 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmulhh_lane_s16.c @@ -0,0 +1,36 @@ +/* Test the vqdmulhh_lane_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do run } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" +#include <stdio.h> + +extern void abort (void); + +int +main (void) +{ + int16_t arg1; + int16x4_t arg2; + int16_t result; + int16_t actual; + int16_t expected; + + arg1 = -32768; + arg2 = vcreate_s16 (0x0000ffff2489e398ULL); + actual = vqdmulhh_lane_s16 (arg1, arg2, 2); + expected = 1; + + if (expected != actual) + { + fprintf (stderr, "Expected: %xd, got %xd\n", expected, actual); + abort (); + } + + return 0; +} + + +/* { dg-final { scan-assembler-times "sqdmulh\[ \t\]+\[hH\]\[0-9\]+, ?\[hH\]\[0-9\]+, ?\[vV\]\[0-9\]+\.\[hH\]\\\[2\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmulhq_laneq_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmulhq_laneq_s16.c new file mode 100644 index 00000000000..809c85a7756 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmulhq_laneq_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmulhq_laneq_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int16x8_t +t_vqdmulhq_laneq_s16 (int16x8_t a, int16x8_t b) +{ + return vqdmulhq_laneq_s16 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmulh\[ \t\]+\[vV\]\[0-9\]+\.8\[hH\], ?\[vV\]\[0-9\]+\.8\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmulhq_laneq_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmulhq_laneq_s32.c new file mode 100644 index 00000000000..d375fe818e6 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmulhq_laneq_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmulhq_laneq_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqdmulhq_laneq_s32 (int32x4_t a, int32x4_t b) +{ + return vqdmulhq_laneq_s32 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmulh\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmulhs_lane_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmulhs_lane_s32.c new file mode 100644 index 00000000000..9c27f5f3a71 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmulhs_lane_s32.c @@ -0,0 +1,34 @@ +/* Test the vqdmulhs_lane_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do run } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" +#include <stdio.h> + +extern void abort (void); + +int +main (void) +{ + int32_t arg1; + int32x2_t arg2; + int32_t result; + int32_t actual; + int32_t expected; + + arg1 = 57336; + arg2 = vcreate_s32 (0x55897fff7fff0000ULL); + actual = vqdmulhs_lane_s32 (arg1, arg2, 0); + expected = 57334; + + if (expected != actual) + { + fprintf (stderr, "Expected: %xd, got %xd\n", expected, actual); + abort (); + } + + return 0; +} +/* { dg-final { scan-assembler-times "sqdmulh\[ \t\]+\[sS\]\[0-9\]+, ?\[sS\]\[0-9\]+, ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmull_high_lane_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmull_high_lane_s16.c new file mode 100644 index 00000000000..0af320e2c6e --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmull_high_lane_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmull_high_lane_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqdmull_high_lane_s16 (int16x8_t a, int16x4_t b) +{ + return vqdmull_high_lane_s16 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmull2\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.8\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmull_high_lane_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmull_high_lane_s32.c new file mode 100644 index 00000000000..583e8a17210 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmull_high_lane_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmull_high_lane_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x2_t +t_vqdmull_high_lane_s32 (int32x4_t a, int32x2_t b) +{ + return vqdmull_high_lane_s32 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmull2\[ \t\]+\[vV\]\[0-9\]+\.2\[dD\], ?\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmull_high_laneq_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmull_high_laneq_s16.c new file mode 100644 index 00000000000..dcfd14c7142 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmull_high_laneq_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmull_high_laneq_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqdmull_high_laneq_s16 (int16x8_t a, int16x8_t b) +{ + return vqdmull_high_laneq_s16 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmull2\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.8\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmull_high_laneq_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmull_high_laneq_s32.c new file mode 100644 index 00000000000..3e8b652d90c --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmull_high_laneq_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmull_high_laneq_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x2_t +t_vqdmull_high_laneq_s32 (int32x4_t a, int32x4_t b) +{ + return vqdmull_high_laneq_s32 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmull2\[ \t\]+\[vV\]\[0-9\]+\.2\[dD\], ?\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmull_lane_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmull_lane_s16.c new file mode 100644 index 00000000000..695d4e3fbc4 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmull_lane_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmull_lane_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqdmull_lane_s16 (int16x4_t a, int16x4_t b) +{ + return vqdmull_lane_s16 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmull\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.4\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmull_lane_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmull_lane_s32.c new file mode 100644 index 00000000000..e6a02b573ab --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmull_lane_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmull_lane_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x2_t +t_vqdmull_lane_s32 (int32x2_t a, int32x2_t b) +{ + return vqdmull_lane_s32 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmull\[ \t\]+\[vV\]\[0-9\]+\.2\[dD\], ?\[vV\]\[0-9\]+\.2\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmull_laneq_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmull_laneq_s16.c new file mode 100644 index 00000000000..ba761b23121 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmull_laneq_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmull_laneq_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqdmull_laneq_s16 (int16x4_t a, int16x8_t b) +{ + return vqdmull_laneq_s16 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmull\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.4\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmull_laneq_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmull_laneq_s32.c new file mode 100644 index 00000000000..82b8e19ed7f --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmull_laneq_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmull_laneq_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x2_t +t_vqdmull_laneq_s32 (int32x2_t a, int32x4_t b) +{ + return vqdmull_laneq_s32 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmull\[ \t\]+\[vV\]\[0-9\]+\.2\[dD\], ?\[vV\]\[0-9\]+\.2\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmullh_lane_s16.c b/gcc/testsuite/gcc.target/aarch64/vqdmullh_lane_s16.c new file mode 100644 index 00000000000..fd271e0b3a8 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmullh_lane_s16.c @@ -0,0 +1,15 @@ +/* Test the vqdmullh_lane_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x1_t +t_vqdmullh_lane_s16 (int16x1_t a, int16x4_t b) +{ + return vqdmullh_lane_s16 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmull\[ \t\]+\[sS\]\[0-9\]+, ?\[hH\]\[0-9\]+, ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqdmulls_lane_s32.c b/gcc/testsuite/gcc.target/aarch64/vqdmulls_lane_s32.c new file mode 100644 index 00000000000..11033337537 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqdmulls_lane_s32.c @@ -0,0 +1,15 @@ +/* Test the vqdmulls_lane_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int64x1_t +t_vqdmulls_lane_s32 (int32x1_t a, int32x2_t b) +{ + return vqdmulls_lane_s32 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqdmull\[ \t\]+\[dD\]\[0-9\]+, ?\[sS\]\[0-9\]+, ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqrdmulh_laneq_s16.c b/gcc/testsuite/gcc.target/aarch64/vqrdmulh_laneq_s16.c new file mode 100644 index 00000000000..0313f1c07d4 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqrdmulh_laneq_s16.c @@ -0,0 +1,15 @@ +/* Test the vqrdmulh_laneq_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int16x4_t +t_vqrdmulh_laneq_s16 (int16x4_t a, int16x8_t b) +{ + return vqrdmulh_laneq_s16 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqrdmulh\[ \t\]+\[vV\]\[0-9\]+\.4\[hH\], ?\[vV\]\[0-9\]+\.4\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqrdmulh_laneq_s32.c b/gcc/testsuite/gcc.target/aarch64/vqrdmulh_laneq_s32.c new file mode 100644 index 00000000000..a9124ee108d --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqrdmulh_laneq_s32.c @@ -0,0 +1,15 @@ +/* Test the vqrdmulh_laneq_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x2_t +t_vqrdmulh_laneq_s32 (int32x2_t a, int32x4_t b) +{ + return vqrdmulh_laneq_s32 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqrdmulh\[ \t\]+\[vV\]\[0-9\]+\.2\[sS\], ?\[vV\]\[0-9\]+\.2\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqrdmulhh_lane_s16.c b/gcc/testsuite/gcc.target/aarch64/vqrdmulhh_lane_s16.c new file mode 100644 index 00000000000..f21863ab468 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqrdmulhh_lane_s16.c @@ -0,0 +1,35 @@ +/* Test the vqrdmulhh_lane_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do run } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" +#include <stdio.h> + +extern void abort (void); + +int +main (void) +{ + int16_t arg1; + int16x4_t arg2; + int16_t result; + int16_t actual; + int16_t expected; + + arg1 = -32768; + arg2 = vcreate_s16 (0xd78e000005d78000ULL); + actual = vqrdmulhh_lane_s16 (arg1, arg2, 3); + expected = 10354; + + if (expected != actual) + { + fprintf (stderr, "Expected: %xd, got %xd\n", expected, actual); + abort (); + } + + return 0; +} + +/* { dg-final { scan-assembler-times "sqrdmulh\[ \t\]+\[hH\]\[0-9\]+, ?\[hH\]\[0-9\]+, ?\[vV\]\[0-9\]+\.\[hH\]\\\[3\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqrdmulhq_laneq_s16.c b/gcc/testsuite/gcc.target/aarch64/vqrdmulhq_laneq_s16.c new file mode 100644 index 00000000000..488e694ab4e --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqrdmulhq_laneq_s16.c @@ -0,0 +1,15 @@ +/* Test the vqrdmulhq_laneq_s16 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int16x8_t +t_vqrdmulhq_laneq_s16 (int16x8_t a, int16x8_t b) +{ + return vqrdmulhq_laneq_s16 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqrdmulh\[ \t\]+\[vV\]\[0-9\]+\.8\[hH\], ?\[vV\]\[0-9\]+\.8\[hH\], ?\[vV\]\[0-9\]+\.\[hH\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqrdmulhq_laneq_s32.c b/gcc/testsuite/gcc.target/aarch64/vqrdmulhq_laneq_s32.c new file mode 100644 index 00000000000..42519f61581 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqrdmulhq_laneq_s32.c @@ -0,0 +1,15 @@ +/* Test the vqrdmulhq_laneq_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do compile } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" + +int32x4_t +t_vqrdmulhq_laneq_s32 (int32x4_t a, int32x4_t b) +{ + return vqrdmulhq_laneq_s32 (a, b, 0); +} + +/* { dg-final { scan-assembler-times "sqrdmulh\[ \t\]+\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.4\[sS\], ?\[vV\]\[0-9\]+\.\[sS\]\\\[0\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vqrdmulhs_lane_s32.c b/gcc/testsuite/gcc.target/aarch64/vqrdmulhs_lane_s32.c new file mode 100644 index 00000000000..83d2ba28e25 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vqrdmulhs_lane_s32.c @@ -0,0 +1,35 @@ +/* Test the vqrdmulhs_lane_s32 AArch64 SIMD intrinsic. */ + +/* { dg-do run } */ +/* { dg-options "-save-temps -O3 -fno-inline" } */ + +#include "arm_neon.h" +#include <stdio.h> + +extern void abort (void); + +int +main (void) +{ + int32_t arg1; + int32x2_t arg2; + int32_t result; + int32_t actual; + int32_t expected; + + arg1 = -2099281921; + arg2 = vcreate_s32 (0x000080007fff0000ULL); + actual = vqrdmulhs_lane_s32 (arg1, arg2, 1); + expected = -32033; + + if (expected != actual) + { + fprintf (stderr, "Expected: %xd, got %xd\n", expected, actual); + abort (); + } + + return 0; +} + +/* { dg-final { scan-assembler-times "sqrdmulh\[ \t\]+\[sS\]\[0-9\]+, ?\[sS\]\[0-9\]+, ?\[vV\]\[0-9\]+\.\[sS\]\\\[1\\\]\n" 1 } } */ +/* { dg-final { cleanup-saved-temps } } */ diff --git a/gcc/testsuite/gcc.target/alpha/pr61586.c b/gcc/testsuite/gcc.target/alpha/pr61586.c new file mode 100644 index 00000000000..afb1af3597f --- /dev/null +++ b/gcc/testsuite/gcc.target/alpha/pr61586.c @@ -0,0 +1,10 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -mieee" } */ + +void foo (int *dimensions, double **params, int hh) +{ + if (params[hh]) + ; + else if (dimensions[hh] > 0) + params[hh][0] = 1.0f; +} diff --git a/gcc/testsuite/gcc.target/arm/pr48252.c b/gcc/testsuite/gcc.target/arm/pr48252.c index 17f729bb341..250d5e4d6f9 100644 --- a/gcc/testsuite/gcc.target/arm/pr48252.c +++ b/gcc/testsuite/gcc.target/arm/pr48252.c @@ -15,7 +15,6 @@ int main(void) uint8x8x2_t vd1, vd2; union {uint8x8_t v; uint8_t buf[8];} d1, d2, d3, d4; int i; - uint8_t odd, even; vd1 = vzip_u8(v1, vdup_n_u8(0)); vd2 = vzip_u8(v2, vdup_n_u8(0)); @@ -25,17 +24,9 @@ int main(void) vst1_u8(d3.buf, vd2.val[0]); vst1_u8(d4.buf, vd2.val[1]); -#ifdef __ARMEL__ - odd = 1; - even = 0; -#else - odd = 0; - even = 1; -#endif - for (i = 0; i < 8; i++) - if ((i % 2 == even && d4.buf[i] != 2) - || (i % 2 == odd && d4.buf[i] != 0)) + if ((i % 2 == 0 && d4.buf[i] != 2) + || (i % 2 == 1 && d4.buf[i] != 0)) abort (); return 0; diff --git a/gcc/testsuite/gcc.target/i386/avx-pr57233.c b/gcc/testsuite/gcc.target/i386/avx-pr57233.c new file mode 100644 index 00000000000..ffc71d908a8 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/avx-pr57233.c @@ -0,0 +1,16 @@ +/* PR tree-optimization/57233 */ +/* { dg-do run { target avx } } */ +/* { dg-options "-O2 -mavx" } */ + +#include "avx-check.h" + +static void +avx_test (void) +{ + do_main (); +} + +#undef main +#define main() do_main () + +#include "../../gcc.dg/pr57233.c" diff --git a/gcc/testsuite/gcc.target/i386/avx2-pr57233.c b/gcc/testsuite/gcc.target/i386/avx2-pr57233.c new file mode 100644 index 00000000000..3fb2608ab18 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/avx2-pr57233.c @@ -0,0 +1,16 @@ +/* PR tree-optimization/57233 */ +/* { dg-do run { target avx2 } } */ +/* { dg-options "-O2 -mavx2" } */ + +#include "avx2-check.h" + +static void +avx2_test (void) +{ + do_main (); +} + +#undef main +#define main() do_main () + +#include "../../gcc.dg/pr57233.c" diff --git a/gcc/testsuite/gcc.target/i386/avx512f-pr57233.c b/gcc/testsuite/gcc.target/i386/avx512f-pr57233.c new file mode 100644 index 00000000000..2f1c23a1554 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/avx512f-pr57233.c @@ -0,0 +1,16 @@ +/* PR tree-optimization/57233 */ +/* { dg-do run { target avx512f } } */ +/* { dg-options "-O2 -mavx512f" } */ + +#include "avx512f-check.h" + +static void +avx512f_test (void) +{ + do_main (); +} + +#undef main +#define main() do_main () + +#include "../../gcc.dg/pr57233.c" diff --git a/gcc/testsuite/gcc.target/i386/pr57233.c b/gcc/testsuite/gcc.target/i386/pr57233.c new file mode 100644 index 00000000000..34182fa7dc4 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr57233.c @@ -0,0 +1,15 @@ +/* PR tree-optimization/57233 */ +/* { dg-do compile { target avx } } */ +/* { dg-options "-O2 -mavx -mno-xop" } */ + +typedef unsigned V4 __attribute__((vector_size(4 * sizeof (int)))); +V4 a; + +__attribute__((noinline)) void +foo (void) +{ + a = (a << 2) | (a >> 30); +} + +/* { dg-final { scan-assembler "vpsrld\[^\n\r]*30" } } */ +/* { dg-final { scan-assembler "vpslld\[^\n\r]*2" } } */ diff --git a/gcc/testsuite/gcc.target/i386/sse2-pr57233.c b/gcc/testsuite/gcc.target/i386/sse2-pr57233.c new file mode 100644 index 00000000000..8a3bb2fc5e3 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/sse2-pr57233.c @@ -0,0 +1,16 @@ +/* PR tree-optimization/57233 */ +/* { dg-do run { target sse2 } } */ +/* { dg-options "-O2 -msse2" } */ + +#include "sse2-check.h" + +static void +sse2_test (void) +{ + do_main (); +} + +#undef main +#define main() do_main () + +#include "../../gcc.dg/pr57233.c" diff --git a/gcc/testsuite/gcc.target/i386/xop-pr57233.c b/gcc/testsuite/gcc.target/i386/xop-pr57233.c new file mode 100644 index 00000000000..6129dc21744 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/xop-pr57233.c @@ -0,0 +1,16 @@ +/* PR tree-optimization/57233 */ +/* { dg-do run { target xop } } */ +/* { dg-options "-O2 -mxop" } */ + +#include "xop-check.h" + +static void +xop_test (void) +{ + do_main (); +} + +#undef main +#define main() do_main () + +#include "../../gcc.dg/pr57233.c" diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_8.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_8.f90 new file mode 100644 index 00000000000..48f6dd21657 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocatable_function_8.f90 @@ -0,0 +1,59 @@ +! { dg-do run } +! Test the fix for PR61459 and PR58883. +! +! Contributed by John Wingate <johnww@tds.net> +! and Tao Song <songtao.thu@gmail.com> +! +module a + + implicit none + private + public :: f_segfault, f_segfault_plus, f_workaround + integer, dimension(2,2) :: b = reshape([1,-1,1,1],[2,2]) + +contains + + function f_segfault(x) + real, dimension(:), allocatable :: f_segfault + real, dimension(:), intent(in) :: x + allocate(f_segfault(2)) + f_segfault = matmul(b,x) + end function f_segfault + +! Sefaulted without the ALLOCATE as well. + function f_segfault_plus(x) + real, dimension(:), allocatable :: f_segfault_plus + real, dimension(:), intent(in) :: x + f_segfault_plus = matmul(b,x) + end function f_segfault_plus + + function f_workaround(x) + real, dimension(:), allocatable :: f_workaround + real, dimension(:), intent(in) :: x + real, dimension(:), allocatable :: tmp + allocate(f_workaround(2),tmp(2)) + tmp = matmul(b,x) + f_workaround = tmp + end function f_workaround + +end module a + +program main + use a + implicit none + real, dimension(2) :: x = 1.0, y +! PR61459 + y = f_workaround (x) + if (any (f_segfault (x) .ne. y)) call abort + if (any (f_segfault_plus (x) .ne. y)) call abort +! PR58883 + if (any (foo () .ne. reshape([1,2,3,4,5,6,7,8],[2,4]))) call abort +contains + function foo() + integer, allocatable :: foo(:,:) + integer, allocatable :: temp(:) + + temp = [1,2,3,4,5,6,7,8] + foo = reshape(temp,[2,4]) + end function +end program main diff --git a/gcc/testsuite/gfortran.dg/arrayio_15.f90 b/gcc/testsuite/gfortran.dg/arrayio_15.f90 new file mode 100644 index 00000000000..df497dc027a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/arrayio_15.f90 @@ -0,0 +1,11 @@ +! { dg-do run } +! PR61499 +program read_internal + + integer :: x(9),i,iostat + character(len=512) :: iomsg + character(kind=1,len=30), dimension(:), allocatable, save :: source + allocate(source(3)) + source=[" 1 1 -1"," 1 -1 1"," -1 1 1"] !This fails + read(source,*) (x(i), i=1,6) +end program read_internal diff --git a/gcc/testsuite/gfortran.dg/arrayio_16.f90 b/gcc/testsuite/gfortran.dg/arrayio_16.f90 new file mode 100644 index 00000000000..46814ae5d55 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/arrayio_16.f90 @@ -0,0 +1,13 @@ +! { dg-do run } +! PR61640 KIND=4 Character Array Internal Unit Read Fail +program read_internal + integer :: x(9),i + integer :: y(9) + character(kind=4,len=30), dimension(3) :: source + + y = reshape ((/ 1,1,-1,1,-1,1,-1,1,1 /), shape(x)) + source=[4_" 1 1 -1",4_" 1 -1 1",4_" -1 1 1"] + !print *, (trim(source(i)), i=1,3) + read(source,*) (x(i), i=1,9) ! This read fails for KIND=4 character + if (any(x /= y )) call abort +end program read_internal diff --git a/gcc/testsuite/gfortran.dg/class_array_15.f03 b/gcc/testsuite/gfortran.dg/class_array_15.f03 index 7d1d4d7181b..d3a123259fc 100644 --- a/gcc/testsuite/gfortran.dg/class_array_15.f03 +++ b/gcc/testsuite/gfortran.dg/class_array_15.f03 @@ -1,4 +1,5 @@ ! { dg-do run } +! { dg-options "-fdump-tree-original" } ! ! Tests the fixes for three bugs with the same underlying cause. All are regressions ! that come about because class array elements end up with a different tree type @@ -114,3 +115,5 @@ subroutine pr54992 ! This test remains as the original. bh => bhGet(b,instance=2) if (loc (b) .ne. loc(bh%hostNode)) call abort end +! { dg-final { scan-tree-dump-times "builtin_free" 12 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90 b/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90 index a5337ca3b9e..6134a562531 100644 --- a/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90 +++ b/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90 @@ -1,6 +1,6 @@ ! { dg-require-effective-target fortran_large_real } -! { dg-do run { xfail powerpc*-apple-darwin* powerpc*-*-linux* } } -! Test XFAILed on these platforms because the system's printf() lacks +! { dg-do run { xfail powerpc*-apple-darwin* } } +! Test XFAILed on this platform because the system's printf() lacks ! proper support for denormalized long doubles. See PR24685 ! ! This tests that the default formats for formatted I/O of reals are diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-1.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-1.f90 new file mode 100644 index 00000000000..b6e20b9ce63 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/affinity-1.f90 @@ -0,0 +1,19 @@ + integer :: i, j + integer, dimension (10, 10) :: a +!$omp parallel do default(none)proc_bind(master)shared(a) + do i = 1, 10 + j = 4 + do j = 1, 10 + a(i, j) = i + j + end do + j = 8 + end do +!$omp end parallel do +!$omp parallel proc_bind (close) +!$omp parallel default(none) proc_bind (spread) firstprivate(a) private (i) + do i = 1, 10 + a(i, i) = i + enddo +!$omp end parallel +!$omp endparallel +end diff --git a/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90 index 2a762c77bac..bc06cc8662c 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90 @@ -14,7 +14,7 @@ CONTAINS TYPE(t), SAVE :: a !$omp threadprivate(a) - !$omp parallel copyin(a) ! { dg-error "has ALLOCATABLE components" } + !$omp parallel copyin(a) ! do something !$omp end parallel END SUBROUTINE @@ -22,7 +22,7 @@ CONTAINS SUBROUTINE test_copyprivate() TYPE(t) :: a - !$omp single ! { dg-error "has ALLOCATABLE components" } + !$omp single ! do something !$omp end single copyprivate (a) END SUBROUTINE @@ -30,7 +30,7 @@ CONTAINS SUBROUTINE test_firstprivate TYPE(t) :: a - !$omp parallel firstprivate(a) ! { dg-error "has ALLOCATABLE components" } + !$omp parallel firstprivate(a) ! do something !$omp end parallel END SUBROUTINE @@ -39,7 +39,7 @@ CONTAINS TYPE(t) :: a INTEGER :: i - !$omp parallel do lastprivate(a) ! { dg-error "has ALLOCATABLE components" } + !$omp parallel do lastprivate(a) DO i = 1, 1 END DO !$omp end parallel do @@ -49,7 +49,7 @@ CONTAINS TYPE(t) :: a(10) INTEGER :: i - !$omp parallel do reduction(+: a) ! { dg-error "must be of numeric type" } + !$omp parallel do reduction(+: a) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } DO i = 1, SIZE(a) END DO !$omp end parallel do diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90 index f67c91c215b..598c904206e 100644 --- a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90 @@ -5,7 +5,7 @@ !$OMP PARALLEL DO REDUCTION(MAX: M) ! MAX is no longer the ! intrinsic so this ! is non-conforming -! { dg-error "is not INTRINSIC procedure name" "" { target *-*-* } 5 } */ +! { dg-error "OMP DECLARE REDUCTION max not found" "" { target *-*-* } 5 } */ DO I = 1, 100 CALL SUB(M,I) END DO diff --git a/gcc/testsuite/gfortran.dg/gomp/associate1.f90 b/gcc/testsuite/gfortran.dg/gomp/associate1.f90 new file mode 100644 index 00000000000..abc5ae95a0d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/associate1.f90 @@ -0,0 +1,83 @@ +! { dg-do compile } + +program associate1 + type dl + integer :: i + end type + type dt + integer :: i + real :: a(3, 3) + type(dl) :: c(3, 3) + end type + integer :: v, i, j + real :: a(3, 3) + type(dt) :: b(3) + i = 1 + j = 2 + associate(k => v, l => a(i, j), m => a(i, :)) + associate(n => b(j)%c(:, :)%i, o => a, p => b) +!$omp parallel shared (l) ! { dg-error "ASSOCIATE name" } +!$omp end parallel +!$omp parallel firstprivate (m) ! { dg-error "ASSOCIATE name" } +!$omp end parallel +!$omp parallel reduction (+: k) ! { dg-error "ASSOCIATE name" } +!$omp end parallel +!$omp parallel do firstprivate (k) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do +!$omp parallel do lastprivate (n) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do +!$omp parallel do private (o) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do +!$omp parallel do shared (p) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do +!$omp task private (k) ! { dg-error "ASSOCIATE name" } +!$omp end task +!$omp task shared (l) ! { dg-error "ASSOCIATE name" } +!$omp end task +!$omp task firstprivate (m) ! { dg-error "ASSOCIATE name" } +!$omp end task +!$omp do private (l) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do +!$omp do reduction (*: k) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do +!$omp sections private(o) ! { dg-error "ASSOCIATE name" } +!$omp section +!$omp section +!$omp end sections +!$omp parallel sections firstprivate(p) ! { dg-error "ASSOCIATE name" } +!$omp section +!$omp section +!$omp endparallelsections +!$omp parallelsections lastprivate(m) ! { dg-error "ASSOCIATE name" } +!$omp section +!$omp section +!$omp endparallelsections +!$omp sections reduction(+:k) ! { dg-error "ASSOCIATE name" } +!$omp section +!$omp section +!$omp end sections +!$omp simd private (l) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do + k = 1 +!$omp simd lastprivate (m) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do + k = 1 +!$omp simd reduction (+: k) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + end do + k = 1 +!$omp simd linear (k : 2) ! { dg-error "ASSOCIATE name" } + do i = 1, 10 + k = k + 2 + end do + end associate + end associate +end program diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 new file mode 100644 index 00000000000..d6ae7c9c812 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } + +subroutine fn1 (x) + integer :: x +!$omp declare simd (fn1) inbranch notinbranch uniform (x) ! { dg-error "Unclassifiable OpenMP directive" } +end subroutine fn1 +subroutine fn2 (x) +!$omp declare simd (fn100) ! { dg-error "should refer to containing procedure" } +end subroutine fn2 diff --git a/gcc/testsuite/gfortran.dg/gomp/depend-1.f90 b/gcc/testsuite/gfortran.dg/gomp/depend-1.f90 new file mode 100644 index 00000000000..bd6d26a3830 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/depend-1.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } + +subroutine foo (x) + integer :: x(5, *) +!$omp parallel +!$omp single +!$omp task depend(in:x(:,5)) +!$omp end task +!$omp task depend(in:x(5,:)) ! { dg-error "Rightmost upper bound of assumed size array section|proper array section" } +!$omp end task +!$omp end single +!$omp end parallel +end diff --git a/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 b/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 new file mode 100644 index 00000000000..f2a2e98fd76 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } + +subroutine foo (x) + integer, pointer, intent (in) :: x + integer :: i +!$omp parallel private (x) ! { dg-error "INTENT.IN. POINTER" } +!$omp end parallel +!$omp parallel do lastprivate (x) ! { dg-error "INTENT.IN. POINTER" } + do i = 1, 10 + end do +!$omp simd linear (x) ! { dg-error "INTENT.IN. POINTER" } + do i = 1, 10 + end do +!$omp single ! { dg-error "INTENT.IN. POINTER" } +!$omp end single copyprivate (x) +end diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_do_concurrent.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_do_concurrent.f90 new file mode 100644 index 00000000000..83204791d95 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/omp_do_concurrent.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } +! +! PR fortran/60127 +! +! OpenMP 4.0 doesn't permit DO CONCURRENT (yet) +! + +!$omp do +do concurrent(i=1:5) ! { dg-error "OMP DO cannot be a DO CONCURRENT loop" } +print *, 'Hello' +end do +end diff --git a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-1.f90 b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-1.f90 new file mode 100644 index 00000000000..c9ce70c4f44 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-1.f90 @@ -0,0 +1,137 @@ +! { dg-do compile } +! { dg-options "-fno-openmp -fopenmp-simd -fdump-tree-original -O2" } + +!$omp declare reduction (foo:integer:omp_out = omp_out + omp_in) + interface + integer function foo (x, y) + integer, value :: x, y +!$omp declare simd (foo) linear (y : 2) + end function foo + end interface + integer :: i, a(64), b, c + integer, save :: d +!$omp threadprivate (d) + d = 5 + a = 6 +!$omp simd + do i = 1, 64 + a(i) = foo (a(i), 2 * i) + end do + b = 0 + c = 0 +!$omp simd reduction (+:b) reduction (foo:c) + do i = 1, 64 + b = b + a(i) + c = c + a(i) * 2 + end do + print *, b + b = 0 +!$omp parallel +!$omp do simd schedule(static, 4) safelen (8) reduction (+:b) + do i = 1, 64 + a(i) = a(i) + 1 + b = b + 1 + end do +!$omp end parallel + print *, b + b = 0 +!$omp parallel do simd schedule(static, 4) safelen (8) & +!$omp num_threads (4) if (.true.) reduction (+:b) + do i = 1, 64 + a(i) = a(i) + 1 + b = b + 1 + end do + print *, b + b = 0 +!$omp parallel +!$omp do simd schedule(static, 4) safelen (8) reduction (+:b) + do i = 1, 64 + a(i) = a(i) + 1 + b = b + 1 + end do +!$omp enddosimd +!$omp end parallel + print *, b + b = 0 +!$omp parallel do simd schedule(static, 4) safelen (8) & +!$omp num_threads (4) if (.true.) reduction (+:b) + do i = 1, 64 + a(i) = a(i) + 1 + b = b + 1 + end do +!$omp end parallel do simd +!$omp atomic seq_cst + b = b + 1 +!$omp end atomic +!$omp barrier +!$omp parallel private (i) +!$omp cancellation point parallel +!$omp critical (bar) + b = b + 1 +!$omp end critical (bar) +!$omp flush(b) +!$omp single + b = b + 1 +!$omp end single +!$omp do ordered + do i = 1, 10 + !$omp atomic + b = b + 1 + !$omp end atomic + !$omp ordered + print *, b + !$omp end ordered + end do +!$omp end do +!$omp master + b = b + 1 +!$omp end master +!$omp cancel parallel +!$omp end parallel +!$omp parallel do schedule(runtime) num_threads(8) + do i = 1, 10 + print *, b + end do +!$omp end parallel do +!$omp sections +!$omp section + b = b + 1 +!$omp section + c = c + 1 +!$omp end sections + print *, b +!$omp parallel sections firstprivate (b) if (.true.) +!$omp section + b = b + 1 +!$omp section + c = c + 1 +!$omp endparallelsections +!$omp workshare + b = 24 +!$omp end workshare +!$omp parallel workshare num_threads (2) + b = b + 1 + c = c + 1 +!$omp end parallel workshare + print *, b +!$omp parallel +!$omp single +!$omp taskgroup +!$omp task firstprivate (b) + b = b + 1 +!$omp taskyield +!$omp end task +!$omp task firstprivate (b) + b = b + 1 +!$omp end task +!$omp taskwait +!$omp end taskgroup +!$omp end single +!$omp end parallel + print *, a, c +end + +! { dg-final { scan-tree-dump-times "pragma omp simd" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp" 6 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP" 0 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-2.f90 b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-2.f90 new file mode 100644 index 00000000000..4b2046a58cc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-2.f90 @@ -0,0 +1,28 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fopenmp-simd -fdump-tree-original -O2" } + +include 'openmp-simd-1.f90' + +! { dg-final { scan-tree-dump-times "pragma omp simd" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp" 39 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp for" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp parallel" 9 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp taskgroup" 1 "original" } } +! Includes the above taskgroup +! { dg-final { scan-tree-dump-times "pragma omp task" 3 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp critical" 1 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp atomic" 2 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp sections" 2 "original" } } +! Includes the above sections +! { dg-final { scan-tree-dump-times "pragma omp section" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp single" 4 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp ordered" 1 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp master" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP" 5 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_barrier" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancellation_point" 1 "original" } } +! Includes the above cancellation point +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancel" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_taskyield" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_taskwait" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-3.f90 b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-3.f90 new file mode 100644 index 00000000000..2dece895f39 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-3.f90 @@ -0,0 +1,28 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fno-openmp-simd -fdump-tree-original -O2" } + +include 'openmp-simd-1.f90' + +! { dg-final { scan-tree-dump-times "pragma omp simd" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp" 39 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp for" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp parallel" 9 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp taskgroup" 1 "original" } } +! Includes the above taskgroup +! { dg-final { scan-tree-dump-times "pragma omp task" 3 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp critical" 1 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp atomic" 2 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp sections" 2 "original" } } +! Includes the above sections +! { dg-final { scan-tree-dump-times "pragma omp section" 6 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp single" 4 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp ordered" 1 "original" } } +! { dg-final { scan-tree-dump-times "pragma omp master" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP" 5 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_barrier" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancellation_point" 1 "original" } } +! Includes the above cancellation point +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancel" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_taskyield" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_taskwait" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/proc_ptr_2.f90 b/gcc/testsuite/gfortran.dg/gomp/proc_ptr_2.f90 new file mode 100644 index 00000000000..d993429a76f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/proc_ptr_2.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } + procedure(foo), pointer :: ptr + integer :: i + ptr => foo +!$omp do reduction (+ : ptr) ! { dg-error "Procedure pointer|not found" } + do i = 1, 10 + end do +!$omp simd linear (ptr) ! { dg-error "must be INTEGER" } + do i = 1, 10 + end do +contains + subroutine foo + end subroutine +end diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction1.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction1.f90 index 4912f7178c1..cdc530bf0f2 100644 --- a/gcc/testsuite/gfortran.dg/gomp/reduction1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/reduction1.f90 @@ -60,73 +60,73 @@ common /blk/ i1 !$omp end parallel !$omp parallel reduction (*:ia1) ! { dg-error "Assumed size" } !$omp end parallel -!$omp parallel reduction (+:l1) ! { dg-error "must be of numeric type, got LOGICAL" } +!$omp parallel reduction (+:l1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (*:la1) ! { dg-error "must be of numeric type, got LOGICAL" } +!$omp parallel reduction (*:la1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (-:a1) ! { dg-error "must be of numeric type, got CHARACTER" } +!$omp parallel reduction (-:a1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (+:t1) ! { dg-error "must be of numeric type, got TYPE" } +!$omp parallel reduction (+:t1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (*:ta1) ! { dg-error "must be of numeric type, got TYPE" } +!$omp parallel reduction (*:ta1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.and.:i3) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.and.:i3) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.or.:ia2) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.or.:ia2) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.eqv.:r1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.eqv.:r1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.neqv.:ra1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.neqv.:ra1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.and.:d1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.and.:d1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.or.:da1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.or.:da1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.eqv.:c1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.eqv.:c1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.neqv.:ca1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.neqv.:ca1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.and.:a1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.and.:a1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.or.:t1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.or.:t1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (.eqv.:ta1) ! { dg-error "must be LOGICAL" } +!$omp parallel reduction (.eqv.:ta1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (min:c1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (min:c1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (max:ca1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (max:ca1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (max:l1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (max:l1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (min:la1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (min:la1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (max:a1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (max:a1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (min:t1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (min:t1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (max:ta1) ! { dg-error "must be INTEGER or REAL" } +!$omp parallel reduction (max:ta1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (iand:r1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (iand:r1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ior:ra1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ior:ra1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ieor:d1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ieor:d1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ior:da1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ior:da1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (iand:c1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (iand:c1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ior:ca1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ior:ca1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ieor:l1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ieor:l1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (iand:la1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (iand:la1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ior:a1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ior:a1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (ieor:t1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (ieor:t1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel -!$omp parallel reduction (iand:ta1) ! { dg-error "must be INTEGER" } +!$omp parallel reduction (iand:ta1) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" } !$omp end parallel end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 index 2c113893af9..9cab6d57d07 100644 --- a/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 @@ -16,7 +16,7 @@ subroutine f1 integer :: i, ior ior = 6 i = 6 -!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" } +!$omp parallel reduction (ior:i) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found" } !$omp end parallel end subroutine f1 subroutine f2 @@ -27,7 +27,7 @@ subroutine f2 end function end interface i = 6 -!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" } +!$omp parallel reduction (ior:i) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found" } i = ior (i, 3) !$omp end parallel end subroutine f2 @@ -50,7 +50,7 @@ subroutine f5 use mreduction3 integer :: i i = 6 -!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" } +!$omp parallel reduction (ior:i) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found" } i = ior (i, 7) !$omp end parallel end subroutine f5 @@ -58,7 +58,7 @@ subroutine f6 use mreduction3 integer :: i i = 6 -!$omp parallel reduction (iand:i) ! { dg-error "is not INTRINSIC procedure name" } +!$omp parallel reduction (iand:i) ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found" } i = iand (i, 18) !$omp end parallel end subroutine f6 diff --git a/gcc/testsuite/gfortran.dg/gomp/target1.f90 b/gcc/testsuite/gfortran.dg/gomp/target1.f90 new file mode 100644 index 00000000000..14db4970bdc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/target1.f90 @@ -0,0 +1,520 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +module target1 + interface + subroutine dosomething (a, n, m) + integer :: a (:), n, m + !$omp declare target + end subroutine dosomething + end interface +contains + subroutine foo (n, o, p, q, r, pp) + integer :: n, o, p, q, r, s, i, j + integer :: a (2:o) + integer, pointer :: pp + !$omp target data device (n + 1) if (n .ne. 6) map (tofrom: n, r) + !$omp target device (n + 1) if (n .ne. 6) map (from: n) map (alloc: a(2:o)) + call dosomething (a, n, 0) + !$omp end target + !$omp target teams device (n + 1) num_teams (n + 4) thread_limit (n * 2) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) + r = r + 1 + p = q + call dosomething (a, n, p + q) + !$omp end target teams + !$omp target teams distribute device (n + 1) num_teams (n + 4) collapse (2) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp target teams distribute device (n + 1) num_teams (n + 4) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end target teams distribute + !$omp target teams distribute parallel do device (n + 1) num_teams (n + 4) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) & + !$omp & ordered schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + j + end do + end do + !$omp target teams distribute parallel do device (n + 1) num_teams (n + 4) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) ordered schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + end do + !$omp end target teams distribute parallel do + !$omp target teams distribute parallel do simd device (n + 1) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) & + !$omp & schedule (static, 8) num_teams (n + 4) safelen(8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp target teams distribute parallel do simd device (n + 1) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) schedule (static, 8) & + !$omp & num_teams (n + 4) safelen(16) linear(i:1) aligned (pp:4) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end target teams distribute parallel do simd + !$omp target teams distribute simd device (n + 1) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & + !$omp & lastprivate (s) num_teams (n + 4) safelen(8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp target teams distribute simd device (n + 1) & + !$omp & if (n .ne. 6)map (from: n) map (alloc: a(2:o)) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) lastprivate (s) & + !$omp & num_teams (n + 4) safelen(16) linear(i:1) aligned (pp:4) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end target teams distribute simd + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams num_teams (n + 4) thread_limit (n * 2) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) + r = r + 1 + p = q + call dosomething (a, n, p + q) + !$omp end teams + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute num_teams (n + 4) collapse (2) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute num_teams (n + 4) default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end teams distribute + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute parallel do num_teams (n + 4) & + !$omp & if (n .ne. 6) default(shared) ordered schedule (static, 8) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + j + end do + end do + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute parallel do num_teams (n + 4)if(n.ne.6)default(shared)& + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) ordered schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + end do + !$omp end teams distribute parallel do + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute parallel do simd if(n.ne.6)default(shared)& + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) & + !$omp & schedule (static, 8) num_teams (n + 4) safelen(8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute parallel do simd if (n .ne. 6)default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) schedule (static, 8) & + !$omp & num_teams (n + 4) safelen(16) linear(i:1) aligned (pp:4) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end teams distribute parallel do simd + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute simd default(shared) safelen(8) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) collapse (2) & + !$omp & lastprivate (s) num_teams (n + 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp end target + !$omp target device (n + 1) if (n .ne. 6)map (from: n) map (alloc: a(2:o)) + !$omp teams distribute simd default(shared) aligned (pp:4) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & thread_limit (n * 2) dist_schedule (static, 4) lastprivate (s) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end teams distribute simd + !$omp end target + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction ( + : r ) + !$omp distribute collapse (2) firstprivate (q) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute firstprivate (q) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end distribute + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do if (n .ne. 6) default(shared) & + !$omp & ordered schedule (static, 8) private (p) firstprivate (q) & + !$omp & shared(n)reduction(+:r)dist_schedule(static,4)collapse(2)& + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + j + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do if(n.ne.6)default(shared)& + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) ordered schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + end do + !$omp end distribute parallel do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do simd if(n.ne.6)default(shared)& + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & dist_schedule (static, 4) collapse (2) safelen(8) & + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) & + !$omp & schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do simd if (n .ne. 6)default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) schedule (static, 8) & + !$omp & safelen(16) linear(i:1) aligned (pp:4) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end distribute parallel do simd + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute simd safelen(8) lastprivate(s) & + !$omp & private (p) firstprivate (q) reduction (+: r) & + !$omp & dist_schedule (static, 4) collapse (2) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute simd aligned (pp:4) & + !$omp & private (p) firstprivate (q) reduction (+: r) & + !$omp & dist_schedule (static, 4) lastprivate (s) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end distribute simd + !$omp end target teams + !$omp end target data + end subroutine + subroutine bar (n, o, p, r, pp) + integer :: n, o, p, q, r, s, i, j + integer :: a (2:o) + integer, pointer :: pp + common /blk/ i, j, q + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction ( + : r ) + !$omp distribute collapse (2) firstprivate (q) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute firstprivate (q) dist_schedule (static, 4) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + end do + !$omp end distribute + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do if (n .ne. 6) default(shared) & + !$omp & ordered schedule (static, 8) private (p) firstprivate (q) & + !$omp & shared(n)reduction(+:r)dist_schedule(static,4)collapse(2)& + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + j + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do if(n.ne.6)default(shared)& + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) ordered schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + call dosomething (a, n, p + q) + end do + !$omp ordered + p = q + !$omp end ordered + s = i * 10 + end do + !$omp end distribute parallel do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do simd if(n.ne.6)default(shared)& + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & dist_schedule (static, 4) collapse (2) safelen(8) & + !$omp & num_threads (n + 4) proc_bind (spread) lastprivate (s) & + !$omp & schedule (static, 8) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute parallel do simd if (n .ne. 6)default(shared) & + !$omp & private (p) firstprivate (q) shared (n) reduction (+: r) & + !$omp & dist_schedule (static, 4) num_threads (n + 4) & + !$omp & proc_bind (master) lastprivate (s) schedule (static, 8) & + !$omp & safelen(16) linear(i:1) aligned (pp:4) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end distribute parallel do simd + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute simd safelen(8) lastprivate(s) & + !$omp & private (p) firstprivate (q) reduction (+: r) & + !$omp & dist_schedule (static, 4) collapse (2) + do i = 1, 10 + do j = 1, 10 + r = r + 1 + p = q + a(2+i*10+j) = p + q + s = i * 10 + j + end do + end do + !$omp end target teams + !$omp target teams device (n + 1) if (n .ne. 6)map (from: n) & + !$omp & map (alloc: a(2:o)) num_teams (n + 4) thread_limit (n * 2) & + !$omp & default(shared) shared(n) private (p) reduction(+:r) + !$omp distribute simd aligned (pp:4) & + !$omp & private (p) firstprivate (q) reduction (+: r) & + !$omp & dist_schedule (static, 4) lastprivate (s) + do i = 1, 10 + r = r + 1 + p = q + a(1+i) = p + q + s = i * 10 + end do + !$omp end distribute simd + !$omp end target teams + end subroutine +end module diff --git a/gcc/testsuite/gfortran.dg/gomp/target2.f90 b/gcc/testsuite/gfortran.dg/gomp/target2.f90 new file mode 100644 index 00000000000..7521331fcb1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/target2.f90 @@ -0,0 +1,74 @@ +! { dg-do compile } +! { dg-options "-fopenmp -ffree-line-length-160" } + +subroutine foo (n, s, t, u, v, w) + integer :: n, i, s, t, u, v, w + common /bar/ i + !$omp simd safelen(s + 1) + do i = 1, n + end do + !$omp do schedule (static, t * 2) + do i = 1, n + end do + !$omp do simd safelen(s + 1) schedule (static, t * 2) + do i = 1, n + end do + !$omp parallel do schedule (static, t * 2) num_threads (u - 1) + do i = 1, n + end do + !$omp parallel do simd safelen(s + 1) schedule (static, t * 2) num_threads (u - 1) + do i = 1, n + end do + !$omp distribute dist_schedule (static, v + 8) + do i = 1, n + end do + !$omp distribute simd dist_schedule (static, v + 8) safelen(s + 1) + do i = 1, n + end do + !$omp distribute parallel do simd dist_schedule (static, v + 8) safelen(s + 1) & + !$omp & schedule (static, t * 2) num_threads (u - 1) + do i = 1, n + end do + !$omp distribute parallel do dist_schedule (static, v + 8) num_threads (u - 1) & + !$omp & schedule (static, t * 2) + do i = 1, n + end do + !$omp target + !$omp teams distribute dist_schedule (static, v + 8) num_teams (w + 8) + do i = 1, n + end do + !$omp end target + !$omp target + !$omp teams distribute simd dist_schedule (static, v + 8) safelen(s + 1) & + !$omp & num_teams (w + 8) + do i = 1, n + end do + !$omp end target + !$omp target + !$omp teams distribute parallel do simd dist_schedule (static, v + 8) safelen(s + 1) & + !$omp & schedule (static, t * 2) num_threads (u - 1) num_teams (w + 8) + do i = 1, n + end do + !$omp end target + !$omp target + !$omp teams distribute parallel do dist_schedule (static, v + 8) num_threads (u - 1) & + !$omp & schedule (static, t * 2) num_teams (w + 8) + do i = 1, n + end do + !$omp end target + !$omp target teams distribute dist_schedule (static, v + 8) num_teams (w + 8) + do i = 1, n + end do + !$omp target teams distribute simd dist_schedule (static, v + 8) safelen(s + 1) & + !$omp & num_teams (w + 8) + do i = 1, n + end do + !$omp target teams distribute parallel do simd dist_schedule (static, v + 8) safelen(s + 1) & + !$omp & schedule (static, t * 2) num_threads (u - 1) num_teams (w + 8) + do i = 1, n + end do + !$omp target teams distribute parallel do dist_schedule (static, v + 8) num_threads (u - 1) & + !$omp & schedule (static, t * 2) num_teams (w + 8) + do i = 1, n + end do +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/target3.f90 b/gcc/testsuite/gfortran.dg/gomp/target3.f90 new file mode 100644 index 00000000000..53a9682bf96 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/target3.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +subroutine foo (r) + integer :: i, r + !$omp target + !$omp target teams distribute parallel do reduction (+: r) ! { dg-warning "target construct inside of target region" } + do i = 1, 10 + r = r + 1 + end do + !$omp end target +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/udr1.f90 b/gcc/testsuite/gfortran.dg/gomp/udr1.f90 new file mode 100644 index 00000000000..84601310c45 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/udr1.f90 @@ -0,0 +1,41 @@ +! { dg-do compile } + +subroutine f1 +!$omp declare reduction (.le.:integer:omp_out = omp_out + omp_in) ! { dg-error "Invalid operator for" } +end subroutine f1 +subroutine f2 +!$omp declare reduction (bar:real(kind=4):omp_out = omp_out + omp_in) + real(kind=4) :: r + integer :: i + r = 0.0 +!$omp parallel do reduction (bar:r) + do i = 1, 10 + r = r + i + end do +!$omp parallel do reduction (foo:r) ! { dg-error "foo not found" } + do i = 1, 10 + r = r + i + end do +!$omp parallel do reduction (.gt.:r) ! { dg-error "cannot be used as a defined operator" } + do i = 1, 10 + r = r + i + end do +end subroutine f2 +subroutine f3 +!$omp declare reduction (foo:blah:omp_out=omp_out + omp_in) ! { dg-error "Unclassifiable OpenMP directive" } +end subroutine f3 +subroutine f4 +!$omp declare reduction (foo:integer:a => null()) ! { dg-error "Invalid character in name" } +!$omp declare reduction (foo:integer:omp_out = omp_in + omp_out) & +!$omp & initializer(a => null()) ! { dg-error "Invalid character in name" } +end subroutine f4 +subroutine f5 + integer :: a, b +!$omp declare reduction (foo:integer:a = b + 1) ! { dg-error "Variable other than OMP_OUT or OMP_IN used in combiner" } +!$omp declare reduction (bar:integer:omp_out = omp_out * omp_in) & +!$omp & initializer(b = a + 1) ! { dg-error "Variable other than OMP_PRIV or OMP_ORIG used in INITIALIZER clause" } +end subroutine f5 +subroutine f6 +!$omp declare reduction (foo:integer:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_orig=omp_priv) +end subroutine f6 diff --git a/gcc/testsuite/gfortran.dg/gomp/udr2.f90 b/gcc/testsuite/gfortran.dg/gomp/udr2.f90 new file mode 100644 index 00000000000..7038d1869d9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/udr2.f90 @@ -0,0 +1,53 @@ +! { dg-do compile } + +subroutine f6 +!$omp declare reduction (foo:real:omp_out (omp_in)) ! { dg-error "Unclassifiable OpenMP directive" } +!$omp declare reduction (bar:real:omp_out = omp_in * omp_out) & ! { dg-error "Unclassifiable OpenMP directive" } +!$omp & initializer (omp_priv (omp_orig)) +end subroutine f6 +subroutine f7 + integer :: a +!$omp declare reduction (foo:integer:a (omp_out, omp_in)) ! { dg-error "Unclassifiable OpenMP directive" } +!$omp declare reduction (bar:real:omp_out = omp_out.or.omp_in) ! { dg-error "Operands of logical operator" } +!$omp declare reduction (baz:real:omp_out = omp_out + omp_in) +!$omp & initializer (a (omp_priv, omp_orig)) ! { dg-error "Unclassifiable OpenMP directive" } + real :: r + r = 0.0 +!$omp parallel reduction (bar:r) +!$omp end parallel +end subroutine f7 +subroutine f8 + interface + subroutine f8a (x) + integer :: x + end subroutine f8a + end interface +!$omp declare reduction (baz:integer:omp_out = omp_out + omp_in) & +!$omp & initializer (f8a (omp_orig)) ! { dg-error "One of actual subroutine arguments in INITIALIZER clause" } +!$omp declare reduction (foo:integer:f8a) ! { dg-error "is not a variable" } +!$omp declare reduction (bar:integer:omp_out = omp_out - omp_in) & +!$omp & initializer (f8a) ! { dg-error "is not a variable" } +end subroutine f8 +subroutine f9 + type dt ! { dg-error "which is not consistent with the CALL" } + integer :: x = 0 + integer :: y = 0 + end type dt + integer :: i +!$omp declare reduction (foo:integer:dt (omp_out, omp_in)) ! { dg-error "which is not consistent with the CALL" } +!$omp declare reduction (bar:integer:omp_out = omp_out + omp_in) & +!$omp & initializer (dt (omp_priv, omp_orig)) ! { dg-error "which is not consistent with the CALL" } + i = 0 +!$omp parallel reduction (foo : i) +!$omp end parallel +!$omp parallel reduction (bar : i) +!$omp end parallel +end subroutine f9 +subroutine f10 + integer :: a, b +!$omp declare reduction(foo:character(len=64) & +!$omp & :omp_out(a:b) = omp_in(a:b)) ! { dg-error "Variable other than OMP_OUT or OMP_IN used in combiner" } +!$omp declare reduction(bar:character(len=16) & +!$omp & :omp_out = trim(omp_out) // omp_in) & +!$omp & initializer (omp_priv(a:b) = ' ') ! { dg-error "Variable other than OMP_PRIV or OMP_ORIG used in INITIALIZER clause" } +end subroutine f10 diff --git a/gcc/testsuite/gfortran.dg/gomp/udr3.f90 b/gcc/testsuite/gfortran.dg/gomp/udr3.f90 new file mode 100644 index 00000000000..a4feaddd1a2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/udr3.f90 @@ -0,0 +1,75 @@ +! { dg-do compile } + +subroutine f1 + type dt + logical :: l = .false. + end type + type dt2 + logical :: l = .false. + end type +!$omp declare reduction (foo:integer(kind = 4) & ! { dg-error "Previous !.OMP DECLARE REDUCTION" } +!$omp & :omp_out = omp_out + omp_in) +!$omp declare reduction (foo:integer(kind = 4) : & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION" } +!$omp & omp_out = omp_out + omp_in) +!$omp declare reduction (bar:integer, & +!$omp & real:omp_out = omp_out + omp_in) +!$omp declare reduction (baz:integer,real,integer & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION|Previous" } +!$omp & : omp_out = omp_out + omp_in) +!$omp declare reduction (id1:dt,dt2:omp_out%l=omp_out%l & +!$omp & .or.omp_in%l) +!$omp declare reduction (id2:dt,dt:omp_out%l=omp_out%l & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION|Previous" } +!$omp & .or.omp_in%l) +!$omp declare reduction (id3:dt2,dt:omp_out%l=omp_out%l & ! { dg-error "Previous !.OMP DECLARE REDUCTION" } +!$omp & .or.omp_in%l) +!$omp declare reduction (id3:dt2:omp_out%l=omp_out%l & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION" } +!$omp & .or.omp_in%l) +end subroutine f1 +subroutine f2 + interface + subroutine f2a (x, y, z) + character (len = *) :: x, y + logical :: z + end subroutine + end interface + interface f2b + subroutine f2b (x, y, z) + character (len = *, kind = 1) :: x, y + logical :: z + end subroutine + subroutine f2c (x, y, z) + character (kind = 4, len = *) :: x, y + logical :: z + end subroutine + end interface +!$omp declare reduction (foo:character(len=*): & +!$omp & f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (bar:character(len=:): & +!$omp & f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (baz:character(len=4): & +!$omp & f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (baz:character(len=5): & +!$omp & f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (baz:character(len=6): & +!$omp & f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (id:character(len=*): & ! { dg-error "Previous !.OMP DECLARE REDUCTION" } +!$omp & f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (id: & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION" } +!$omp & character(len=:) : f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION|Previous" } +!$omp (id2:character(len=*), character(len=:): & +!$omp f2a (omp_out, omp_in, .false.)) & +!$omp & initializer (f2a (omp_priv, omp_orig, .true.)) +!$omp declare reduction (id3:character(len=*, kind = 1), character(kind=4, len=:): & +!$omp f2b (omp_out, omp_in, .false.)) & +!$omp & initializer (f2b (omp_priv, omp_orig, .true.)) +!$omp declare reduction (id4:character(kind=4, len=4), character(kind =1, len=4): & +!$omp f2b (omp_out, omp_in, .false.)) & +!$omp & initializer (f2b (omp_priv, omp_orig, .true.)) +end subroutine f2 diff --git a/gcc/testsuite/gfortran.dg/gomp/udr4.f90 b/gcc/testsuite/gfortran.dg/gomp/udr4.f90 new file mode 100644 index 00000000000..b48c1090f27 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/udr4.f90 @@ -0,0 +1,74 @@ +! { dg-do compile } + +subroutine f3 +!$omp declare reduction ! { dg-error "Unclassifiable OpenMP directive" } +!$omp declare reduction foo ! { dg-error "Unclassifiable OpenMP directive" } +!$omp declare reduction (foo) ! { dg-error "Unclassifiable OpenMP directive" } +!$omp declare reduction (foo:integer) ! { dg-error "Unclassifiable OpenMP directive" } +!$omp declare reduction (foo:integer:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv=0) initializer(omp_priv=0) ! { dg-error "Unexpected junk after" } +end subroutine f3 +subroutine f4 + implicit integer (o) + implicit real (b) +!$omp declare reduction (foo:integer:omp_priv(omp_out,omp_in)) ! { dg-error "Implicitly declared subroutine omp_priv" } +!$omp declare reduction (foo:real:bar(omp_out,omp_in)) ! { dg-error "Implicitly declared subroutine bar used" } +!$omp declare reduction (bar:integer:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_out (omp_priv)) ! { dg-error "Implicitly declared subroutine omp_out used" } +!$omp declare reduction (bar:real:omp_out=omp_out+omp_in) & +!$omp & initializer(bar (omp_priv, omp_orig)) ! { dg-error "Implicitly declared subroutine bar used" } +!$omp declare reduction (id1:integer:omp_out=omp_orig(omp_out,omp_in)) ! { dg-error "Implicitly declared function omp_orig used" } +!$omp declare reduction (id1:real:omp_out=foo(omp_out,omp_in)) ! { dg-error "Implicitly declared function foo used" } +!$omp declare reduction (id2:integer:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv = omp_in (omp_orig)) ! { dg-error "Implicitly declared function omp_in used" } +!$omp declare reduction (id2:real:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv = baz (omp_orig)) ! { dg-error "Implicitly declared function baz used" } + integer :: i + real :: r + i = 0 + r = 0 +!$omp parallel reduction (foo: i, r) +!$omp end parallel +!$omp parallel reduction (bar: i, r) +!$omp end parallel +!$omp parallel reduction (id1: i, r) +!$omp end parallel +!$omp parallel reduction (id2: i, r) +!$omp end parallel +end subroutine f4 +subroutine f5 + interface + subroutine f5a (x, *, y) + double precision :: x, y + end subroutine f5a + end interface +!$omp declare reduction (foo:double precision: & ! { dg-error "Subroutine call with alternate returns in combiner" } +!$omp & f5a (omp_out, *10, omp_in)) +!$omp declare reduction (bar:double precision: & +!$omp omp_out = omp_in + omp_out) & +!$omp & initializer (f5a (omp_priv, *20, omp_orig)) ! { dg-error "Subroutine call with alternate returns in INITIALIZER clause" } +10 continue +20 continue +end subroutine f5 +subroutine f6 + integer :: a +!$omp declare reduction(foo:character(len=a*2) & ! { dg-error "cannot appear in the expression|not constant" } +!$omp & :omp_out=trim(omp_out)//omp_in) & +!$omp & initializer(omp_priv=' ') +end subroutine f6 +subroutine f7 + type dt1 + integer :: a = 1 + integer :: b + end type + type dt2 + integer :: a = 2 + integer :: b = 3 + end type + type dt3 + integer :: a + integer :: b + end type dt3 +!$omp declare reduction(foo:dt1,dt2:omp_out%a=omp_out%a+omp_in%a) +!$omp declare reduction(foo:dt3:omp_out%a=omp_out%a+omp_in%a) ! { dg-error "Missing INITIALIZER clause for !.OMP DECLARE REDUCTION of derived type without default initializer" } +end subroutine f7 diff --git a/gcc/testsuite/gfortran.dg/gomp/udr5.f90 b/gcc/testsuite/gfortran.dg/gomp/udr5.f90 new file mode 100644 index 00000000000..aebeee3a243 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/udr5.f90 @@ -0,0 +1,59 @@ +! { dg-do compile } + +module udr5m1 + type dt + real :: r + end type dt +end module udr5m1 +module udr5m2 + use udr5m1 + interface operator(+) + module procedure addm2 + end interface +!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) +!$omp declare reduction(.myadd.:dt:omp_out=omp_out.myadd.omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) + interface operator(.myadd.) + module procedure addm2 + end interface +contains + type(dt) function addm2 (x, y) + type(dt), intent (in):: x, y + addm2%r = x%r + y%r + end function +end module udr5m2 +module udr5m3 + use udr5m1 + interface operator(.myadd.) + module procedure addm3 + end interface +!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) +!$omp declare reduction(.myadd.:dt:omp_out=omp_out.myadd.omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) + interface operator(+) + module procedure addm3 + end interface +contains + type(dt) function addm3 (x, y) + type(dt), intent (in):: x, y + addm3%r = x%r + y%r + end function +end module udr5m3 +subroutine f1 + use udr5m2 + type(dt) :: d, e + integer :: i + d=dt(0.0) + e = dt (0.0) +!$omp parallel do reduction (+ : d) reduction ( .myadd. : e) + do i=1,100 + d=d+dt(i) + e=e+dt(i) + end do +end subroutine f1 +subroutine f2 + use udr5m3 ! { dg-error "Previous !.OMP DECLARE REDUCTION|Ambiguous interfaces" } + use udr5m2 ! { dg-error "Ambiguous !.OMP DECLARE REDUCTION" } +end subroutine f2 diff --git a/gcc/testsuite/gfortran.dg/gomp/udr6.f90 b/gcc/testsuite/gfortran.dg/gomp/udr6.f90 new file mode 100644 index 00000000000..92fc5bb1be5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/udr6.f90 @@ -0,0 +1,205 @@ +! { dg-do compile } +! { dg-options "-fmax-errors=1000 -fopenmp -ffree-line-length-160" } + +module udr6 + type dt + integer :: i + end type +end module udr6 +subroutine f1 + use udr6, only : dt +!$omp declare reduction (+:integer:omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (+:real(kind=4):omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (+:double precision:omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (+:integer(kind=8),integer(kind=1) & ! { dg-error "Redefinition of predefined" } +!$omp & :omp_out = omp_out + omp_in) +!$omp declare reduction (+:complex:omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (+:complex(kind=8):omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(+) + function addf1 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: addf1 + end function + end interface +end subroutine f1 +subroutine f2 + use udr6, only : dt + interface operator(-) + function subf2 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: subf2 + end function + end interface +!$omp declare reduction (-:integer:omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (-:real(kind=4):omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (-:double precision:omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (-:integer(kind=8),integer(kind=1) & ! { dg-error "Redefinition of predefined" } +!$omp & :omp_out = omp_out + omp_in) +!$omp declare reduction (-:complex:omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (-:complex(kind=8):omp_out = omp_out + omp_in) ! { dg-error "Redefinition of predefined" } +end subroutine f2 +subroutine f3 + use udr6, only : dt + interface operator(*) + function mulf3 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: mulf3 + end function + end interface +!$omp declare reduction (*:integer:omp_out = omp_out * omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (*:real(kind=4):omp_out = omp_out * omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (*:double precision:omp_out = omp_out * omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (*:integer(kind=8),integer(kind=1) & ! { dg-error "Redefinition of predefined" } +!$omp & :omp_out = omp_out * omp_in) +!$omp declare reduction (*:complex:omp_out = omp_out * omp_in) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (*:complex(kind=8):omp_out = omp_out * omp_in) ! { dg-error "Redefinition of predefined" } +end subroutine f3 +subroutine f4 + use udr6, only : dt + interface operator(.and.) + function andf4 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: andf4 + end function + end interface +!$omp declare reduction (.neqv.:logical:omp_out = omp_out .or. omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(.or.) + function orf4 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: orf4 + end function + end interface +!$omp declare reduction (.eqv.:logical:omp_out = omp_out .or. omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(.eqv.) + function eqvf4 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: eqvf4 + end function + end interface +!$omp declare reduction (.or.:logical:omp_out = omp_out .or. omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(.neqv.) + function neqvf4 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: neqvf4 + end function + end interface +!$omp declare reduction (.and.:logical:omp_out = omp_out .and. omp_in) ! { dg-error "Redefinition of predefined" } +end subroutine f4 +subroutine f5 + use udr6, only : dt + interface operator(.and.) + function andf5 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: andf5 + end function + end interface +!$omp declare reduction (.neqv.:logical(kind =4):omp_out = omp_out .neqv. omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(.or.) + function orf5 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: orf5 + end function + end interface +!$omp declare reduction (.eqv.:logical(kind= 4):omp_out = omp_out .eqv. omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(.eqv.) + function eqvf5 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: eqvf5 + end function + end interface +!$omp declare reduction (.or.:logical(kind=4):omp_out = omp_out .or. omp_in) ! { dg-error "Redefinition of predefined" } + interface operator(.neqv.) + function neqvf5 (x, y) + use udr6, only : dt + type(dt), intent (in) :: x, y + type(dt) :: neqvf5 + end function + end interface +!$omp declare reduction (.and.:logical(kind = 4):omp_out = omp_out .and. omp_in) ! { dg-error "Redefinition of predefined" } +end subroutine f5 +subroutine f6 +!$omp declare reduction (min:integer:omp_out = min (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (max:integer:omp_out = max (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (iand:integer:omp_out = iand (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (ior:integer:omp_out = ior (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (ieor:integer:omp_out = ieor (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (min:real:omp_out = min (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (max:real:omp_out = max (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (min:double precision:omp_out = min (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (max:double precision:omp_out = max (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +end subroutine f6 +subroutine f7 +!$omp declare reduction (min:integer(kind=2):omp_out = min (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (max:integer(kind=4):omp_out = max (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (iand:integer(kind=1):omp_out = iand (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (ior:integer(kind=8):omp_out = ior (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (ieor:integer(kind=4):omp_out = ieor (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (min:real(kind=4):omp_out = min (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (max:real(kind=4):omp_out = max (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (min:double precision:omp_out = min (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +!$omp declare reduction (max:double precision:omp_out = max (omp_out, omp_in)) ! { dg-error "Redefinition of predefined" } +end subroutine f7 +subroutine f8 + integer :: min +!$omp declare reduction (min:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (min:real:omp_out = omp_out + omp_in) +!$omp declare reduction (min:double precision:omp_out = omp_out + omp_in) +end subroutine f8 +subroutine f9 + integer :: max +!$omp declare reduction (max:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (max:real:omp_out = omp_out + omp_in) +!$omp declare reduction (max:double precision:omp_out = omp_out + omp_in) +end subroutine f9 +subroutine f10 + integer :: iand +!$omp declare reduction (iand:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (iand:real:omp_out = omp_out + omp_in) +end subroutine f10 +subroutine f11 + integer :: ior +!$omp declare reduction (ior:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (ior:real:omp_out = omp_out + omp_in) +end subroutine f11 +subroutine f12 + integer :: ieor +!$omp declare reduction (ieor:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (ieor:real:omp_out = omp_out + omp_in) +end subroutine f12 +subroutine f13 +!$omp declare reduction (min:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (min:real:omp_out = omp_out + omp_in) +!$omp declare reduction (min:double precision:omp_out = omp_out + omp_in) + integer :: min +end subroutine f13 +subroutine f14 +!$omp declare reduction (max:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (max:real:omp_out = omp_out + omp_in) +!$omp declare reduction (max:double precision:omp_out = omp_out + omp_in) + integer :: max +end subroutine f14 +subroutine f15 +!$omp declare reduction (iand:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (iand:real:omp_out = omp_out + omp_in) + integer :: iand +end subroutine f15 +subroutine f16 +!$omp declare reduction (ior:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (ior:real:omp_out = omp_out + omp_in) + integer :: ior +end subroutine f16 +subroutine f17 +!$omp declare reduction (ieor:integer:omp_out = omp_out + omp_in) +!$omp declare reduction (ieor:real:omp_out = omp_out + omp_in) + integer :: ieor +end subroutine f17 diff --git a/gcc/testsuite/gfortran.dg/gomp/udr7.f90 b/gcc/testsuite/gfortran.dg/gomp/udr7.f90 new file mode 100644 index 00000000000..230a3fc44dd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/udr7.f90 @@ -0,0 +1,90 @@ +! { dg-do compile } + +module udr7m1 + type dt + real :: r + end type dt +end module udr7m1 +module udr7m2 + use udr7m1 + interface operator(+) + module procedure addm2 + end interface +!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) +!$omp declare reduction(.myadd.:dt:omp_out=omp_out.myadd.omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) + interface operator(.myadd.) + module procedure addm2 + end interface + private + public :: operator(+), operator(.myadd.), dt +contains + type(dt) function addm2 (x, y) + type(dt), intent (in):: x, y + addm2%r = x%r + y%r + end function +end module udr7m2 +module udr7m3 + use udr7m1 + private + public :: operator(.myadd.), operator(+), dt + interface operator(.myadd.) + module procedure addm3 + end interface +!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) +!$omp declare reduction(.myadd.:dt:omp_out=omp_out.myadd.omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) + interface operator(+) + module procedure addm3 + end interface +contains + type(dt) function addm3 (x, y) + type(dt), intent (in):: x, y + addm3%r = x%r + y%r + end function +end module udr7m3 +module udr7m4 + use udr7m1 + private + interface operator(.myadd.) + module procedure addm4 + end interface +!$omp declare reduction(+:dt:omp_out=omp_out+omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) +!$omp declare reduction(.myadd.:dt:omp_out=omp_out.myadd.omp_in) & +!$omp & initializer(omp_priv=dt(0.0)) + interface operator(+) + module procedure addm4 + end interface +contains + type(dt) function addm4 (x, y) + type(dt), intent (in):: x, y + addm4%r = x%r + y%r + end function +end module udr7m4 +subroutine f1 + use udr7m2 + type(dt) :: d, e + integer :: i + d=dt(0.0) + e = dt (0.0) +!$omp parallel do reduction (+ : d) reduction ( .myadd. : e) + do i=1,100 + d=d+dt(i) + e=e+dt(i) + end do +end subroutine f1 +subroutine f2 + use udr7m3 ! { dg-error "Previous !.OMP DECLARE REDUCTION|Ambiguous interfaces" } + use udr7m2 ! { dg-error "Ambiguous !.OMP DECLARE REDUCTION" } +end subroutine f2 +subroutine f3 + use udr7m4 + use udr7m2 +end subroutine f3 +subroutine f4 + use udr7m3 + use udr7m4 +end subroutine f4 diff --git a/gcc/testsuite/gfortran.dg/gomp/udr8.f90 b/gcc/testsuite/gfortran.dg/gomp/udr8.f90 new file mode 100644 index 00000000000..e040b3d1e8b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/udr8.f90 @@ -0,0 +1,351 @@ +! { dg-do compile } +! { dg-options "-fmax-errors=1000 -fopenmp" } + +module m +contains + function fn1 (x, y) + integer, intent(in) :: x, y + integer :: fn1 + fn1 = x + 2 * y + end function + subroutine sub1 (x, y) + integer, intent(in) :: y + integer, intent(out) :: x + x = y + end subroutine + function fn2 (x) + integer, intent(in) :: x + integer :: fn2 + fn2 = x + end function + subroutine sub2 (x, y) + integer, intent(in) :: y + integer, intent(inout) :: x + x = x + y + end subroutine + function fn3 (x, y) + integer, intent(in) :: x(:), y(:) + integer :: fn3(lbound(x, 1):ubound(x, 1)) + fn3 = x + 2 * y + end function + subroutine sub3 (x, y) + integer, intent(in) :: y(:) + integer, intent(out) :: x(:) + x = y + end subroutine + function fn4 (x) + integer, intent(in) :: x(:) + integer :: fn4(lbound(x, 1):ubound(x, 1)) + fn4 = x + end function + subroutine sub4 (x, y) + integer, intent(in) :: y(:) + integer, intent(inout) :: x(:) + x = x + y + end subroutine + function fn5 (x, y) + integer, intent(in) :: x(10), y(10) + integer :: fn5(10) + fn5 = x + 2 * y + end function + subroutine sub5 (x, y) + integer, intent(in) :: y(10) + integer, intent(out) :: x(10) + x = y + end subroutine + function fn6 (x) + integer, intent(in) :: x(10) + integer :: fn6(10) + fn6 = x + end function + subroutine sub6 (x, y) + integer, intent(in) :: y(10) + integer, intent(inout) :: x(10) + x = x + y + end subroutine + function fn7 (x, y) + integer, allocatable, intent(in) :: x(:), y(:) + integer, allocatable :: fn7(:) + fn7 = x + 2 * y + end function + subroutine sub7 (x, y) + integer, allocatable, intent(in) :: y(:) + integer, allocatable, intent(out) :: x(:) + x = y + end subroutine + function fn8 (x) + integer, allocatable, intent(in) :: x(:) + integer, allocatable :: fn8(:) + fn8 = x + end function + subroutine sub8 (x, y) + integer, allocatable, intent(in) :: y(:) + integer, allocatable, intent(inout) :: x(:) + x = x + y + end subroutine +end module +subroutine test1 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } +!$omp & initializer (sub1 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } +!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } +!$omp initializer (omp_priv = fn2 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } + integer :: a(10) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test1 +subroutine test2 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & +!$omp & initializer (sub1 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn2 (omp_orig)) + integer :: a +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test2 +subroutine test3 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } +!$omp & initializer (sub1 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } +!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } +!$omp initializer (omp_priv = fn2 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" } + integer, allocatable :: a(:) + allocate (a(10)) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test3 +subroutine test4 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & +!$omp & initializer (sub1 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn2 (omp_orig)) + integer, allocatable :: a + allocate (a) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test4 +subroutine test5 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) & +!$omp & initializer (sub3 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn4 (omp_orig)) + integer :: a(10) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test5 +subroutine test6 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } +!$omp & initializer (sub3 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp initializer (omp_priv = fn4 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } + integer :: a +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test6 +subroutine test7 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) & +!$omp & initializer (sub3 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn4 (omp_orig)) + integer, allocatable :: a(:) + allocate (a(10)) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test7 +subroutine test8 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } +!$omp & initializer (sub3 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp initializer (omp_priv = fn4 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } + integer, allocatable :: a + allocate (a) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test8 +subroutine test9 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) & +!$omp & initializer (sub5 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn6 (omp_orig)) + integer :: a(10) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test9 +subroutine test10 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } +!$omp & initializer (sub5 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp initializer (omp_priv = fn6 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } + integer :: a +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test10 +subroutine test11 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) & +!$omp & initializer (sub5 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn6 (omp_orig)) + integer, allocatable :: a(:) + allocate (a(10)) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test11 +subroutine test12 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } +!$omp & initializer (sub5 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp initializer (omp_priv = fn6 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } + integer, allocatable :: a + allocate (a) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test12 +subroutine test13 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = & ! { dg-error "Different shape for array assignment at \[^\n\r]* on dimension 1 .9 and 10" } +!$omp & fn5 (omp_out, omp_in)) & ! { dg-warning "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" } +!$omp & initializer (sub5 (omp_priv, omp_orig)) ! { dg-warning "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" } +!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & ! { dg-warning "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" } +!$omp initializer (omp_priv = & ! { dg-error "Different shape for array assignment at \[^\n\r]* on dimension 1 .9 and 10" } +!$omp & fn6 (omp_orig)) ! { dg-warning "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" } + integer :: a(9) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test13 +subroutine test14 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" } +!$omp & initializer (sub7 (omp_priv, omp_orig)) ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" } +!$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" } +!$omp initializer (omp_priv = fn8 (omp_orig)) ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" } + integer :: a(10) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test14 +subroutine test15 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } +!$omp & initializer (sub7 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp initializer (omp_priv = fn8 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } + integer :: a +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test15 +subroutine test16 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & +!$omp & initializer (sub7 (omp_priv, omp_orig)) +!$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & +!$omp initializer (omp_priv = fn8 (omp_orig)) + integer, allocatable :: a(:) + allocate (a(10)) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test16 +subroutine test17 + use m +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) +!$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } +!$omp & initializer (sub7 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" } +!$omp initializer (omp_priv = fn8 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" } + integer, allocatable :: a + allocate (a) +!$omp parallel reduction (foo : a) +!$omp end parallel +!$omp parallel reduction (bar : a) +!$omp end parallel +!$omp parallel reduction (baz : a) +!$omp end parallel +end subroutine test17 diff --git a/gcc/testsuite/gfortran.dg/nint_2.f90 b/gcc/testsuite/gfortran.dg/nint_2.f90 index 9f2705318fb..0727136dfc9 100644 --- a/gcc/testsuite/gfortran.dg/nint_2.f90 +++ b/gcc/testsuite/gfortran.dg/nint_2.f90 @@ -4,7 +4,8 @@ ! http://gcc.gnu.org/ml/fortran/2005-04/msg00139.html ! ! { dg-do run } -! { dg-xfail-run-if "PR 33271, math library bug" { powerpc-ibm-aix* powerpc*-*-linux* *-*-mingw* } { "-O0" } { "" } } +! { dg-xfail-run-if "PR 33271, math library bug" { powerpc-ibm-aix* powerpc-*-linux* powerpc64-*-linux* *-*-mingw* } { "-O0" } { "" } } +! Note that this doesn't fail on powerpc64le-*-linux*. real(kind=8) :: a integer(kind=8) :: i1, i2 real :: b diff --git a/gcc/testsuite/gfortran.dg/oldstyle_5.f b/gcc/testsuite/gfortran.dg/oldstyle_5.f new file mode 100644 index 00000000000..8a0d3119fb4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/oldstyle_5.f @@ -0,0 +1,8 @@ +C { dg-do compile } + TYPE T + INTEGER A(2)/1,2/ ! { dg-error "Invalid old style initialization for derived type component" } + END TYPE + TYPE S + INTEGER B/1/ ! { dg-error "Invalid old style initialization for derived type component" } + END TYPE + END diff --git a/gcc/testsuite/gfortran.dg/openmp-define-3.f90 b/gcc/testsuite/gfortran.dg/openmp-define-3.f90 index 3d559864faf..44d5c9de49b 100644 --- a/gcc/testsuite/gfortran.dg/openmp-define-3.f90 +++ b/gcc/testsuite/gfortran.dg/openmp-define-3.f90 @@ -6,6 +6,6 @@ # error _OPENMP not defined #endif -#if _OPENMP != 201107 +#if _OPENMP != 201307 # error _OPENMP defined to wrong value #endif diff --git a/gcc/testsuite/gfortran.dg/round_4.f90 b/gcc/testsuite/gfortran.dg/round_4.f90 index 975cb20e440..f60e1f785f7 100644 --- a/gcc/testsuite/gfortran.dg/round_4.f90 +++ b/gcc/testsuite/gfortran.dg/round_4.f90 @@ -1,6 +1,7 @@ ! { dg-do run } ! { dg-add-options ieee } ! { dg-skip-if "PR libfortran/58015" { *-*-solaris2.9* hppa*-*-hpux* } } +! { dg-skip-if "IBM long double 31 bits of precision, test requires 38" { powerpc*-*-linux* } } ! ! PR fortran/35862 ! diff --git a/gcc/tree-core.h b/gcc/tree-core.h index 75c1e3fc275..40443d4ef4e 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -1127,6 +1127,11 @@ enum omp_clause_map_kind array sections. OMP_CLAUSE_SIZE for these is not the pointer size, which is implicitly POINTER_SIZE / BITS_PER_UNIT, but the bias. */ OMP_CLAUSE_MAP_POINTER, + /* Also internal, behaves like OMP_CLAUS_MAP_TO, but additionally any + OMP_CLAUSE_MAP_POINTER records consecutive after it which have addresses + falling into that range will not be ignored if OMP_CLAUSE_MAP_TO_PSET + wasn't mapped already. */ + OMP_CLAUSE_MAP_TO_PSET, OMP_CLAUSE_MAP_LAST }; diff --git a/gcc/tree-nested.c b/gcc/tree-nested.c index 9c175de4e9d..28753c16c89 100644 --- a/gcc/tree-nested.c +++ b/gcc/tree-nested.c @@ -1085,6 +1085,10 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_LINEAR: if (OMP_CLAUSE_LINEAR_GIMPLE_SEQ (clause)) need_stmts = true; + wi->val_only = true; + wi->is_lhs = false; + convert_nonlocal_reference_op (&OMP_CLAUSE_LINEAR_STEP (clause), + &dummy, wi); goto do_decl_clause; case OMP_CLAUSE_PRIVATE: @@ -1112,10 +1116,64 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_FINAL: case OMP_CLAUSE_IF: case OMP_CLAUSE_NUM_THREADS: + case OMP_CLAUSE_DEPEND: + case OMP_CLAUSE_DEVICE: + case OMP_CLAUSE_NUM_TEAMS: + case OMP_CLAUSE_THREAD_LIMIT: + case OMP_CLAUSE_SAFELEN: wi->val_only = true; wi->is_lhs = false; convert_nonlocal_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), - &dummy, wi); + &dummy, wi); + break; + + case OMP_CLAUSE_DIST_SCHEDULE: + if (OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (clause) != NULL) + { + wi->val_only = true; + wi->is_lhs = false; + convert_nonlocal_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), + &dummy, wi); + } + break; + + case OMP_CLAUSE_MAP: + case OMP_CLAUSE_TO: + case OMP_CLAUSE_FROM: + if (OMP_CLAUSE_SIZE (clause)) + { + wi->val_only = true; + wi->is_lhs = false; + convert_nonlocal_reference_op (&OMP_CLAUSE_SIZE (clause), + &dummy, wi); + } + if (DECL_P (OMP_CLAUSE_DECL (clause))) + goto do_decl_clause; + wi->val_only = true; + wi->is_lhs = false; + walk_tree (&OMP_CLAUSE_DECL (clause), convert_nonlocal_reference_op, + wi, NULL); + break; + + case OMP_CLAUSE_ALIGNED: + if (OMP_CLAUSE_ALIGNED_ALIGNMENT (clause)) + { + wi->val_only = true; + wi->is_lhs = false; + convert_nonlocal_reference_op + (&OMP_CLAUSE_ALIGNED_ALIGNMENT (clause), &dummy, wi); + } + /* Like do_decl_clause, but don't add any suppression. */ + decl = OMP_CLAUSE_DECL (clause); + if (TREE_CODE (decl) == VAR_DECL + && (TREE_STATIC (decl) || DECL_EXTERNAL (decl))) + break; + if (decl_function_context (decl) != info->context) + { + OMP_CLAUSE_DECL (clause) = get_nonlocal_debug_decl (info, decl); + if (OMP_CLAUSE_CODE (clause) != OMP_CLAUSE_PRIVATE) + need_chain = true; + } break; case OMP_CLAUSE_NOWAIT: @@ -1125,6 +1183,7 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_COLLAPSE: case OMP_CLAUSE_UNTIED: case OMP_CLAUSE_MERGEABLE: + case OMP_CLAUSE_PROC_BIND: break; default: @@ -1315,10 +1374,42 @@ convert_nonlocal_reference_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p, break; case GIMPLE_OMP_TARGET: + if (gimple_omp_target_kind (stmt) != GF_OMP_TARGET_KIND_REGION) + { + save_suppress = info->suppress_expansion; + convert_nonlocal_omp_clauses (gimple_omp_target_clauses_ptr (stmt), + wi); + info->suppress_expansion = save_suppress; + walk_body (convert_nonlocal_reference_stmt, + convert_nonlocal_reference_op, info, + gimple_omp_body_ptr (stmt)); + break; + } save_suppress = info->suppress_expansion; - convert_nonlocal_omp_clauses (gimple_omp_target_clauses_ptr (stmt), wi); + if (convert_nonlocal_omp_clauses (gimple_omp_target_clauses_ptr (stmt), + wi)) + { + tree c, decl; + decl = get_chain_decl (info); + c = build_omp_clause (gimple_location (stmt), OMP_CLAUSE_MAP); + OMP_CLAUSE_DECL (c) = decl; + OMP_CLAUSE_MAP_KIND (c) = OMP_CLAUSE_MAP_TO; + OMP_CLAUSE_SIZE (c) = DECL_SIZE_UNIT (decl); + OMP_CLAUSE_CHAIN (c) = gimple_omp_target_clauses (stmt); + gimple_omp_target_set_clauses (stmt, c); + } + + save_local_var_chain = info->new_local_var_chain; + info->new_local_var_chain = NULL; + walk_body (convert_nonlocal_reference_stmt, convert_nonlocal_reference_op, info, gimple_omp_body_ptr (stmt)); + + if (info->new_local_var_chain) + declare_vars (info->new_local_var_chain, + gimple_seq_first_stmt (gimple_omp_body (stmt)), + false); + info->new_local_var_chain = save_local_var_chain; info->suppress_expansion = save_suppress; break; @@ -1619,6 +1710,10 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_LINEAR: if (OMP_CLAUSE_LINEAR_GIMPLE_SEQ (clause)) need_stmts = true; + wi->val_only = true; + wi->is_lhs = false; + convert_local_reference_op (&OMP_CLAUSE_LINEAR_STEP (clause), &dummy, + wi); goto do_decl_clause; case OMP_CLAUSE_PRIVATE: @@ -1651,12 +1746,71 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_FINAL: case OMP_CLAUSE_IF: case OMP_CLAUSE_NUM_THREADS: + case OMP_CLAUSE_DEPEND: + case OMP_CLAUSE_DEVICE: + case OMP_CLAUSE_NUM_TEAMS: + case OMP_CLAUSE_THREAD_LIMIT: + case OMP_CLAUSE_SAFELEN: wi->val_only = true; wi->is_lhs = false; convert_local_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), &dummy, wi); break; + case OMP_CLAUSE_DIST_SCHEDULE: + if (OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (clause) != NULL) + { + wi->val_only = true; + wi->is_lhs = false; + convert_local_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), + &dummy, wi); + } + break; + + case OMP_CLAUSE_MAP: + case OMP_CLAUSE_TO: + case OMP_CLAUSE_FROM: + if (OMP_CLAUSE_SIZE (clause)) + { + wi->val_only = true; + wi->is_lhs = false; + convert_local_reference_op (&OMP_CLAUSE_SIZE (clause), + &dummy, wi); + } + if (DECL_P (OMP_CLAUSE_DECL (clause))) + goto do_decl_clause; + wi->val_only = true; + wi->is_lhs = false; + walk_tree (&OMP_CLAUSE_DECL (clause), convert_local_reference_op, + wi, NULL); + break; + + case OMP_CLAUSE_ALIGNED: + if (OMP_CLAUSE_ALIGNED_ALIGNMENT (clause)) + { + wi->val_only = true; + wi->is_lhs = false; + convert_local_reference_op + (&OMP_CLAUSE_ALIGNED_ALIGNMENT (clause), &dummy, wi); + } + /* Like do_decl_clause, but don't add any suppression. */ + decl = OMP_CLAUSE_DECL (clause); + if (TREE_CODE (decl) == VAR_DECL + && (TREE_STATIC (decl) || DECL_EXTERNAL (decl))) + break; + if (decl_function_context (decl) == info->context + && !use_pointer_in_frame (decl)) + { + tree field = lookup_field_for_decl (info, decl, NO_INSERT); + if (field) + { + OMP_CLAUSE_DECL (clause) + = get_local_debug_decl (info, decl, field); + need_frame = true; + } + } + break; + case OMP_CLAUSE_NOWAIT: case OMP_CLAUSE_ORDERED: case OMP_CLAUSE_DEFAULT: @@ -1664,6 +1818,7 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi) case OMP_CLAUSE_COLLAPSE: case OMP_CLAUSE_UNTIED: case OMP_CLAUSE_MERGEABLE: + case OMP_CLAUSE_PROC_BIND: break; default: @@ -1785,10 +1940,38 @@ convert_local_reference_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p, break; case GIMPLE_OMP_TARGET: + if (gimple_omp_target_kind (stmt) != GF_OMP_TARGET_KIND_REGION) + { + save_suppress = info->suppress_expansion; + convert_local_omp_clauses (gimple_omp_target_clauses_ptr (stmt), wi); + info->suppress_expansion = save_suppress; + walk_body (convert_local_reference_stmt, convert_local_reference_op, + info, gimple_omp_body_ptr (stmt)); + break; + } save_suppress = info->suppress_expansion; - convert_local_omp_clauses (gimple_omp_target_clauses_ptr (stmt), wi); - walk_body (convert_local_reference_stmt, convert_local_reference_op, - info, gimple_omp_body_ptr (stmt)); + if (convert_local_omp_clauses (gimple_omp_target_clauses_ptr (stmt), wi)) + { + tree c; + (void) get_frame_type (info); + c = build_omp_clause (gimple_location (stmt), OMP_CLAUSE_MAP); + OMP_CLAUSE_DECL (c) = info->frame_decl; + OMP_CLAUSE_MAP_KIND (c) = OMP_CLAUSE_MAP_TOFROM; + OMP_CLAUSE_SIZE (c) = DECL_SIZE_UNIT (info->frame_decl); + OMP_CLAUSE_CHAIN (c) = gimple_omp_target_clauses (stmt); + gimple_omp_target_set_clauses (stmt, c); + } + + save_local_var_chain = info->new_local_var_chain; + info->new_local_var_chain = NULL; + + walk_body (convert_local_reference_stmt, convert_local_reference_op, info, + gimple_omp_body_ptr (stmt)); + + if (info->new_local_var_chain) + declare_vars (info->new_local_var_chain, + gimple_seq_first_stmt (gimple_omp_body (stmt)), false); + info->new_local_var_chain = save_local_var_chain; info->suppress_expansion = save_suppress; break; @@ -2089,6 +2272,13 @@ convert_tramp_reference_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p, break; } + case GIMPLE_OMP_TARGET: + if (gimple_omp_target_kind (stmt) != GF_OMP_TARGET_KIND_REGION) + { + *handled_ops_p = false; + return NULL_TREE; + } + /* FALLTHRU */ case GIMPLE_OMP_PARALLEL: case GIMPLE_OMP_TASK: { @@ -2109,7 +2299,6 @@ convert_tramp_reference_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p, default: *handled_ops_p = false; return NULL_TREE; - break; } *handled_ops_p = true; @@ -2181,6 +2370,42 @@ convert_gimple_call (gimple_stmt_iterator *gsi, bool *handled_ops_p, info->static_chain_added |= save_static_chain_added; break; + case GIMPLE_OMP_TARGET: + if (gimple_omp_target_kind (stmt) != GF_OMP_TARGET_KIND_REGION) + { + walk_body (convert_gimple_call, NULL, info, gimple_omp_body_ptr (stmt)); + break; + } + save_static_chain_added = info->static_chain_added; + info->static_chain_added = 0; + walk_body (convert_gimple_call, NULL, info, gimple_omp_body_ptr (stmt)); + for (i = 0; i < 2; i++) + { + tree c, decl; + if ((info->static_chain_added & (1 << i)) == 0) + continue; + decl = i ? get_chain_decl (info) : info->frame_decl; + /* Don't add CHAIN.* or FRAME.* twice. */ + for (c = gimple_omp_target_clauses (stmt); + c; + c = OMP_CLAUSE_CHAIN (c)) + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP + && OMP_CLAUSE_DECL (c) == decl) + break; + if (c == NULL) + { + c = build_omp_clause (gimple_location (stmt), OMP_CLAUSE_MAP); + OMP_CLAUSE_DECL (c) = decl; + OMP_CLAUSE_MAP_KIND (c) + = i ? OMP_CLAUSE_MAP_TO : OMP_CLAUSE_MAP_TOFROM; + OMP_CLAUSE_SIZE (c) = DECL_SIZE_UNIT (decl); + OMP_CLAUSE_CHAIN (c) = gimple_omp_target_clauses (stmt); + gimple_omp_target_set_clauses (stmt, c); + } + } + info->static_chain_added |= save_static_chain_added; + break; + case GIMPLE_OMP_FOR: walk_body (convert_gimple_call, NULL, info, gimple_omp_for_pre_body_ptr (stmt)); @@ -2188,7 +2413,6 @@ convert_gimple_call (gimple_stmt_iterator *gsi, bool *handled_ops_p, case GIMPLE_OMP_SECTIONS: case GIMPLE_OMP_SECTION: case GIMPLE_OMP_SINGLE: - case GIMPLE_OMP_TARGET: case GIMPLE_OMP_TEAMS: case GIMPLE_OMP_MASTER: case GIMPLE_OMP_TASKGROUP: diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c index 83d5ca62d6c..d6f39d882a5 100644 --- a/gcc/tree-pretty-print.c +++ b/gcc/tree-pretty-print.c @@ -499,6 +499,7 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags) pp_string (buffer, "alloc"); break; case OMP_CLAUSE_MAP_TO: + case OMP_CLAUSE_MAP_TO_PSET: pp_string (buffer, "to"); break; case OMP_CLAUSE_MAP_FROM: @@ -519,6 +520,9 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags) if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_MAP && OMP_CLAUSE_MAP_KIND (clause) == OMP_CLAUSE_MAP_POINTER) pp_string (buffer, " [pointer assign, bias: "); + else if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_MAP + && OMP_CLAUSE_MAP_KIND (clause) == OMP_CLAUSE_MAP_TO_PSET) + pp_string (buffer, " [pointer set, len: "); else pp_string (buffer, " [len: "); dump_generic_node (buffer, OMP_CLAUSE_SIZE (clause), diff --git a/gcc/tree-ssa-ifcombine.c b/gcc/tree-ssa-ifcombine.c index 6d8349c3156..d02d72b9e4d 100644 --- a/gcc/tree-ssa-ifcombine.c +++ b/gcc/tree-ssa-ifcombine.c @@ -233,7 +233,8 @@ recognize_single_bit_test (gimple cond, tree *name, tree *bit, bool inv) while (is_gimple_assign (stmt) && ((CONVERT_EXPR_CODE_P (gimple_assign_rhs_code (stmt)) && (TYPE_PRECISION (TREE_TYPE (gimple_assign_lhs (stmt))) - <= TYPE_PRECISION (TREE_TYPE (gimple_assign_rhs1 (stmt))))) + <= TYPE_PRECISION (TREE_TYPE (gimple_assign_rhs1 (stmt)))) + && TREE_CODE (gimple_assign_rhs1 (stmt)) == SSA_NAME) || gimple_assign_ssa_name_copy_p (stmt))) stmt = SSA_NAME_DEF_STMT (gimple_assign_rhs1 (stmt)); diff --git a/gcc/tree-ssa-math-opts.c b/gcc/tree-ssa-math-opts.c index 9ff857cd657..292ced1d0ea 100644 --- a/gcc/tree-ssa-math-opts.c +++ b/gcc/tree-ssa-math-opts.c @@ -1620,7 +1620,7 @@ make_pass_cse_sincos (gcc::context *ctxt) struct symbolic_number { unsigned HOST_WIDEST_INT n; - int size; + tree type; }; /* Perform a SHIFT or ROTATE operation by COUNT bits on symbolic @@ -1632,13 +1632,15 @@ do_shift_rotate (enum tree_code code, struct symbolic_number *n, int count) { + int bitsize = TYPE_PRECISION (n->type); + if (count % 8 != 0) return false; /* Zero out the extra bits of N in order to avoid them being shifted into the significant bits. */ - if (n->size < (int)sizeof (HOST_WIDEST_INT)) - n->n &= ((unsigned HOST_WIDEST_INT)1 << (n->size * BITS_PER_UNIT)) - 1; + if (bitsize < 8 * (int)sizeof (HOST_WIDEST_INT)) + n->n &= ((unsigned HOST_WIDEST_INT)1 << bitsize) - 1; switch (code) { @@ -1646,20 +1648,24 @@ do_shift_rotate (enum tree_code code, n->n <<= count; break; case RSHIFT_EXPR: + /* Arithmetic shift of signed type: result is dependent on the value. */ + if (!TYPE_UNSIGNED (n->type) + && (n->n & ((unsigned HOST_WIDEST_INT) 0xff << (bitsize - 8)))) + return false; n->n >>= count; break; case LROTATE_EXPR: - n->n = (n->n << count) | (n->n >> ((n->size * BITS_PER_UNIT) - count)); + n->n = (n->n << count) | (n->n >> (bitsize - count)); break; case RROTATE_EXPR: - n->n = (n->n >> count) | (n->n << ((n->size * BITS_PER_UNIT) - count)); + n->n = (n->n >> count) | (n->n << (bitsize - count)); break; default: return false; } /* Zero unused bits for size. */ - if (n->size < (int)sizeof (HOST_WIDEST_INT)) - n->n &= ((unsigned HOST_WIDEST_INT)1 << (n->size * BITS_PER_UNIT)) - 1; + if (bitsize < 8 * (int)sizeof (HOST_WIDEST_INT)) + n->n &= ((unsigned HOST_WIDEST_INT)1 << bitsize) - 1; return true; } @@ -1676,7 +1682,7 @@ verify_symbolic_number_p (struct symbolic_number *n, gimple stmt) if (TREE_CODE (lhs_type) != INTEGER_TYPE) return false; - if (TYPE_PRECISION (lhs_type) != n->size * BITS_PER_UNIT) + if (TYPE_PRECISION (lhs_type) != TYPE_PRECISION (n->type)) return false; return true; @@ -1733,20 +1739,23 @@ find_bswap_1 (gimple stmt, struct symbolic_number *n, int limit) to initialize the symbolic number. */ if (!source_expr1) { + int size; + /* Set up the symbolic number N by setting each byte to a value between 1 and the byte size of rhs1. The highest order byte is set to n->size and the lowest order byte to 1. */ - n->size = TYPE_PRECISION (TREE_TYPE (rhs1)); - if (n->size % BITS_PER_UNIT != 0) + n->type = TREE_TYPE (rhs1); + size = TYPE_PRECISION (n->type); + if (size % BITS_PER_UNIT != 0) return NULL_TREE; - n->size /= BITS_PER_UNIT; + size /= BITS_PER_UNIT; n->n = (sizeof (HOST_WIDEST_INT) < 8 ? 0 : (unsigned HOST_WIDEST_INT)0x08070605 << 32 | 0x04030201); - if (n->size < (int)sizeof (HOST_WIDEST_INT)) + if (size < (int)sizeof (HOST_WIDEST_INT)) n->n &= ((unsigned HOST_WIDEST_INT)1 << - (n->size * BITS_PER_UNIT)) - 1; + (size * BITS_PER_UNIT)) - 1; source_expr1 = rhs1; } @@ -1755,12 +1764,12 @@ find_bswap_1 (gimple stmt, struct symbolic_number *n, int limit) { case BIT_AND_EXPR: { - int i; + int i, size = TYPE_PRECISION (n->type) / BITS_PER_UNIT; unsigned HOST_WIDEST_INT val = widest_int_cst_value (rhs2); unsigned HOST_WIDEST_INT tmp = val; /* Only constants masking full bytes are allowed. */ - for (i = 0; i < n->size; i++, tmp >>= BITS_PER_UNIT) + for (i = 0; i < size; i++, tmp >>= BITS_PER_UNIT) if ((tmp & 0xff) != 0 && (tmp & 0xff) != 0xff) return NULL_TREE; @@ -1776,19 +1785,29 @@ find_bswap_1 (gimple stmt, struct symbolic_number *n, int limit) break; CASE_CONVERT: { - int type_size; + int type_size, old_type_size; + tree type; - type_size = TYPE_PRECISION (gimple_expr_type (stmt)); + type = gimple_expr_type (stmt); + type_size = TYPE_PRECISION (type); if (type_size % BITS_PER_UNIT != 0) return NULL_TREE; + /* Sign extension: result is dependent on the value. */ + old_type_size = TYPE_PRECISION (n->type); + if (!TYPE_UNSIGNED (n->type) + && type_size > old_type_size + && n->n & + ((unsigned HOST_WIDEST_INT) 0xff << (old_type_size - 8))) + return NULL_TREE; + if (type_size / BITS_PER_UNIT < (int)(sizeof (HOST_WIDEST_INT))) { /* If STMT casts to a smaller type mask out the bits not belonging to the target type. */ n->n &= ((unsigned HOST_WIDEST_INT)1 << type_size) - 1; } - n->size = type_size / BITS_PER_UNIT; + n->type = type; } break; default: @@ -1801,7 +1820,7 @@ find_bswap_1 (gimple stmt, struct symbolic_number *n, int limit) if (rhs_class == GIMPLE_BINARY_RHS) { - int i; + int i, size; struct symbolic_number n1, n2; unsigned HOST_WIDEST_INT mask; tree source_expr2; @@ -1825,11 +1844,12 @@ find_bswap_1 (gimple stmt, struct symbolic_number *n, int limit) source_expr2 = find_bswap_1 (rhs2_stmt, &n2, limit - 1); if (source_expr1 != source_expr2 - || n1.size != n2.size) + || TYPE_PRECISION (n1.type) != TYPE_PRECISION (n2.type)) return NULL_TREE; - n->size = n1.size; - for (i = 0, mask = 0xff; i < n->size; i++, mask <<= BITS_PER_UNIT) + n->type = n1.type; + size = TYPE_PRECISION (n->type) / BITS_PER_UNIT; + for (i = 0, mask = 0xff; i < size; i++, mask <<= BITS_PER_UNIT) { unsigned HOST_WIDEST_INT masked1, masked2; @@ -1868,7 +1888,7 @@ find_bswap (gimple stmt) struct symbolic_number n; tree source_expr; - int limit; + int limit, bitsize; /* The last parameter determines the depth search limit. It usually correlates directly to the number of bytes to be touched. We @@ -1883,13 +1903,14 @@ find_bswap (gimple stmt) return NULL_TREE; /* Zero out the extra bits of N and CMP. */ - if (n.size < (int)sizeof (HOST_WIDEST_INT)) + bitsize = TYPE_PRECISION (n.type); + if (bitsize < 8 * (int)sizeof (HOST_WIDEST_INT)) { unsigned HOST_WIDEST_INT mask = - ((unsigned HOST_WIDEST_INT)1 << (n.size * BITS_PER_UNIT)) - 1; + ((unsigned HOST_WIDEST_INT)1 << bitsize) - 1; n.n &= mask; - cmp >>= (sizeof (HOST_WIDEST_INT) - n.size) * BITS_PER_UNIT; + cmp >>= sizeof (HOST_WIDEST_INT) * BITS_PER_UNIT - bitsize; } /* A complete byte swap should make the symbolic number to start diff --git a/gcc/tree-ssa-structalias.c b/gcc/tree-ssa-structalias.c index 347dba3e9a1..abc99ba377a 100644 --- a/gcc/tree-ssa-structalias.c +++ b/gcc/tree-ssa-structalias.c @@ -6091,6 +6091,10 @@ find_what_var_points_to (varinfo_t orig_vi) pt->ipa_escaped = 1; else pt->escaped = 1; + /* Expand some special vars of ESCAPED in-place here. */ + varinfo_t evi = get_varinfo (find (escaped_id)); + if (bitmap_bit_p (evi->solution, nonlocal_id)) + pt->nonlocal = 1; } else if (vi->id == nonlocal_id) pt->nonlocal = 1; diff --git a/gcc/tree-vect-data-refs.c b/gcc/tree-vect-data-refs.c index 274cdbdcf80..6622bd84df1 100644 --- a/gcc/tree-vect-data-refs.c +++ b/gcc/tree-vect-data-refs.c @@ -373,11 +373,14 @@ vect_analyze_data_ref_dependence (struct data_dependence_relation *ddr, .. = a[i+1]; where we will end up loading { a[i], a[i+1] } once, make sure that inserting group loads before the first load and - stores after the last store will do the right thing. */ - if ((STMT_VINFO_GROUPED_ACCESS (stmtinfo_a) - && GROUP_SAME_DR_STMT (stmtinfo_a)) - || (STMT_VINFO_GROUPED_ACCESS (stmtinfo_b) - && GROUP_SAME_DR_STMT (stmtinfo_b))) + stores after the last store will do the right thing. + Similar for groups like + a[i] = ...; + ... = a[i]; + a[i+1] = ...; + where loads from the group interleave with the store. */ + if (STMT_VINFO_GROUPED_ACCESS (stmtinfo_a) + || STMT_VINFO_GROUPED_ACCESS (stmtinfo_b)) { gimple earlier_stmt; earlier_stmt = get_earlier_stmt (DR_STMT (dra), DR_STMT (drb)); diff --git a/gcc/tree-vect-generic.c b/gcc/tree-vect-generic.c index a1de7beb02e..0cc83b41740 100644 --- a/gcc/tree-vect-generic.c +++ b/gcc/tree-vect-generic.c @@ -1336,15 +1336,67 @@ lower_vec_perm (gimple_stmt_iterator *gsi) update_stmt (gsi_stmt (*gsi)); } +/* Return type in which CODE operation with optab OP can be + computed. */ + +static tree +get_compute_type (enum tree_code code, optab op, tree type) +{ + /* For very wide vectors, try using a smaller vector mode. */ + tree compute_type = type; + if (op + && (!VECTOR_MODE_P (TYPE_MODE (type)) + || optab_handler (op, TYPE_MODE (type)) == CODE_FOR_nothing)) + { + tree vector_compute_type + = type_for_widest_vector_mode (TREE_TYPE (type), op); + if (vector_compute_type != NULL_TREE + && (TYPE_VECTOR_SUBPARTS (vector_compute_type) + < TYPE_VECTOR_SUBPARTS (compute_type)) + && (optab_handler (op, TYPE_MODE (vector_compute_type)) + != CODE_FOR_nothing)) + compute_type = vector_compute_type; + } + + /* If we are breaking a BLKmode vector into smaller pieces, + type_for_widest_vector_mode has already looked into the optab, + so skip these checks. */ + if (compute_type == type) + { + enum machine_mode compute_mode = TYPE_MODE (compute_type); + if (VECTOR_MODE_P (compute_mode)) + { + if (op && optab_handler (op, compute_mode) != CODE_FOR_nothing) + return compute_type; + if (code == MULT_HIGHPART_EXPR + && can_mult_highpart_p (compute_mode, + TYPE_UNSIGNED (compute_type))) + return compute_type; + } + /* There is no operation in hardware, so fall back to scalars. */ + compute_type = TREE_TYPE (type); + } + + return compute_type; +} + +/* Helper function of expand_vector_operations_1. Return number of + vector elements for vector types or 1 for other types. */ + +static inline int +count_type_subparts (tree type) +{ + return VECTOR_TYPE_P (type) ? TYPE_VECTOR_SUBPARTS (type) : 1; +} + /* Process one statement. If we identify a vector operation, expand it. */ static void expand_vector_operations_1 (gimple_stmt_iterator *gsi) { gimple stmt = gsi_stmt (*gsi); - tree lhs, rhs1, rhs2 = NULL, type, compute_type; + tree lhs, rhs1, rhs2 = NULL, type, compute_type = NULL_TREE; enum tree_code code; - enum machine_mode compute_mode; optab op = unknown_optab; enum gimple_rhs_class rhs_class; tree new_rhs; @@ -1457,11 +1509,76 @@ expand_vector_operations_1 (gimple_stmt_iterator *gsi) { op = optab_for_tree_code (code, type, optab_scalar); + compute_type = get_compute_type (code, op, type); + if (compute_type == type) + return; /* The rtl expander will expand vector/scalar as vector/vector - if necessary. Don't bother converting the stmt here. */ - if (optab_handler (op, TYPE_MODE (type)) == CODE_FOR_nothing - && optab_handler (opv, TYPE_MODE (type)) != CODE_FOR_nothing) + if necessary. Pick one with wider vector type. */ + tree compute_vtype = get_compute_type (code, opv, type); + if (count_type_subparts (compute_vtype) + > count_type_subparts (compute_type)) + { + compute_type = compute_vtype; + op = opv; + } + } + + if (code == LROTATE_EXPR || code == RROTATE_EXPR) + { + if (compute_type == NULL_TREE) + compute_type = get_compute_type (code, op, type); + if (compute_type == type) return; + /* Before splitting vector rotates into scalar rotates, + see if we can't use vector shifts and BIT_IOR_EXPR + instead. For vector by vector rotates we'd also + need to check BIT_AND_EXPR and NEGATE_EXPR, punt there + for now, fold doesn't seem to create such rotates anyway. */ + if (compute_type == TREE_TYPE (type) + && !VECTOR_INTEGER_TYPE_P (TREE_TYPE (rhs2))) + { + optab oplv = vashl_optab, opl = ashl_optab; + optab oprv = vlshr_optab, opr = lshr_optab, opo = ior_optab; + tree compute_lvtype = get_compute_type (LSHIFT_EXPR, oplv, type); + tree compute_rvtype = get_compute_type (RSHIFT_EXPR, oprv, type); + tree compute_otype = get_compute_type (BIT_IOR_EXPR, opo, type); + tree compute_ltype = get_compute_type (LSHIFT_EXPR, opl, type); + tree compute_rtype = get_compute_type (RSHIFT_EXPR, opr, type); + /* The rtl expander will expand vector/scalar as vector/vector + if necessary. Pick one with wider vector type. */ + if (count_type_subparts (compute_lvtype) + > count_type_subparts (compute_ltype)) + { + compute_ltype = compute_lvtype; + opl = oplv; + } + if (count_type_subparts (compute_rvtype) + > count_type_subparts (compute_rtype)) + { + compute_rtype = compute_rvtype; + opr = oprv; + } + /* Pick the narrowest type from LSHIFT_EXPR, RSHIFT_EXPR and + BIT_IOR_EXPR. */ + compute_type = compute_ltype; + if (count_type_subparts (compute_type) + > count_type_subparts (compute_rtype)) + compute_type = compute_rtype; + if (count_type_subparts (compute_type) + > count_type_subparts (compute_otype)) + compute_type = compute_otype; + /* Verify all 3 operations can be performed in that type. */ + if (compute_type != TREE_TYPE (type)) + { + if (optab_handler (opl, TYPE_MODE (compute_type)) + == CODE_FOR_nothing + || optab_handler (opr, TYPE_MODE (compute_type)) + == CODE_FOR_nothing + || optab_handler (opo, TYPE_MODE (compute_type)) + == CODE_FOR_nothing) + compute_type = TREE_TYPE (type); + } + } } } else @@ -1475,38 +1592,10 @@ expand_vector_operations_1 (gimple_stmt_iterator *gsi) && INTEGRAL_TYPE_P (TREE_TYPE (type))) op = optab_for_tree_code (MINUS_EXPR, type, optab_default); - /* For very wide vectors, try using a smaller vector mode. */ - compute_type = type; - if (!VECTOR_MODE_P (TYPE_MODE (type)) && op) - { - tree vector_compute_type - = type_for_widest_vector_mode (TREE_TYPE (type), op); - if (vector_compute_type != NULL_TREE - && (TYPE_VECTOR_SUBPARTS (vector_compute_type) - < TYPE_VECTOR_SUBPARTS (compute_type)) - && (optab_handler (op, TYPE_MODE (vector_compute_type)) - != CODE_FOR_nothing)) - compute_type = vector_compute_type; - } - - /* If we are breaking a BLKmode vector into smaller pieces, - type_for_widest_vector_mode has already looked into the optab, - so skip these checks. */ + if (compute_type == NULL_TREE) + compute_type = get_compute_type (code, op, type); if (compute_type == type) - { - compute_mode = TYPE_MODE (compute_type); - if (VECTOR_MODE_P (compute_mode)) - { - if (op && optab_handler (op, compute_mode) != CODE_FOR_nothing) - return; - if (code == MULT_HIGHPART_EXPR - && can_mult_highpart_p (compute_mode, - TYPE_UNSIGNED (compute_type))) - return; - } - /* There is no operation in hardware, so fall back to scalars. */ - compute_type = TREE_TYPE (type); - } + return; gcc_assert (code != VEC_LSHIFT_EXPR && code != VEC_RSHIFT_EXPR); new_rhs = expand_vector_operation (gsi, type, compute_type, stmt, code); diff --git a/gcc/tree-vrp.c b/gcc/tree-vrp.c index 8fcb9d15eef..2c80135f96b 100644 --- a/gcc/tree-vrp.c +++ b/gcc/tree-vrp.c @@ -3616,15 +3616,18 @@ extract_range_basic (value_range_t *vr, gimple stmt) /* If arg is non-zero, then ffs or popcount are non-zero. */ if (((vr0->type == VR_RANGE - && integer_nonzerop (vr0->min)) + && range_includes_zero_p (vr0->min, vr0->max) == 0) || (vr0->type == VR_ANTI_RANGE - && integer_zerop (vr0->min))) - && !is_overflow_infinity (vr0->min)) + && range_includes_zero_p (vr0->min, vr0->max) == 1)) + && !is_overflow_infinity (vr0->min) + && !is_overflow_infinity (vr0->max)) mini = 1; /* If some high bits are known to be zero, we can decrease the maximum. */ if (vr0->type == VR_RANGE && TREE_CODE (vr0->max) == INTEGER_CST + && !operand_less_p (vr0->min, + build_zero_cst (TREE_TYPE (vr0->min))) && !is_overflow_infinity (vr0->max)) maxi = tree_floor_log2 (vr0->max) + 1; } diff --git a/gcc/tree.c b/gcc/tree.c index efee5e69cf2..069abb77590 100644 --- a/gcc/tree.c +++ b/gcc/tree.c @@ -252,7 +252,7 @@ unsigned const char omp_clause_num_ops[] = 4, /* OMP_CLAUSE_REDUCTION */ 1, /* OMP_CLAUSE_COPYIN */ 1, /* OMP_CLAUSE_COPYPRIVATE */ - 2, /* OMP_CLAUSE_LINEAR */ + 3, /* OMP_CLAUSE_LINEAR */ 2, /* OMP_CLAUSE_ALIGNED */ 1, /* OMP_CLAUSE_DEPEND */ 1, /* OMP_CLAUSE_UNIFORM */ @@ -11079,8 +11079,13 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data, WALK_SUBTREE_TAIL (OMP_CLAUSE_CHAIN (*tp)); } - case OMP_CLAUSE_ALIGNED: case OMP_CLAUSE_LINEAR: + WALK_SUBTREE (OMP_CLAUSE_DECL (*tp)); + WALK_SUBTREE (OMP_CLAUSE_LINEAR_STEP (*tp)); + WALK_SUBTREE (OMP_CLAUSE_LINEAR_STMT (*tp)); + WALK_SUBTREE_TAIL (OMP_CLAUSE_CHAIN (*tp)); + + case OMP_CLAUSE_ALIGNED: case OMP_CLAUSE_FROM: case OMP_CLAUSE_TO: case OMP_CLAUSE_MAP: diff --git a/gcc/tree.h b/gcc/tree.h index 90e5e275cec..d73bc521c3d 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -1327,9 +1327,17 @@ extern void protected_set_expr_location (tree, location_t); #define OMP_CLAUSE_LINEAR_VARIABLE_STRIDE(NODE) \ TREE_PROTECTED (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_LINEAR)) +/* True if a LINEAR clause is for an array or allocatable variable that + needs special handling by the frontend. */ +#define OMP_CLAUSE_LINEAR_ARRAY(NODE) \ + (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_LINEAR)->base.deprecated_flag) + #define OMP_CLAUSE_LINEAR_STEP(NODE) \ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_LINEAR), 1) +#define OMP_CLAUSE_LINEAR_STMT(NODE) \ + OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_LINEAR), 2) + #define OMP_CLAUSE_LINEAR_GIMPLE_SEQ(NODE) \ (OMP_CLAUSE_CHECK (NODE))->omp_clause.gimple_reduction_init |