backport: re PR fortran/46752 (OpenMP - Seg fault for unallocated allocatable array in firstprivate clause)

Merge from gomp-3_1-branch branch:

2011-08-02  Jakub Jelinek  <jakub@redhat.com>

gcc/
	* c-parser.c (enum c_parser_prec): New enum, moved from within
	c_parser_binary_expression.
	(c_parser_binary_expression): Add PREC argument.  Stop parsing
	if operator has lower or equal precedence than PREC.
	(c_parser_conditional_expression, c_parser_omp_for_loop): Adjust
	callers.
	(c_parser_omp_atomic): Handle parsing OpenMP 3.1 atomics.
	Adjust c_finish_omp_atomic caller.
	(c_parser_omp_taskyield): New function.
	(c_parser_pragma): Handle PRAGMA_OMP_TASKYIELD.
	(c_parser_omp_clause_name): Handle final and mergeable clauses.
	(c_parser_omp_clause_final, c_parser_omp_clause_mergeable): New
	functions.
	(c_parser_omp_all_clauses): Handle PRAGMA_OMP_CLAUSE_FINAL
	and PRAGMA_OMP_CLAUSE_MERGEABLE.
	(OMP_TASK_CLAUSE_MASK): Allow final and mergeable clauses.
	(c_parser_omp_clause_reduction): Handle min and max.
	* c-typeck.c (c_finish_omp_clauses): Don't complain about
	const qualified predetermined vars in firstprivate clause.
	andle OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
	Handle MIN_EXPR and MAX_EXPR.
	* tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_FINAL
	and OMP_CLAUSE_MERGEABLE.
	(dump_generic_node): Handle OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD
	and OMP_ATOMIC_CAPTURE_NEW.
	* tree.c (omp_clause_num_ops): Add OMP_CLAUSE_FINAL and
	OMP_CLAUSE_MERGEABLE.
	(omp_clause_code_name): Likewise.
	(walk_tree_1): Handle OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
	* tree.h (enum omp_clause_code): Add OMP_CLAUSE_FINAL
	and OMP_CLAUSE_MERGEABLE.
	(OMP_CLAUSE_FINAL_EXPR): Define.
	* omp-low.c (scan_sharing_clauses): Handle OMP_CLAUSE_FINAL and
	OMP_CLAUSE_MERGEABLE.
	(expand_task_call): Likewise.
	(expand_omp_atomic_load, expand_omp_atomic_store): New functions.
	(expand_omp_atomic_fetch_op): Handle cases where old or new
	value is needed afterwards.
	(expand_omp_atomic): Call expand_omp_atomic_load resp.
	expand_omp_atomic_store.
	* gimplify.c (gimplify_omp_atomic, gimplify_expr): Handle
	OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD and OMP_ATOMIC_CAPTURE_NEW.
	(gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses): Handle
	OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
	* tree-nested.c (convert_nonlocal_omp_clauses,
	convert_local_omp_clauses): Likewise.
	* tree.def (OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD,
	OMP_ATOMIC_CAPTURE_NEW): New.
	* gimple.h (GF_OMP_ATOMIC_NEED_VALUE): New.
	(gimple_omp_atomic_need_value_p, gimple_omp_atomic_set_need_value):
	New inlines.
	* omp-builtins.def (BUILT_IN_GOMP_TASKYIELD): New builtin.
	* doc/generic.texi: Mention OMP_CLAUSE_COLLAPSE,
	OMP_CLAUSE_UNTIED, OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
gcc/c-family/
	* c-common.h (c_finish_omp_atomic): Adjust prototype.
	(c_finish_omp_taskyield): New prototype.
	* c-omp.c (c_finish_omp_atomic): Add OPCODE, V, LHS1 and RHS1
	arguments. Handle OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD and
	OMP_ATOMIC_CAPTURE_NEW in addition to OMP_ATOMIC.  If LHS1
	or RHS1 have side-effects, evaluate those too in the right spot,
	if it is a decl and LHS is also a decl, error out if they
	aren't the same.
	(c_finish_omp_taskyield): New function.
	* c-cppbuiltin.c (c_cpp_builtins): Change _OPENMP to 201107.
	* c-pragma.c (omp_pragmas): Add taskyield.
	* c-pragma.h (enum pragma_kind): Add PRAGMA_OMP_TASKYIELD.
	(enum pragma_omp_clause): Add PRAGMA_OMP_CLAUSE_FINAL and
	PRAGMA_OMP_CLAUSE_MERGEABLE.
gcc/cp/
	* cp-tree.h (finish_omp_atomic): Adjust prototype.
	(cxx_omp_const_qual_no_mutable): New prototype.
	(finish_omp_taskyield): New prototype.
	* parser.c (cp_parser_omp_atomic): (cp_parser_omp_atomic): Handle
	parsing OpenMP 3.1 atomics.  Adjust finish_omp_atomic caller.
	(cp_parser_omp_clause_name): Handle final and mergeable clauses.
	(cp_parser_omp_clause_final, cp_parser_omp_clause_mergeable): New
	functions.
	(cp_parser_omp_all_clauses): Handle PRAGMA_OMP_CLAUSE_FINAL
	and PRAGMA_OMP_CLAUSE_MERGEABLE.
	(OMP_TASK_CLAUSE_MASK): Allow final and mergeable clauses.
	(cp_parser_omp_taskyield): New function.
	(cp_parser_pragma): Handle PRAGMA_OMP_TASKYIELD.
	(cp_parser_omp_clause_reduction): Handle min and max.
	* pt.c (tsubst_expr) <case OMP_ATOMIC>: Handle OpenMP 3.1 atomics.
	(tsubst_omp_clauses): Handle OMP_CLAUSE_FINAL and
	OMP_CLAUSE_MERGEABLE.
	* semantics.c (finish_omp_atomic): Add OPCODE, V, LHS1 and RHS1
	arguments.  Handle OpenMP 3.1 atomics.  Adjust c_finish_omp_atomic
	caller.
	(finish_omp_clauses): Don't complain about const qualified
	predetermined vars and static data members in firstprivate clause.
	Handle OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE. Handle MIN_EXPR
	and MAX_EXPR.
	(finish_omp_taskyield): New function.
	* cp-gimplify.c (cxx_omp_const_qual_no_mutable): New function.
	(cxx_omp_predetermined_sharing): Use it.
gcc/fortran/
	PR fortran/46752
	* cpp.c (cpp_define_builtins): Change _OPENMP to 201107.
	* openmp.c (gfc_free_omp_clauses): Free also final_expr.
	(OMP_CLAUSE_FINAL, OMP_CLAUSE_MERGEABLE): Define.
	(gfc_match_omp_clauses): Handle parsing final and mergeable
	clauses.
	(OMP_TASK_CLAUSES): Allow final and mergeable clauses.
	(gfc_match_omp_taskyield): New function.
	(resolve_omp_clauses): Resolve final clause.  Allow POINTERs and
	Cray pointers in clauses other than REDUCTION.
	(gfc_match_omp_atomic): Match optional
	read/write/update/capture keywords after !$omp atomic.
	(resolve_omp_atomic): Handle all OpenMP 3.1 atomic forms.
	* dump-parse-tree.c (show_omp_node): Handle EXEC_OMP_TASKYIELD,
	print final and mergeable clauses.
	(show_code_node): Handle EXEC_OMP_TASKYIELD.
	* trans-openmp.c (gfc_trans_omp_clauses): Handle final and
	mergeable clauses.
	(gfc_trans_omp_taskyield): New function.
	(gfc_trans_omp_directive): Handle EXEC_OMP_TASKYIELD.
	(gfc_trans_omp_atomic): Handle all OpenMP 3.1 atomic forms.
	(gfc_omp_clause_copy_ctor): Handle non-allocated allocatable.
	(gfc_omp_predetermined_sharing): Adjust comment.
	* gfortran.h (gfc_statement): Add ST_OMP_TASKYIELD and
	ST_OMP_END_ATOMIC.
	(gfc_omp_clauses): Add final_expr and mergeable fields.
	(gfc_exec_op): Add EXEC_OMP_TASKYIELD.
	(gfc_omp_atomic_op): New enum typedef.
	(struct gfc_code): Add ext.omp_atomic.
	* trans.c (trans_code): Handle EXEC_OMP_TASKYIELD.
	* frontend-passes.c (gfc_code_walker): Also walk final_expr.
	* resolve.c (gfc_resolve_blocks, resolve_code): Handle
	EXEC_OMP_TASKYIELD.
	* st.c (gfc_free_statement): Likewise.
	* match.h (gfc_match_omp_taskyield): New prototype.
	* parse.c (decode_omp_directive): Handle taskyield directive.
	Handle !$omp end atomic.
	(case_executable): Add ST_OMP_TASKYIELD case.
	(gfc_ascii_statement): Handle ST_OMP_TASKYIELD.
	(parse_omp_atomic): Return gfc_statement instead of void.
	For !$omp atomic capture parse two assignments instead of
	just one and require !$omp end atomic afterwards, for
	other !$omp atomic forms just allow !$omp end atomic at the
	end.
	(parse_omp_structured_block, parse_executable): Adjust
	parse_omp_atomic callers.

2011-08-02  Tobias Burnus  <burnus@net-b.de>

	* intrinsic.c (OMP_LIB): Updated openmp_version's
	value to 201107.
	* gfortran.texi (OpenMP): Update ref to OpenMP 3.1.
	* intrinsic.texi (OpenMP Modules): Update ref to OpenMP 3.1;
	remove deleted omp_integer_kind and omp_logical_kind constants.
gcc/testsuite/
	PR fortran/46752
	* gcc.dg/gomp/atomic-5.c: Adjust expected diagnostics.
	* gcc.dg/gomp/atomic-15.c: New test.
	* g++.dg/gomp/atomic-5.C: Adjust expected diagnostics.
	* g++.dg/gomp/atomic-15.C: New test.
	* g++.dg/gomp/private-1.C: New test.
	* g++.dg/gomp/sharing-2.C: New test.
	* gfortran.dg/gomp/crayptr1.f90: Don't expect error
	about Cray pointer in FIRSTPRIVATE/LASTPRIVATE.
	* gfortran.dg/gomp/omp_atomic2.f90: New test.
libgomp/
	PR fortran/42041
	PR fortran/46752
	* omp.h.in (omp_in_final): New prototype.
	* omp_lib.f90.in (omp_in_final): New interface.
	(omp_integer_kind, omp_logical_kind): Remove
	and replace all its uses in the module with 4.
	(openmp_version): Change to 201107.
	* omp_lib.h.in (omp_sched_static, omp_sched_dynamic,
	omp_sched_guided, omp_sched_auto): Use omp_sched_kind
	kind for the parameters.
	(omp_in_final): New external.
	(openmp_version): Change to 201107.
	* task.c (omp_in_final): New function.
	(gomp_init_task): Initialize final_task.
	(GOMP_task): Remove unused attribute from flags.  Handle final
	tasks.
	(GOMP_taskyield): New function.
	(omp_in_final): Return true if if (false) or final (true) task
	or descendant of final (true).
	* fortran.c (omp_in_final_): New function.
	* libgomp.map (OMP_3.1): Export omp_in_final and omp_in_final_.
	(GOMP_3.0): Export GOMP_taskyield.
	* env.c (gomp_nthreads_var_list, gomp_nthreads_var_list_len): New
	variables.
	(parse_unsigned_long_list): New function.
	(initialize_env): Use it for OMP_NUM_THREADS.  Call parse_boolean
	with "OMP_PROC_BIND".  If OMP_PROC_BIND=true, call gomp_init_affinity
	even if parse_affinity returned false.
	* config/linux/affinity.c (gomp_init_affinity): Handle
	gomp_cpu_affinity_len == 0.
	* libgomp_g.h (GOMP_taskyield): New prototype.
	* libgomp.h (struct gomp_task): Add final_task field.
	(gomp_nthreads_var_list, gomp_nthreads_var_list_len): New externs.
	* team.c (gomp_team_start): Override new task's nthreads_var icv
	if list form OMP_NUM_THREADS has been used and it has value for
	the new nesting level.

	* testsuite/libgomp.c/atomic-11.c: New test.
	* testsuite/libgomp.c/atomic-12.c: New test.
	* testsuite/libgomp.c/atomic-13.c: New test.
	* testsuite/libgomp.c/atomic-14.c: New test.
	* testsuite/libgomp.c/reduction-6.c: New test.
	* testsuite/libgomp.c/task-5.c: New test.
	* testsuite/libgomp.c++/atomic-2.C: New test.
	* testsuite/libgomp.c++/atomic-3.C: New test.
	* testsuite/libgomp.c++/atomic-4.C: New test.
	* testsuite/libgomp.c++/atomic-5.C: New test.
	* testsuite/libgomp.c++/atomic-6.C: New test.
	* testsuite/libgomp.c++/atomic-7.C: New test.
	* testsuite/libgomp.c++/atomic-8.C: New test.
	* testsuite/libgomp.c++/atomic-9.C: New test.
	* testsuite/libgomp.c++/task-8.C: New test.
	* testsuite/libgomp.c++/reduction-4.C: New test.
	* testsuite/libgomp.fortran/allocatable7.f90: New test.
	* testsuite/libgomp.fortran/allocatable8.f90: New test.
	* testsuite/libgomp.fortran/crayptr3.f90: New test.
	* testsuite/libgomp.fortran/omp_atomic3.f90: New test.
	* testsuite/libgomp.fortran/omp_atomic4.f90: New test.
	* testsuite/libgomp.fortran/pointer1.f90: New test.
	* testsuite/libgomp.fortran/pointer2.f90: New test.
	* testsuite/libgomp.fortran/task4.f90: New test.

2011-08-02  Tobias Burnus  <burnus@net-b.de>

	* libgomp.texi: Update OpenMP spec references to 3.1.
	(omp_in_final,OMP_PROC_BIND): New sections.
	(OMP_NUM_THREADS): Document that the value can be now a list.
	(GOMP_STACKSIZE,GOMP_CPU_AFFINITY): Update @ref.

From-SVN: r177194
This commit is contained in:
Jakub Jelinek 2011-08-02 18:13:29 +02:00
parent 113430e542
commit 20906c66f2
87 changed files with 4321 additions and 333 deletions

View File

@ -1,3 +1,60 @@
2011-08-02 Jakub Jelinek <jakub@redhat.com>
* c-parser.c (enum c_parser_prec): New enum, moved from within
c_parser_binary_expression.
(c_parser_binary_expression): Add PREC argument. Stop parsing
if operator has lower or equal precedence than PREC.
(c_parser_conditional_expression, c_parser_omp_for_loop): Adjust
callers.
(c_parser_omp_atomic): Handle parsing OpenMP 3.1 atomics.
Adjust c_finish_omp_atomic caller.
(c_parser_omp_taskyield): New function.
(c_parser_pragma): Handle PRAGMA_OMP_TASKYIELD.
(c_parser_omp_clause_name): Handle final and mergeable clauses.
(c_parser_omp_clause_final, c_parser_omp_clause_mergeable): New
functions.
(c_parser_omp_all_clauses): Handle PRAGMA_OMP_CLAUSE_FINAL
and PRAGMA_OMP_CLAUSE_MERGEABLE.
(OMP_TASK_CLAUSE_MASK): Allow final and mergeable clauses.
(c_parser_omp_clause_reduction): Handle min and max.
* c-typeck.c (c_finish_omp_clauses): Don't complain about
const qualified predetermined vars in firstprivate clause.
andle OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
Handle MIN_EXPR and MAX_EXPR.
* tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_FINAL
and OMP_CLAUSE_MERGEABLE.
(dump_generic_node): Handle OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD
and OMP_ATOMIC_CAPTURE_NEW.
* tree.c (omp_clause_num_ops): Add OMP_CLAUSE_FINAL and
OMP_CLAUSE_MERGEABLE.
(omp_clause_code_name): Likewise.
(walk_tree_1): Handle OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
* tree.h (enum omp_clause_code): Add OMP_CLAUSE_FINAL
and OMP_CLAUSE_MERGEABLE.
(OMP_CLAUSE_FINAL_EXPR): Define.
* omp-low.c (scan_sharing_clauses): Handle OMP_CLAUSE_FINAL and
OMP_CLAUSE_MERGEABLE.
(expand_task_call): Likewise.
(expand_omp_atomic_load, expand_omp_atomic_store): New functions.
(expand_omp_atomic_fetch_op): Handle cases where old or new
value is needed afterwards.
(expand_omp_atomic): Call expand_omp_atomic_load resp.
expand_omp_atomic_store.
* gimplify.c (gimplify_omp_atomic, gimplify_expr): Handle
OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD and OMP_ATOMIC_CAPTURE_NEW.
(gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses): Handle
OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
* tree-nested.c (convert_nonlocal_omp_clauses,
convert_local_omp_clauses): Likewise.
* tree.def (OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD,
OMP_ATOMIC_CAPTURE_NEW): New.
* gimple.h (GF_OMP_ATOMIC_NEED_VALUE): New.
(gimple_omp_atomic_need_value_p, gimple_omp_atomic_set_need_value):
New inlines.
* omp-builtins.def (BUILT_IN_GOMP_TASKYIELD): New builtin.
* doc/generic.texi: Mention OMP_CLAUSE_COLLAPSE,
OMP_CLAUSE_UNTIED, OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE.
2011-08-02 Kai Tietz <ktietz@redhat.com>
* gimple.c (canonicalize_cond_expr_cond): Handle cast from

View File

@ -1,3 +1,20 @@
2011-08-02 Jakub Jelinek <jakub@redhat.com>
* c-common.h (c_finish_omp_atomic): Adjust prototype.
(c_finish_omp_taskyield): New prototype.
* c-omp.c (c_finish_omp_atomic): Add OPCODE, V, LHS1 and RHS1
arguments. Handle OMP_ATOMIC_READ, OMP_ATOMIC_CAPTURE_OLD and
OMP_ATOMIC_CAPTURE_NEW in addition to OMP_ATOMIC. If LHS1
or RHS1 have side-effects, evaluate those too in the right spot,
if it is a decl and LHS is also a decl, error out if they
aren't the same.
(c_finish_omp_taskyield): New function.
* c-cppbuiltin.c (c_cpp_builtins): Change _OPENMP to 201107.
* c-pragma.c (omp_pragmas): Add taskyield.
* c-pragma.h (enum pragma_kind): Add PRAGMA_OMP_TASKYIELD.
(enum pragma_omp_clause): Add PRAGMA_OMP_CLAUSE_FINAL and
PRAGMA_OMP_CLAUSE_MERGEABLE.
2011-07-25 Dodji Seketeli <dodji@redhat.com>
* c-common.h (set_underlying_type): Remove parm name from

View File

@ -1029,9 +1029,11 @@ extern tree c_finish_omp_master (location_t, tree);
extern tree c_finish_omp_critical (location_t, tree, tree);
extern tree c_finish_omp_ordered (location_t, tree);
extern void c_finish_omp_barrier (location_t);
extern tree c_finish_omp_atomic (location_t, enum tree_code, tree, tree);
extern tree c_finish_omp_atomic (location_t, enum tree_code, enum tree_code,
tree, tree, tree, tree, tree);
extern void c_finish_omp_flush (location_t);
extern void c_finish_omp_taskwait (location_t);
extern void c_finish_omp_taskyield (location_t);
extern tree c_finish_omp_for (location_t, tree, tree, tree, tree, tree, tree);
extern void c_split_parallel_clauses (location_t, tree, tree *, tree *);
extern enum omp_clause_default_kind c_omp_predetermined_sharing (tree);

View File

@ -807,7 +807,7 @@ c_cpp_builtins (cpp_reader *pfile)
cpp_define (pfile, "__SSP__=1");
if (flag_openmp)
cpp_define (pfile, "_OPENMP=200805");
cpp_define (pfile, "_OPENMP=201107");
if (int128_integer_type_node != NULL_TREE)
builtin_define_type_sizeof ("__SIZEOF_INT128__",

View File

@ -1,7 +1,8 @@
/* This file contains routines to construct GNU OpenMP constructs,
called from parsing in the C and C++ front ends.
Copyright (C) 2005, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
Copyright (C) 2005, 2007, 2008, 2009, 2010, 2011
Free Software Foundation, Inc.
Contributed by Richard Henderson <rth@redhat.com>,
Diego Novillo <dnovillo@redhat.com>.
@ -96,18 +97,39 @@ c_finish_omp_taskwait (location_t loc)
}
/* Complete a #pragma omp atomic construct. The expression to be
implemented atomically is LHS code= RHS. LOC is the location of
the atomic statement. The value returned is either error_mark_node
(if the construct was erroneous) or an OMP_ATOMIC node which should
be added to the current statement tree with add_stmt.*/
/* Complete a #pragma omp taskyield construct. LOC is the location of the
pragma. */
void
c_finish_omp_taskyield (location_t loc)
{
tree x;
x = built_in_decls[BUILT_IN_GOMP_TASKYIELD];
x = build_call_expr_loc (loc, x, 0);
add_stmt (x);
}
/* Complete a #pragma omp atomic construct. For CODE OMP_ATOMIC
the expression to be implemented atomically is LHS opcode= RHS.
For OMP_ATOMIC_READ V = LHS, for OMP_ATOMIC_CAPTURE_{NEW,OLD} LHS
opcode= RHS with the new or old content of LHS returned.
LOC is the location of the atomic statement. The value returned
is either error_mark_node (if the construct was erroneous) or an
OMP_ATOMIC* node which should be added to the current statement
tree with add_stmt. */
tree
c_finish_omp_atomic (location_t loc, enum tree_code code, tree lhs, tree rhs)
c_finish_omp_atomic (location_t loc, enum tree_code code,
enum tree_code opcode, tree lhs, tree rhs,
tree v, tree lhs1, tree rhs1)
{
tree x, type, addr;
if (lhs == error_mark_node || rhs == error_mark_node)
if (lhs == error_mark_node || rhs == error_mark_node
|| v == error_mark_node || lhs1 == error_mark_node
|| rhs1 == error_mark_node)
return error_mark_node;
/* ??? According to one reading of the OpenMP spec, complex type are
@ -143,10 +165,19 @@ c_finish_omp_atomic (location_t loc, enum tree_code code, tree lhs, tree rhs)
}
lhs = build_indirect_ref (loc, addr, RO_NULL);
if (code == OMP_ATOMIC_READ)
{
x = build1 (OMP_ATOMIC_READ, type, addr);
SET_EXPR_LOCATION (x, loc);
return build_modify_expr (loc, v, NULL_TREE, NOP_EXPR,
loc, x, NULL_TREE);
return x;
}
/* There are lots of warnings, errors, and conversions that need to happen
in the course of interpreting a statement. Use the normal mechanisms
to do this, and then take it apart again. */
x = build_modify_expr (input_location, lhs, NULL_TREE, code,
x = build_modify_expr (input_location, lhs, NULL_TREE, opcode,
input_location, rhs, NULL_TREE);
if (x == error_mark_node)
return error_mark_node;
@ -154,8 +185,68 @@ c_finish_omp_atomic (location_t loc, enum tree_code code, tree lhs, tree rhs)
rhs = TREE_OPERAND (x, 1);
/* Punt the actual generation of atomic operations to common code. */
x = build2 (OMP_ATOMIC, void_type_node, addr, rhs);
if (code == OMP_ATOMIC)
type = void_type_node;
x = build2 (code, type, addr, rhs);
SET_EXPR_LOCATION (x, loc);
/* Generally it is hard to prove lhs1 and lhs are the same memory
location, just diagnose different variables. */
if (rhs1
&& TREE_CODE (rhs1) == VAR_DECL
&& TREE_CODE (lhs) == VAR_DECL
&& rhs1 != lhs)
{
if (code == OMP_ATOMIC)
error_at (loc, "%<#pragma omp atomic update%> uses two different variables for memory");
else
error_at (loc, "%<#pragma omp atomic capture%> uses two different variables for memory");
return error_mark_node;
}
if (code != OMP_ATOMIC)
{
/* Generally it is hard to prove lhs1 and lhs are the same memory
location, just diagnose different variables. */
if (lhs1 && TREE_CODE (lhs1) == VAR_DECL && TREE_CODE (lhs) == VAR_DECL)
{
if (lhs1 != lhs)
{
error_at (loc, "%<#pragma omp atomic capture%> uses two different variables for memory");
return error_mark_node;
}
}
x = build_modify_expr (loc, v, NULL_TREE, NOP_EXPR,
loc, x, NULL_TREE);
if (rhs1 && rhs1 != lhs)
{
tree rhs1addr = build_unary_op (loc, ADDR_EXPR, rhs1, 0);
if (rhs1addr == error_mark_node)
return error_mark_node;
x = omit_one_operand_loc (loc, type, x, rhs1addr);
}
if (lhs1 && lhs1 != lhs)
{
tree lhs1addr = build_unary_op (loc, ADDR_EXPR, lhs1, 0);
if (lhs1addr == error_mark_node)
return error_mark_node;
if (code == OMP_ATOMIC_CAPTURE_OLD)
x = omit_one_operand_loc (loc, type, x, lhs1addr);
else
{
x = save_expr (x);
x = omit_two_operands_loc (loc, type, x, x, lhs1addr);
}
}
}
else if (rhs1 && rhs1 != lhs)
{
tree rhs1addr = build_unary_op (loc, ADDR_EXPR, rhs1, 0);
if (rhs1addr == error_mark_node)
return error_mark_node;
x = omit_one_operand_loc (loc, type, x, rhs1addr);
}
return x;
}

View File

@ -1196,6 +1196,7 @@ static const struct omp_pragma_def omp_pragmas[] = {
{ "single", PRAGMA_OMP_SINGLE },
{ "task", PRAGMA_OMP_TASK },
{ "taskwait", PRAGMA_OMP_TASKWAIT },
{ "taskyield", PRAGMA_OMP_TASKYIELD },
{ "threadprivate", PRAGMA_OMP_THREADPRIVATE }
};

View File

@ -43,6 +43,7 @@ typedef enum pragma_kind {
PRAGMA_OMP_SINGLE,
PRAGMA_OMP_TASK,
PRAGMA_OMP_TASKWAIT,
PRAGMA_OMP_TASKYIELD,
PRAGMA_OMP_THREADPRIVATE,
PRAGMA_GCC_PCH_PREPROCESS,
@ -70,7 +71,9 @@ typedef enum pragma_omp_clause {
PRAGMA_OMP_CLAUSE_REDUCTION,
PRAGMA_OMP_CLAUSE_SCHEDULE,
PRAGMA_OMP_CLAUSE_SHARED,
PRAGMA_OMP_CLAUSE_UNTIED
PRAGMA_OMP_CLAUSE_UNTIED,
PRAGMA_OMP_CLAUSE_FINAL,
PRAGMA_OMP_CLAUSE_MERGEABLE
} pragma_omp_clause;
extern struct cpp_reader* parse_in;

View File

@ -1090,6 +1090,23 @@ typedef enum c_dtr_syn {
C_DTR_PARM
} c_dtr_syn;
/* The binary operation precedence levels, where 0 is a dummy lowest level
used for the bottom of the stack. */
enum c_parser_prec {
PREC_NONE,
PREC_LOGOR,
PREC_LOGAND,
PREC_BITOR,
PREC_BITXOR,
PREC_BITAND,
PREC_EQ,
PREC_REL,
PREC_SHIFT,
PREC_ADD,
PREC_MULT,
NUM_PRECS
};
static void c_parser_external_declaration (c_parser *);
static void c_parser_asm_definition (c_parser *);
static void c_parser_declaration_or_fndef (c_parser *, bool, bool, bool,
@ -1138,7 +1155,8 @@ static tree c_parser_asm_clobbers (c_parser *);
static struct c_expr c_parser_expr_no_commas (c_parser *, struct c_expr *);
static struct c_expr c_parser_conditional_expression (c_parser *,
struct c_expr *);
static struct c_expr c_parser_binary_expression (c_parser *, struct c_expr *);
static struct c_expr c_parser_binary_expression (c_parser *, struct c_expr *,
enum c_parser_prec);
static struct c_expr c_parser_cast_expression (c_parser *, struct c_expr *);
static struct c_expr c_parser_unary_expression (c_parser *);
static struct c_expr c_parser_sizeof_expression (c_parser *);
@ -1159,6 +1177,7 @@ static void c_parser_omp_threadprivate (c_parser *);
static void c_parser_omp_barrier (c_parser *);
static void c_parser_omp_flush (c_parser *);
static void c_parser_omp_taskwait (c_parser *);
static void c_parser_omp_taskyield (c_parser *);
enum pragma_context { pragma_external, pragma_stmt, pragma_compound };
static bool c_parser_pragma (c_parser *, enum pragma_context);
@ -5308,7 +5327,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after)
gcc_assert (!after || c_dialect_objc ());
cond = c_parser_binary_expression (parser, after);
cond = c_parser_binary_expression (parser, after, PREC_NONE);
if (c_parser_next_token_is_not (parser, CPP_QUERY))
return cond;
@ -5393,7 +5412,8 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after)
/* Parse a binary expression; that is, a logical-OR-expression (C90
6.3.5-6.3.14, C99 6.5.5-6.5.14). If AFTER is not NULL then it is
an Objective-C message expression which is the primary-expression
starting the expression as an initializer.
starting the expression as an initializer. PREC is the starting
precedence, usually PREC_NONE.
multiplicative-expression:
cast-expression
@ -5445,7 +5465,8 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after)
*/
static struct c_expr
c_parser_binary_expression (c_parser *parser, struct c_expr *after)
c_parser_binary_expression (c_parser *parser, struct c_expr *after,
enum c_parser_prec prec)
{
/* A binary expression is parsed using operator-precedence parsing,
with the operands being cast expressions. All the binary
@ -5468,28 +5489,12 @@ c_parser_binary_expression (c_parser *parser, struct c_expr *after)
expressions, we also need to adjust c_inhibit_evaluation_warnings
as appropriate when the operators are pushed and popped. */
/* The precedence levels, where 0 is a dummy lowest level used for
the bottom of the stack. */
enum prec {
PREC_NONE,
PREC_LOGOR,
PREC_LOGAND,
PREC_BITOR,
PREC_BITXOR,
PREC_BITAND,
PREC_EQ,
PREC_REL,
PREC_SHIFT,
PREC_ADD,
PREC_MULT,
NUM_PRECS
};
struct {
/* The expression at this stack level. */
struct c_expr expr;
/* The precedence of the operator on its left, PREC_NONE at the
bottom of the stack. */
enum prec prec;
enum c_parser_prec prec;
/* The operation on its left. */
enum tree_code op;
/* The source location of this operation. */
@ -5528,11 +5533,11 @@ c_parser_binary_expression (c_parser *parser, struct c_expr *after)
gcc_assert (!after || c_dialect_objc ());
stack[0].loc = c_parser_peek_token (parser)->location;
stack[0].expr = c_parser_cast_expression (parser, after);
stack[0].prec = PREC_NONE;
stack[0].prec = prec;
sp = 0;
while (true)
{
enum prec oprec;
enum c_parser_prec oprec;
enum tree_code ocode;
if (parser->error)
goto out;
@ -5616,9 +5621,13 @@ c_parser_binary_expression (c_parser *parser, struct c_expr *after)
goto out;
}
binary_loc = c_parser_peek_token (parser)->location;
c_parser_consume_token (parser);
while (oprec <= stack[sp].prec)
POP;
{
if (sp == 0)
goto out;
POP;
}
c_parser_consume_token (parser);
switch (ocode)
{
case TRUTH_ANDIF_EXPR:
@ -8243,6 +8252,17 @@ c_parser_pragma (c_parser *parser, enum pragma_context context)
c_parser_omp_taskwait (parser);
return false;
case PRAGMA_OMP_TASKYIELD:
if (context != pragma_compound)
{
if (context == pragma_stmt)
c_parser_error (parser, "%<#pragma omp taskyield%> may only be "
"used in compound statements");
goto bad_stmt;
}
c_parser_omp_taskyield (parser);
return false;
case PRAGMA_OMP_THREADPRIVATE:
c_parser_omp_threadprivate (parser);
return false;
@ -8358,13 +8378,19 @@ c_parser_omp_clause_name (c_parser *parser)
result = PRAGMA_OMP_CLAUSE_COPYPRIVATE;
break;
case 'f':
if (!strcmp ("firstprivate", p))
if (!strcmp ("final", p))
result = PRAGMA_OMP_CLAUSE_FINAL;
else if (!strcmp ("firstprivate", p))
result = PRAGMA_OMP_CLAUSE_FIRSTPRIVATE;
break;
case 'l':
if (!strcmp ("lastprivate", p))
result = PRAGMA_OMP_CLAUSE_LASTPRIVATE;
break;
case 'm':
if (!strcmp ("mergeable", p))
result = PRAGMA_OMP_CLAUSE_MERGEABLE;
break;
case 'n':
if (!strcmp ("nowait", p))
result = PRAGMA_OMP_CLAUSE_NOWAIT;
@ -8606,6 +8632,31 @@ c_parser_omp_clause_firstprivate (c_parser *parser, tree list)
return c_parser_omp_var_list_parens (parser, OMP_CLAUSE_FIRSTPRIVATE, list);
}
/* OpenMP 3.1:
final ( expression ) */
static tree
c_parser_omp_clause_final (c_parser *parser, tree list)
{
location_t loc = c_parser_peek_token (parser)->location;
if (c_parser_next_token_is (parser, CPP_OPEN_PAREN))
{
tree t = c_parser_paren_condition (parser);
tree c;
check_no_duplicate_clause (list, OMP_CLAUSE_FINAL, "final");
c = build_omp_clause (loc, OMP_CLAUSE_FINAL);
OMP_CLAUSE_FINAL_EXPR (c) = t;
OMP_CLAUSE_CHAIN (c) = list;
list = c;
}
else
c_parser_error (parser, "expected %<(%>");
return list;
}
/* OpenMP 2.5:
if ( expression ) */
@ -8640,6 +8691,24 @@ c_parser_omp_clause_lastprivate (c_parser *parser, tree list)
return c_parser_omp_var_list_parens (parser, OMP_CLAUSE_LASTPRIVATE, list);
}
/* OpenMP 3.1:
mergeable */
static tree
c_parser_omp_clause_mergeable (c_parser *parser ATTRIBUTE_UNUSED, tree list)
{
tree c;
/* FIXME: Should we allow duplicates? */
check_no_duplicate_clause (list, OMP_CLAUSE_MERGEABLE, "mergeable");
c = build_omp_clause (c_parser_peek_token (parser)->location,
OMP_CLAUSE_MERGEABLE);
OMP_CLAUSE_CHAIN (c) = list;
return c;
}
/* OpenMP 2.5:
nowait */
@ -8730,7 +8799,12 @@ c_parser_omp_clause_private (c_parser *parser, tree list)
reduction ( reduction-operator : variable-list )
reduction-operator:
One of: + * - & ^ | && || */
One of: + * - & ^ | && ||
OpenMP 3.1:
reduction-operator:
One of: + * - & ^ | && || max min */
static tree
c_parser_omp_clause_reduction (c_parser *parser, tree list)
@ -8766,10 +8840,26 @@ c_parser_omp_clause_reduction (c_parser *parser, tree list)
case CPP_OR_OR:
code = TRUTH_ORIF_EXPR;
break;
case CPP_NAME:
{
const char *p
= IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
if (strcmp (p, "min") == 0)
{
code = MIN_EXPR;
break;
}
if (strcmp (p, "max") == 0)
{
code = MAX_EXPR;
break;
}
}
/* FALLTHRU */
default:
c_parser_error (parser,
"expected %<+%>, %<*%>, %<-%>, %<&%>, "
"%<^%>, %<|%>, %<&&%>, or %<||%>");
"%<^%>, %<|%>, %<&&%>, %<||%>, %<min%> or %<max%>");
c_parser_skip_until_found (parser, CPP_CLOSE_PAREN, 0);
return list;
}
@ -8957,6 +9047,10 @@ c_parser_omp_all_clauses (c_parser *parser, unsigned int mask,
clauses = c_parser_omp_clause_firstprivate (parser, clauses);
c_name = "firstprivate";
break;
case PRAGMA_OMP_CLAUSE_FINAL:
clauses = c_parser_omp_clause_final (parser, clauses);
c_name = "final";
break;
case PRAGMA_OMP_CLAUSE_IF:
clauses = c_parser_omp_clause_if (parser, clauses);
c_name = "if";
@ -8965,6 +9059,10 @@ c_parser_omp_all_clauses (c_parser *parser, unsigned int mask,
clauses = c_parser_omp_clause_lastprivate (parser, clauses);
c_name = "lastprivate";
break;
case PRAGMA_OMP_CLAUSE_MERGEABLE:
clauses = c_parser_omp_clause_mergeable (parser, clauses);
c_name = "mergeable";
break;
case PRAGMA_OMP_CLAUSE_NOWAIT:
clauses = c_parser_omp_clause_nowait (parser, clauses);
c_name = "nowait";
@ -9044,38 +9142,158 @@ c_parser_omp_structured_block (c_parser *parser)
where x is an lvalue expression with scalar type.
OpenMP 3.1:
# pragma omp atomic new-line
update-stmt
# pragma omp atomic read new-line
read-stmt
# pragma omp atomic write new-line
write-stmt
# pragma omp atomic update new-line
update-stmt
# pragma omp atomic capture new-line
capture-stmt
# pragma omp atomic capture new-line
capture-block
read-stmt:
v = x
write-stmt:
x = expr
update-stmt:
expression-stmt | x = x binop expr
capture-stmt:
v = x binop= expr | v = x++ | v = ++x | v = x-- | v = --x
capture-block:
{ v = x; update-stmt; } | { update-stmt; v = x; }
where x and v are lvalue expressions with scalar type.
LOC is the location of the #pragma token. */
static void
c_parser_omp_atomic (location_t loc, c_parser *parser)
{
tree lhs, rhs;
tree stmt;
enum tree_code code;
tree lhs = NULL_TREE, rhs = NULL_TREE, v = NULL_TREE;
tree lhs1 = NULL_TREE, rhs1 = NULL_TREE;
tree stmt, orig_lhs;
enum tree_code code = OMP_ATOMIC, opcode = NOP_EXPR;
struct c_expr rhs_expr;
bool structured_block = false;
if (c_parser_next_token_is (parser, CPP_NAME))
{
const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
if (!strcmp (p, "read"))
code = OMP_ATOMIC_READ;
else if (!strcmp (p, "write"))
code = NOP_EXPR;
else if (!strcmp (p, "update"))
code = OMP_ATOMIC;
else if (!strcmp (p, "capture"))
code = OMP_ATOMIC_CAPTURE_NEW;
else
p = NULL;
if (p)
c_parser_consume_token (parser);
}
c_parser_skip_to_pragma_eol (parser);
switch (code)
{
case OMP_ATOMIC_READ:
case NOP_EXPR: /* atomic write */
v = c_parser_unary_expression (parser).value;
v = c_fully_fold (v, false, NULL);
if (v == error_mark_node)
goto saw_error;
loc = c_parser_peek_token (parser)->location;
if (!c_parser_require (parser, CPP_EQ, "expected %<=%>"))
goto saw_error;
if (code == NOP_EXPR)
lhs = c_parser_expression (parser).value;
else
lhs = c_parser_unary_expression (parser).value;
lhs = c_fully_fold (lhs, false, NULL);
if (lhs == error_mark_node)
goto saw_error;
if (code == NOP_EXPR)
{
/* atomic write is represented by OMP_ATOMIC with NOP_EXPR
opcode. */
code = OMP_ATOMIC;
rhs = lhs;
lhs = v;
v = NULL_TREE;
}
goto done;
case OMP_ATOMIC_CAPTURE_NEW:
if (c_parser_next_token_is (parser, CPP_OPEN_BRACE))
{
c_parser_consume_token (parser);
structured_block = true;
}
else
{
v = c_parser_unary_expression (parser).value;
v = c_fully_fold (v, false, NULL);
if (v == error_mark_node)
goto saw_error;
if (!c_parser_require (parser, CPP_EQ, "expected %<=%>"))
goto saw_error;
}
break;
default:
break;
}
/* For structured_block case we don't know yet whether
old or new x should be captured. */
restart:
lhs = c_parser_unary_expression (parser).value;
lhs = c_fully_fold (lhs, false, NULL);
orig_lhs = lhs;
switch (TREE_CODE (lhs))
{
case ERROR_MARK:
saw_error:
c_parser_skip_to_end_of_block_or_statement (parser);
if (structured_block)
{
if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE))
c_parser_consume_token (parser);
else if (code == OMP_ATOMIC_CAPTURE_NEW)
{
c_parser_skip_to_end_of_block_or_statement (parser);
if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE))
c_parser_consume_token (parser);
}
}
return;
case PREINCREMENT_EXPR:
case POSTINCREMENT_EXPR:
if (code == OMP_ATOMIC_CAPTURE_NEW && !structured_block)
code = OMP_ATOMIC_CAPTURE_OLD;
/* FALLTHROUGH */
case PREINCREMENT_EXPR:
lhs = TREE_OPERAND (lhs, 0);
code = PLUS_EXPR;
opcode = PLUS_EXPR;
rhs = integer_one_node;
break;
case PREDECREMENT_EXPR:
case POSTDECREMENT_EXPR:
if (code == OMP_ATOMIC_CAPTURE_NEW && !structured_block)
code = OMP_ATOMIC_CAPTURE_OLD;
/* FALLTHROUGH */
case PREDECREMENT_EXPR:
lhs = TREE_OPERAND (lhs, 0);
code = MINUS_EXPR;
opcode = MINUS_EXPR;
rhs = integer_one_node;
break;
@ -9100,7 +9318,11 @@ c_parser_omp_atomic (location_t loc, c_parser *parser)
/* This is pre or post increment. */
rhs = TREE_OPERAND (lhs, 1);
lhs = TREE_OPERAND (lhs, 0);
code = NOP_EXPR;
opcode = NOP_EXPR;
if (code == OMP_ATOMIC_CAPTURE_NEW
&& !structured_block
&& TREE_CODE (orig_lhs) == COMPOUND_EXPR)
code = OMP_ATOMIC_CAPTURE_OLD;
break;
}
if (TREE_CODE (TREE_OPERAND (lhs, 1)) == TRUTH_NOT_EXPR
@ -9110,7 +9332,11 @@ c_parser_omp_atomic (location_t loc, c_parser *parser)
/* This is pre or post decrement. */
rhs = TREE_OPERAND (lhs, 1);
lhs = TREE_OPERAND (lhs, 0);
code = NOP_EXPR;
opcode = NOP_EXPR;
if (code == OMP_ATOMIC_CAPTURE_NEW
&& !structured_block
&& TREE_CODE (orig_lhs) == COMPOUND_EXPR)
code = OMP_ATOMIC_CAPTURE_OLD;
break;
}
}
@ -9119,32 +9345,114 @@ c_parser_omp_atomic (location_t loc, c_parser *parser)
switch (c_parser_peek_token (parser)->type)
{
case CPP_MULT_EQ:
code = MULT_EXPR;
opcode = MULT_EXPR;
break;
case CPP_DIV_EQ:
code = TRUNC_DIV_EXPR;
opcode = TRUNC_DIV_EXPR;
break;
case CPP_PLUS_EQ:
code = PLUS_EXPR;
opcode = PLUS_EXPR;
break;
case CPP_MINUS_EQ:
code = MINUS_EXPR;
opcode = MINUS_EXPR;
break;
case CPP_LSHIFT_EQ:
code = LSHIFT_EXPR;
opcode = LSHIFT_EXPR;
break;
case CPP_RSHIFT_EQ:
code = RSHIFT_EXPR;
opcode = RSHIFT_EXPR;
break;
case CPP_AND_EQ:
code = BIT_AND_EXPR;
opcode = BIT_AND_EXPR;
break;
case CPP_OR_EQ:
code = BIT_IOR_EXPR;
opcode = BIT_IOR_EXPR;
break;
case CPP_XOR_EQ:
code = BIT_XOR_EXPR;
opcode = BIT_XOR_EXPR;
break;
case CPP_EQ:
if (structured_block || code == OMP_ATOMIC)
{
location_t aloc = c_parser_peek_token (parser)->location;
location_t rhs_loc;
enum c_parser_prec oprec = PREC_NONE;
c_parser_consume_token (parser);
rhs1 = c_parser_unary_expression (parser).value;
rhs1 = c_fully_fold (rhs1, false, NULL);
if (rhs1 == error_mark_node)
goto saw_error;
switch (c_parser_peek_token (parser)->type)
{
case CPP_SEMICOLON:
if (code == OMP_ATOMIC_CAPTURE_NEW)
{
code = OMP_ATOMIC_CAPTURE_OLD;
v = lhs;
lhs = NULL_TREE;
lhs1 = rhs1;
rhs1 = NULL_TREE;
c_parser_consume_token (parser);
goto restart;
}
c_parser_error (parser,
"invalid form of %<#pragma omp atomic%>");
goto saw_error;
case CPP_MULT:
opcode = MULT_EXPR;
oprec = PREC_MULT;
break;
case CPP_DIV:
opcode = TRUNC_DIV_EXPR;
oprec = PREC_MULT;
break;
case CPP_PLUS:
opcode = PLUS_EXPR;
oprec = PREC_ADD;
break;
case CPP_MINUS:
opcode = MINUS_EXPR;
oprec = PREC_ADD;
break;
case CPP_LSHIFT:
opcode = LSHIFT_EXPR;
oprec = PREC_SHIFT;
break;
case CPP_RSHIFT:
opcode = RSHIFT_EXPR;
oprec = PREC_SHIFT;
break;
case CPP_AND:
opcode = BIT_AND_EXPR;
oprec = PREC_BITAND;
break;
case CPP_OR:
opcode = BIT_IOR_EXPR;
oprec = PREC_BITOR;
break;
case CPP_XOR:
opcode = BIT_XOR_EXPR;
oprec = PREC_BITXOR;
break;
default:
c_parser_error (parser,
"invalid operator for %<#pragma omp atomic%>");
goto saw_error;
}
loc = aloc;
c_parser_consume_token (parser);
rhs_loc = c_parser_peek_token (parser)->location;
if (commutative_tree_code (opcode))
oprec = (enum c_parser_prec) (oprec - 1);
rhs_expr = c_parser_binary_expression (parser, NULL, oprec);
rhs_expr = default_function_array_read_conversion (rhs_loc,
rhs_expr);
rhs = rhs_expr.value;
rhs = c_fully_fold (rhs, false, NULL);
goto stmt_done;
}
/* FALLTHROUGH */
default:
c_parser_error (parser,
"invalid operator for %<#pragma omp atomic%>");
@ -9164,10 +9472,34 @@ c_parser_omp_atomic (location_t loc, c_parser *parser)
rhs = c_fully_fold (rhs, false, NULL);
break;
}
stmt = c_finish_omp_atomic (loc, code, lhs, rhs);
stmt_done:
if (structured_block && code == OMP_ATOMIC_CAPTURE_NEW)
{
if (!c_parser_require (parser, CPP_SEMICOLON, "expected %<;%>"))
goto saw_error;
v = c_parser_unary_expression (parser).value;
v = c_fully_fold (v, false, NULL);
if (v == error_mark_node)
goto saw_error;
if (!c_parser_require (parser, CPP_EQ, "expected %<=%>"))
goto saw_error;
lhs1 = c_parser_unary_expression (parser).value;
lhs1 = c_fully_fold (lhs1, false, NULL);
if (lhs1 == error_mark_node)
goto saw_error;
}
if (structured_block)
{
c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
c_parser_require (parser, CPP_CLOSE_BRACE, "expected %<}%>");
}
done:
stmt = c_finish_omp_atomic (loc, code, opcode, lhs, rhs, v, lhs1, rhs1);
if (stmt != error_mark_node)
add_stmt (stmt);
c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
if (!structured_block)
c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
}
@ -9330,7 +9662,8 @@ c_parser_omp_for_loop (location_t loc,
if (c_parser_next_token_is_not (parser, CPP_SEMICOLON))
{
location_t cond_loc = c_parser_peek_token (parser)->location;
struct c_expr cond_expr = c_parser_binary_expression (parser, NULL);
struct c_expr cond_expr = c_parser_binary_expression (parser, NULL,
PREC_NONE);
cond = cond_expr.value;
cond = c_objc_common_truthvalue_conversion (cond_loc, cond);
@ -9827,7 +10160,9 @@ c_parser_omp_single (location_t loc, c_parser *parser)
| (1u << PRAGMA_OMP_CLAUSE_DEFAULT) \
| (1u << PRAGMA_OMP_CLAUSE_PRIVATE) \
| (1u << PRAGMA_OMP_CLAUSE_FIRSTPRIVATE) \
| (1u << PRAGMA_OMP_CLAUSE_SHARED))
| (1u << PRAGMA_OMP_CLAUSE_SHARED) \
| (1u << PRAGMA_OMP_CLAUSE_FINAL) \
| (1u << PRAGMA_OMP_CLAUSE_MERGEABLE))
static tree
c_parser_omp_task (location_t loc, c_parser *parser)
@ -9856,6 +10191,20 @@ c_parser_omp_taskwait (c_parser *parser)
c_finish_omp_taskwait (loc);
}
/* OpenMP 3.1:
# pragma omp taskyield new-line
*/
static void
c_parser_omp_taskyield (c_parser *parser)
{
location_t loc = c_parser_peek_token (parser)->location;
c_parser_consume_pragma (parser);
c_parser_skip_to_pragma_eol (parser);
c_finish_omp_taskyield (loc);
}
/* Main entry point to parsing most OpenMP pragmas. */
static void

View File

@ -10451,6 +10451,8 @@ c_finish_omp_clauses (tree clauses)
case PLUS_EXPR:
case MULT_EXPR:
case MINUS_EXPR:
case MIN_EXPR:
case MAX_EXPR:
break;
case BIT_AND_EXPR:
r_name = "&";
@ -10567,6 +10569,8 @@ c_finish_omp_clauses (tree clauses)
case OMP_CLAUSE_DEFAULT:
case OMP_CLAUSE_UNTIED:
case OMP_CLAUSE_COLLAPSE:
case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_MERGEABLE:
pc = &OMP_CLAUSE_CHAIN (c);
continue;
@ -10596,6 +10600,10 @@ c_finish_omp_clauses (tree clauses)
case OMP_CLAUSE_DEFAULT_UNSPECIFIED:
break;
case OMP_CLAUSE_DEFAULT_SHARED:
/* const vars may be specified in firstprivate clause. */
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE
&& TREE_READONLY (t))
break;
share_name = "shared";
break;
case OMP_CLAUSE_DEFAULT_PRIVATE:

View File

@ -1,3 +1,33 @@
2011-08-02 Jakub Jelinek <jakub@redhat.com>
* cp-tree.h (finish_omp_atomic): Adjust prototype.
(cxx_omp_const_qual_no_mutable): New prototype.
(finish_omp_taskyield): New prototype.
* parser.c (cp_parser_omp_atomic): (cp_parser_omp_atomic): Handle
parsing OpenMP 3.1 atomics. Adjust finish_omp_atomic caller.
(cp_parser_omp_clause_name): Handle final and mergeable clauses.
(cp_parser_omp_clause_final, cp_parser_omp_clause_mergeable): New
functions.
(cp_parser_omp_all_clauses): Handle PRAGMA_OMP_CLAUSE_FINAL
and PRAGMA_OMP_CLAUSE_MERGEABLE.
(OMP_TASK_CLAUSE_MASK): Allow final and mergeable clauses.
(cp_parser_omp_taskyield): New function.
(cp_parser_pragma): Handle PRAGMA_OMP_TASKYIELD.
(cp_parser_omp_clause_reduction): Handle min and max.
* pt.c (tsubst_expr) <case OMP_ATOMIC>: Handle OpenMP 3.1 atomics.
(tsubst_omp_clauses): Handle OMP_CLAUSE_FINAL and
OMP_CLAUSE_MERGEABLE.
* semantics.c (finish_omp_atomic): Add OPCODE, V, LHS1 and RHS1
arguments. Handle OpenMP 3.1 atomics. Adjust c_finish_omp_atomic
caller.
(finish_omp_clauses): Don't complain about const qualified
predetermined vars and static data members in firstprivate clause.
Handle OMP_CLAUSE_FINAL and OMP_CLAUSE_MERGEABLE. Handle MIN_EXPR
and MAX_EXPR.
(finish_omp_taskyield): New function.
* cp-gimplify.c (cxx_omp_const_qual_no_mutable): New function.
(cxx_omp_predetermined_sharing): Use it.
2011-08-02 Jason Merrill <jason@redhat.com>
* call.c (build_call_a): Also check at_function_scope_p.

View File

@ -1365,26 +1365,15 @@ cxx_omp_privatize_by_reference (const_tree decl)
return is_invisiref_parm (decl);
}
/* True if OpenMP sharing attribute of DECL is predetermined. */
enum omp_clause_default_kind
cxx_omp_predetermined_sharing (tree decl)
/* Return true if DECL is const qualified var having no mutable member. */
bool
cxx_omp_const_qual_no_mutable (tree decl)
{
tree type;
/* Static data members are predetermined as shared. */
if (TREE_STATIC (decl))
{
tree ctx = CP_DECL_CONTEXT (decl);
if (TYPE_P (ctx) && MAYBE_CLASS_TYPE_P (ctx))
return OMP_CLAUSE_DEFAULT_SHARED;
}
type = TREE_TYPE (decl);
tree type = TREE_TYPE (decl);
if (TREE_CODE (type) == REFERENCE_TYPE)
{
if (!is_invisiref_parm (decl))
return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
return false;
type = TREE_TYPE (type);
if (TREE_CODE (decl) == RESULT_DECL && DECL_NAME (decl))
@ -1408,11 +1397,32 @@ cxx_omp_predetermined_sharing (tree decl)
}
if (type == error_mark_node)
return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
return false;
/* Variables with const-qualified type having no mutable member
are predetermined shared. */
if (TYPE_READONLY (type) && !cp_has_mutable_p (type))
return true;
return false;
}
/* True if OpenMP sharing attribute of DECL is predetermined. */
enum omp_clause_default_kind
cxx_omp_predetermined_sharing (tree decl)
{
/* Static data members are predetermined shared. */
if (TREE_STATIC (decl))
{
tree ctx = CP_DECL_CONTEXT (decl);
if (TYPE_P (ctx) && MAYBE_CLASS_TYPE_P (ctx))
return OMP_CLAUSE_DEFAULT_SHARED;
}
/* Const qualified vars having no mutable member are predetermined
shared. */
if (cxx_omp_const_qual_no_mutable (decl))
return OMP_CLAUSE_DEFAULT_SHARED;
return OMP_CLAUSE_DEFAULT_UNSPECIFIED;

View File

@ -5454,10 +5454,12 @@ extern tree begin_omp_task (void);
extern tree finish_omp_task (tree, tree);
extern tree finish_omp_for (location_t, tree, tree,
tree, tree, tree, tree, tree);
extern void finish_omp_atomic (enum tree_code, tree, tree);
extern void finish_omp_atomic (enum tree_code, enum tree_code,
tree, tree, tree, tree, tree);
extern void finish_omp_barrier (void);
extern void finish_omp_flush (void);
extern void finish_omp_taskwait (void);
extern void finish_omp_taskyield (void);
extern bool cxx_omp_create_clause_info (tree, tree, bool, bool, bool);
extern tree baselink_for_fns (tree);
extern void finish_static_assert (tree, tree, location_t,
@ -5765,6 +5767,7 @@ extern void init_shadowed_var_for_decl (void);
extern int cp_gimplify_expr (tree *, gimple_seq *,
gimple_seq *);
extern void cp_genericize (tree);
extern bool cxx_omp_const_qual_no_mutable (tree);
extern enum omp_clause_default_kind cxx_omp_predetermined_sharing (tree);
extern tree cxx_omp_clause_default_ctor (tree, tree, tree);
extern tree cxx_omp_clause_copy_ctor (tree, tree, tree);

View File

@ -23600,13 +23600,19 @@ cp_parser_omp_clause_name (cp_parser *parser)
result = PRAGMA_OMP_CLAUSE_COPYPRIVATE;
break;
case 'f':
if (!strcmp ("firstprivate", p))
if (!strcmp ("final", p))
result = PRAGMA_OMP_CLAUSE_FINAL;
else if (!strcmp ("firstprivate", p))
result = PRAGMA_OMP_CLAUSE_FIRSTPRIVATE;
break;
case 'l':
if (!strcmp ("lastprivate", p))
result = PRAGMA_OMP_CLAUSE_LASTPRIVATE;
break;
case 'm':
if (!strcmp ("mergeable", p))
result = PRAGMA_OMP_CLAUSE_MERGEABLE;
break;
case 'n':
if (!strcmp ("nowait", p))
result = PRAGMA_OMP_CLAUSE_NOWAIT;
@ -23836,6 +23842,34 @@ cp_parser_omp_clause_default (cp_parser *parser, tree list, location_t location)
return c;
}
/* OpenMP 3.1:
final ( expression ) */
static tree
cp_parser_omp_clause_final (cp_parser *parser, tree list, location_t location)
{
tree t, c;
if (!cp_parser_require (parser, CPP_OPEN_PAREN, RT_OPEN_PAREN))
return list;
t = cp_parser_condition (parser);
if (t == error_mark_node
|| !cp_parser_require (parser, CPP_CLOSE_PAREN, RT_CLOSE_PAREN))
cp_parser_skip_to_closing_parenthesis (parser, /*recovering=*/true,
/*or_comma=*/false,
/*consume_paren=*/true);
check_no_duplicate_clause (list, OMP_CLAUSE_FINAL, "final", location);
c = build_omp_clause (location, OMP_CLAUSE_FINAL);
OMP_CLAUSE_FINAL_EXPR (c) = t;
OMP_CLAUSE_CHAIN (c) = list;
return c;
}
/* OpenMP 2.5:
if ( expression ) */
@ -23864,6 +23898,23 @@ cp_parser_omp_clause_if (cp_parser *parser, tree list, location_t location)
return c;
}
/* OpenMP 3.1:
mergeable */
static tree
cp_parser_omp_clause_mergeable (cp_parser *parser ATTRIBUTE_UNUSED,
tree list, location_t location)
{
tree c;
check_no_duplicate_clause (list, OMP_CLAUSE_MERGEABLE, "mergeable",
location);
c = build_omp_clause (location, OMP_CLAUSE_MERGEABLE);
OMP_CLAUSE_CHAIN (c) = list;
return c;
}
/* OpenMP 2.5:
nowait */
@ -23931,7 +23982,12 @@ cp_parser_omp_clause_ordered (cp_parser *parser ATTRIBUTE_UNUSED,
reduction ( reduction-operator : variable-list )
reduction-operator:
One of: + * - & ^ | && || */
One of: + * - & ^ | && ||
OpenMP 3.1:
reduction-operator:
One of: + * - & ^ | && || min max */
static tree
cp_parser_omp_clause_reduction (cp_parser *parser, tree list)
@ -23968,9 +24024,26 @@ cp_parser_omp_clause_reduction (cp_parser *parser, tree list)
case CPP_OR_OR:
code = TRUTH_ORIF_EXPR;
break;
case CPP_NAME:
{
tree id = cp_lexer_peek_token (parser->lexer)->u.value;
const char *p = IDENTIFIER_POINTER (id);
if (strcmp (p, "min") == 0)
{
code = MIN_EXPR;
break;
}
if (strcmp (p, "max") == 0)
{
code = MAX_EXPR;
break;
}
}
/* FALLTHROUGH */
default:
cp_parser_error (parser, "expected %<+%>, %<*%>, %<-%>, %<&%>, %<^%>, "
"%<|%>, %<&&%>, or %<||%>");
"%<|%>, %<&&%>, %<||%>, %<min%> or %<max%>");
resync_fail:
cp_parser_skip_to_closing_parenthesis (parser, /*recovering=*/true,
/*or_comma=*/false,
@ -24143,6 +24216,10 @@ cp_parser_omp_all_clauses (cp_parser *parser, unsigned int mask,
token->location);
c_name = "default";
break;
case PRAGMA_OMP_CLAUSE_FINAL:
clauses = cp_parser_omp_clause_final (parser, clauses, token->location);
c_name = "final";
break;
case PRAGMA_OMP_CLAUSE_FIRSTPRIVATE:
clauses = cp_parser_omp_var_list (parser, OMP_CLAUSE_FIRSTPRIVATE,
clauses);
@ -24157,6 +24234,11 @@ cp_parser_omp_all_clauses (cp_parser *parser, unsigned int mask,
clauses);
c_name = "lastprivate";
break;
case PRAGMA_OMP_CLAUSE_MERGEABLE:
clauses = cp_parser_omp_clause_mergeable (parser, clauses,
token->location);
c_name = "mergeable";
break;
case PRAGMA_OMP_CLAUSE_NOWAIT:
clauses = cp_parser_omp_clause_nowait (parser, clauses, token->location);
c_name = "nowait";
@ -24267,34 +24349,140 @@ cp_parser_omp_structured_block (cp_parser *parser)
binop:
+, *, -, /, &, ^, |, <<, >>
where x is an lvalue expression with scalar type. */
where x is an lvalue expression with scalar type.
OpenMP 3.1:
# pragma omp atomic new-line
update-stmt
# pragma omp atomic read new-line
read-stmt
# pragma omp atomic write new-line
write-stmt
# pragma omp atomic update new-line
update-stmt
# pragma omp atomic capture new-line
capture-stmt
# pragma omp atomic capture new-line
capture-block
read-stmt:
v = x
write-stmt:
x = expr
update-stmt:
expression-stmt | x = x binop expr
capture-stmt:
v = x binop= expr | v = x++ | v = ++x | v = x-- | v = --x
capture-block:
{ v = x; update-stmt; } | { update-stmt; v = x; }
where x and v are lvalue expressions with scalar type. */
static void
cp_parser_omp_atomic (cp_parser *parser, cp_token *pragma_tok)
{
tree lhs, rhs;
enum tree_code code;
tree lhs = NULL_TREE, rhs = NULL_TREE, v = NULL_TREE, lhs1 = NULL_TREE;
tree rhs1 = NULL_TREE, orig_lhs;
enum tree_code code = OMP_ATOMIC, opcode = NOP_EXPR;
bool structured_block = false;
if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
{
tree id = cp_lexer_peek_token (parser->lexer)->u.value;
const char *p = IDENTIFIER_POINTER (id);
if (!strcmp (p, "read"))
code = OMP_ATOMIC_READ;
else if (!strcmp (p, "write"))
code = NOP_EXPR;
else if (!strcmp (p, "update"))
code = OMP_ATOMIC;
else if (!strcmp (p, "capture"))
code = OMP_ATOMIC_CAPTURE_NEW;
else
p = NULL;
if (p)
cp_lexer_consume_token (parser->lexer);
}
cp_parser_require_pragma_eol (parser, pragma_tok);
switch (code)
{
case OMP_ATOMIC_READ:
case NOP_EXPR: /* atomic write */
v = cp_parser_unary_expression (parser, /*address_p=*/false,
/*cast_p=*/false, NULL);
if (v == error_mark_node)
goto saw_error;
if (!cp_parser_require (parser, CPP_EQ, RT_EQ))
goto saw_error;
if (code == NOP_EXPR)
lhs = cp_parser_expression (parser, /*cast_p=*/false, NULL);
else
lhs = cp_parser_unary_expression (parser, /*address_p=*/false,
/*cast_p=*/false, NULL);
if (lhs == error_mark_node)
goto saw_error;
if (code == NOP_EXPR)
{
/* atomic write is represented by OMP_ATOMIC with NOP_EXPR
opcode. */
code = OMP_ATOMIC;
rhs = lhs;
lhs = v;
v = NULL_TREE;
}
goto done;
case OMP_ATOMIC_CAPTURE_NEW:
if (cp_lexer_next_token_is (parser->lexer, CPP_OPEN_BRACE))
{
cp_lexer_consume_token (parser->lexer);
structured_block = true;
}
else
{
v = cp_parser_unary_expression (parser, /*address_p=*/false,
/*cast_p=*/false, NULL);
if (v == error_mark_node)
goto saw_error;
if (!cp_parser_require (parser, CPP_EQ, RT_EQ))
goto saw_error;
}
default:
break;
}
restart:
lhs = cp_parser_unary_expression (parser, /*address_p=*/false,
/*cast_p=*/false, NULL);
orig_lhs = lhs;
switch (TREE_CODE (lhs))
{
case ERROR_MARK:
goto saw_error;
case PREINCREMENT_EXPR:
case POSTINCREMENT_EXPR:
if (code == OMP_ATOMIC_CAPTURE_NEW && !structured_block)
code = OMP_ATOMIC_CAPTURE_OLD;
/* FALLTHROUGH */
case PREINCREMENT_EXPR:
lhs = TREE_OPERAND (lhs, 0);
code = PLUS_EXPR;
opcode = PLUS_EXPR;
rhs = integer_one_node;
break;
case PREDECREMENT_EXPR:
case POSTDECREMENT_EXPR:
if (code == OMP_ATOMIC_CAPTURE_NEW && !structured_block)
code = OMP_ATOMIC_CAPTURE_OLD;
/* FALLTHROUGH */
case PREDECREMENT_EXPR:
lhs = TREE_OPERAND (lhs, 0);
code = MINUS_EXPR;
opcode = MINUS_EXPR;
rhs = integer_one_node;
break;
@ -24312,48 +24500,123 @@ cp_parser_omp_atomic (cp_parser *parser, cp_token *pragma_tok)
case MODIFY_EXPR:
if (TREE_CODE (lhs) == MODIFY_EXPR
&& TREE_CODE (TREE_TYPE (TREE_OPERAND (lhs, 0))) == BOOLEAN_TYPE)
{
/* Undo effects of boolean_increment. */
if (integer_onep (TREE_OPERAND (lhs, 1)))
{
/* This is pre or post increment. */
rhs = TREE_OPERAND (lhs, 1);
lhs = TREE_OPERAND (lhs, 0);
code = NOP_EXPR;
break;
}
}
{
/* Undo effects of boolean_increment. */
if (integer_onep (TREE_OPERAND (lhs, 1)))
{
/* This is pre or post increment. */
rhs = TREE_OPERAND (lhs, 1);
lhs = TREE_OPERAND (lhs, 0);
opcode = NOP_EXPR;
if (code == OMP_ATOMIC_CAPTURE_NEW
&& !structured_block
&& TREE_CODE (orig_lhs) == COMPOUND_EXPR)
code = OMP_ATOMIC_CAPTURE_OLD;
break;
}
}
/* FALLTHRU */
default:
switch (cp_lexer_peek_token (parser->lexer)->type)
{
case CPP_MULT_EQ:
code = MULT_EXPR;
opcode = MULT_EXPR;
break;
case CPP_DIV_EQ:
code = TRUNC_DIV_EXPR;
opcode = TRUNC_DIV_EXPR;
break;
case CPP_PLUS_EQ:
code = PLUS_EXPR;
opcode = PLUS_EXPR;
break;
case CPP_MINUS_EQ:
code = MINUS_EXPR;
opcode = MINUS_EXPR;
break;
case CPP_LSHIFT_EQ:
code = LSHIFT_EXPR;
opcode = LSHIFT_EXPR;
break;
case CPP_RSHIFT_EQ:
code = RSHIFT_EXPR;
opcode = RSHIFT_EXPR;
break;
case CPP_AND_EQ:
code = BIT_AND_EXPR;
opcode = BIT_AND_EXPR;
break;
case CPP_OR_EQ:
code = BIT_IOR_EXPR;
opcode = BIT_IOR_EXPR;
break;
case CPP_XOR_EQ:
code = BIT_XOR_EXPR;
opcode = BIT_XOR_EXPR;
break;
case CPP_EQ:
if (structured_block || code == OMP_ATOMIC)
{
enum cp_parser_prec oprec;
cp_token *token;
cp_lexer_consume_token (parser->lexer);
rhs1 = cp_parser_unary_expression (parser, /*address_p=*/false,
/*cast_p=*/false, NULL);
if (rhs1 == error_mark_node)
goto saw_error;
token = cp_lexer_peek_token (parser->lexer);
switch (token->type)
{
case CPP_SEMICOLON:
if (code == OMP_ATOMIC_CAPTURE_NEW)
{
code = OMP_ATOMIC_CAPTURE_OLD;
v = lhs;
lhs = NULL_TREE;
lhs1 = rhs1;
rhs1 = NULL_TREE;
cp_lexer_consume_token (parser->lexer);
goto restart;
}
cp_parser_error (parser,
"invalid form of %<#pragma omp atomic%>");
goto saw_error;
case CPP_MULT:
opcode = MULT_EXPR;
break;
case CPP_DIV:
opcode = TRUNC_DIV_EXPR;
break;
case CPP_PLUS:
opcode = PLUS_EXPR;
break;
case CPP_MINUS:
opcode = MINUS_EXPR;
break;
case CPP_LSHIFT:
opcode = LSHIFT_EXPR;
break;
case CPP_RSHIFT:
opcode = RSHIFT_EXPR;
break;
case CPP_AND:
opcode = BIT_AND_EXPR;
break;
case CPP_OR:
opcode = BIT_IOR_EXPR;
break;
case CPP_XOR:
opcode = BIT_XOR_EXPR;
break;
default:
cp_parser_error (parser,
"invalid operator for %<#pragma omp atomic%>");
goto saw_error;
}
oprec = TOKEN_PRECEDENCE (token);
gcc_assert (oprec != PREC_NOT_OPERATOR);
if (commutative_tree_code (opcode))
oprec = (enum cp_parser_prec) (oprec - 1);
cp_lexer_consume_token (parser->lexer);
rhs = cp_parser_binary_expression (parser, false, false,
oprec, NULL);
if (rhs == error_mark_node)
goto saw_error;
goto stmt_done;
}
/* FALLTHROUGH */
default:
cp_parser_error (parser,
"invalid operator for %<#pragma omp atomic%>");
@ -24366,12 +24629,46 @@ cp_parser_omp_atomic (cp_parser *parser, cp_token *pragma_tok)
goto saw_error;
break;
}
finish_omp_atomic (code, lhs, rhs);
cp_parser_consume_semicolon_at_end_of_statement (parser);
stmt_done:
if (structured_block && code == OMP_ATOMIC_CAPTURE_NEW)
{
if (!cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON))
goto saw_error;
v = cp_parser_unary_expression (parser, /*address_p=*/false,
/*cast_p=*/false, NULL);
if (v == error_mark_node)
goto saw_error;
if (!cp_parser_require (parser, CPP_EQ, RT_EQ))
goto saw_error;
lhs1 = cp_parser_unary_expression (parser, /*address_p=*/false,
/*cast_p=*/false, NULL);
if (lhs1 == error_mark_node)
goto saw_error;
}
if (structured_block)
{
cp_parser_consume_semicolon_at_end_of_statement (parser);
cp_parser_require (parser, CPP_CLOSE_BRACE, RT_CLOSE_BRACE);
}
done:
finish_omp_atomic (code, opcode, lhs, rhs, v, lhs1, rhs1);
if (!structured_block)
cp_parser_consume_semicolon_at_end_of_statement (parser);
return;
saw_error:
cp_parser_skip_to_end_of_block_or_statement (parser);
if (structured_block)
{
if (cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_BRACE))
cp_lexer_consume_token (parser->lexer);
else if (code == OMP_ATOMIC_CAPTURE_NEW)
{
cp_parser_skip_to_end_of_block_or_statement (parser);
if (cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_BRACE))
cp_lexer_consume_token (parser->lexer);
}
}
}
@ -25233,7 +25530,9 @@ cp_parser_omp_single (cp_parser *parser, cp_token *pragma_tok)
| (1u << PRAGMA_OMP_CLAUSE_DEFAULT) \
| (1u << PRAGMA_OMP_CLAUSE_PRIVATE) \
| (1u << PRAGMA_OMP_CLAUSE_FIRSTPRIVATE) \
| (1u << PRAGMA_OMP_CLAUSE_SHARED))
| (1u << PRAGMA_OMP_CLAUSE_SHARED) \
| (1u << PRAGMA_OMP_CLAUSE_FINAL) \
| (1u << PRAGMA_OMP_CLAUSE_MERGEABLE))
static tree
cp_parser_omp_task (cp_parser *parser, cp_token *pragma_tok)
@ -25260,6 +25559,16 @@ cp_parser_omp_taskwait (cp_parser *parser, cp_token *pragma_tok)
finish_omp_taskwait ();
}
/* OpenMP 3.1:
# pragma omp taskyield new-line */
static void
cp_parser_omp_taskyield (cp_parser *parser, cp_token *pragma_tok)
{
cp_parser_require_pragma_eol (parser, pragma_tok);
finish_omp_taskyield ();
}
/* OpenMP 2.5:
# pragma omp threadprivate (variable-list) */
@ -25435,6 +25744,22 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context)
}
break;
case PRAGMA_OMP_TASKYIELD:
switch (context)
{
case pragma_compound:
cp_parser_omp_taskyield (parser, pragma_tok);
return false;
case pragma_stmt:
error_at (pragma_tok->location,
"%<#pragma omp taskyield%> may only be "
"used in compound statements");
break;
default:
goto bad_stmt;
}
break;
case PRAGMA_OMP_THREADPRIVATE:
cp_parser_omp_threadprivate (parser, pragma_tok);
return false;

View File

@ -12181,6 +12181,7 @@ tsubst_omp_clauses (tree clauses, tree args, tsubst_flags_t complain,
case OMP_CLAUSE_NUM_THREADS:
case OMP_CLAUSE_SCHEDULE:
case OMP_CLAUSE_COLLAPSE:
case OMP_CLAUSE_FINAL:
OMP_CLAUSE_OPERAND (nc, 0)
= tsubst_expr (OMP_CLAUSE_OPERAND (oc, 0), args, complain,
in_decl, /*integral_constant_expression_p=*/false);
@ -12189,6 +12190,7 @@ tsubst_omp_clauses (tree clauses, tree args, tsubst_flags_t complain,
case OMP_CLAUSE_ORDERED:
case OMP_CLAUSE_DEFAULT:
case OMP_CLAUSE_UNTIED:
case OMP_CLAUSE_MERGEABLE:
break;
default:
gcc_unreachable ();
@ -12819,12 +12821,56 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl,
case OMP_ATOMIC:
gcc_assert (OMP_ATOMIC_DEPENDENT_P (t));
{
tree op1 = TREE_OPERAND (t, 1);
tree lhs = RECUR (TREE_OPERAND (op1, 0));
tree rhs = RECUR (TREE_OPERAND (op1, 1));
finish_omp_atomic (TREE_CODE (op1), lhs, rhs);
}
if (TREE_CODE (TREE_OPERAND (t, 1)) != MODIFY_EXPR)
{
tree op1 = TREE_OPERAND (t, 1);
tree rhs1 = NULL_TREE;
tree lhs, rhs;
if (TREE_CODE (op1) == COMPOUND_EXPR)
{
rhs1 = RECUR (TREE_OPERAND (op1, 0));
op1 = TREE_OPERAND (op1, 1);
}
lhs = RECUR (TREE_OPERAND (op1, 0));
rhs = RECUR (TREE_OPERAND (op1, 1));
finish_omp_atomic (OMP_ATOMIC, TREE_CODE (op1), lhs, rhs,
NULL_TREE, NULL_TREE, rhs1);
}
else
{
tree op1 = TREE_OPERAND (t, 1);
tree v = NULL_TREE, lhs, rhs = NULL_TREE, lhs1 = NULL_TREE;
tree rhs1 = NULL_TREE;
enum tree_code code = TREE_CODE (TREE_OPERAND (op1, 1));
enum tree_code opcode = NOP_EXPR;
if (code == OMP_ATOMIC_READ)
{
v = RECUR (TREE_OPERAND (op1, 0));
lhs = RECUR (TREE_OPERAND (TREE_OPERAND (op1, 1), 0));
}
else if (code == OMP_ATOMIC_CAPTURE_OLD
|| code == OMP_ATOMIC_CAPTURE_NEW)
{
tree op11 = TREE_OPERAND (TREE_OPERAND (op1, 1), 1);
v = RECUR (TREE_OPERAND (op1, 0));
lhs1 = RECUR (TREE_OPERAND (TREE_OPERAND (op1, 1), 0));
if (TREE_CODE (op11) == COMPOUND_EXPR)
{
rhs1 = RECUR (TREE_OPERAND (op11, 0));
op11 = TREE_OPERAND (op11, 1);
}
lhs = RECUR (TREE_OPERAND (op11, 0));
rhs = RECUR (TREE_OPERAND (op11, 1));
opcode = TREE_CODE (op11);
}
else
{
code = OMP_ATOMIC;
lhs = RECUR (TREE_OPERAND (op1, 0));
rhs = RECUR (TREE_OPERAND (op1, 1));
}
finish_omp_atomic (code, opcode, lhs, rhs, v, lhs1, rhs1);
}
break;
case EXPR_PACK_EXPANSION:

View File

@ -3905,6 +3905,14 @@ finish_omp_clauses (tree clauses)
OMP_CLAUSE_IF_EXPR (c) = t;
break;
case OMP_CLAUSE_FINAL:
t = OMP_CLAUSE_FINAL_EXPR (c);
t = maybe_convert_cond (t);
if (t == error_mark_node)
remove = true;
OMP_CLAUSE_FINAL_EXPR (c) = t;
break;
case OMP_CLAUSE_NUM_THREADS:
t = OMP_CLAUSE_NUM_THREADS_EXPR (c);
if (t == error_mark_node)
@ -3936,6 +3944,7 @@ finish_omp_clauses (tree clauses)
case OMP_CLAUSE_DEFAULT:
case OMP_CLAUSE_UNTIED:
case OMP_CLAUSE_COLLAPSE:
case OMP_CLAUSE_MERGEABLE:
break;
default:
@ -4030,6 +4039,8 @@ finish_omp_clauses (tree clauses)
case PLUS_EXPR:
case MULT_EXPR:
case MINUS_EXPR:
case MIN_EXPR:
case MAX_EXPR:
break;
default:
error ("%qE has invalid type for %<reduction(%s)%>",
@ -4074,6 +4085,10 @@ finish_omp_clauses (tree clauses)
case OMP_CLAUSE_DEFAULT_UNSPECIFIED:
break;
case OMP_CLAUSE_DEFAULT_SHARED:
/* const vars may be specified in firstprivate clause. */
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE
&& cxx_omp_const_qual_no_mutable (t))
break;
share_name = "shared";
break;
case OMP_CLAUSE_DEFAULT_PRIVATE:
@ -4697,15 +4712,22 @@ finish_omp_for (location_t locus, tree declv, tree initv, tree condv,
}
void
finish_omp_atomic (enum tree_code code, tree lhs, tree rhs)
finish_omp_atomic (enum tree_code code, enum tree_code opcode, tree lhs,
tree rhs, tree v, tree lhs1, tree rhs1)
{
tree orig_lhs;
tree orig_rhs;
tree orig_v;
tree orig_lhs1;
tree orig_rhs1;
bool dependent_p;
tree stmt;
orig_lhs = lhs;
orig_rhs = rhs;
orig_v = v;
orig_lhs1 = lhs1;
orig_rhs1 = rhs1;
dependent_p = false;
stmt = NULL_TREE;
@ -4714,22 +4736,53 @@ finish_omp_atomic (enum tree_code code, tree lhs, tree rhs)
if (processing_template_decl)
{
dependent_p = (type_dependent_expression_p (lhs)
|| type_dependent_expression_p (rhs));
|| (rhs && type_dependent_expression_p (rhs))
|| (v && type_dependent_expression_p (v))
|| (lhs1 && type_dependent_expression_p (lhs1))
|| (rhs1 && type_dependent_expression_p (rhs1)));
if (!dependent_p)
{
lhs = build_non_dependent_expr (lhs);
rhs = build_non_dependent_expr (rhs);
if (rhs)
rhs = build_non_dependent_expr (rhs);
if (v)
v = build_non_dependent_expr (v);
if (lhs1)
lhs1 = build_non_dependent_expr (lhs1);
if (rhs1)
rhs1 = build_non_dependent_expr (rhs1);
}
}
if (!dependent_p)
{
stmt = c_finish_omp_atomic (input_location, code, lhs, rhs);
stmt = c_finish_omp_atomic (input_location, code, opcode, lhs, rhs,
v, lhs1, rhs1);
if (stmt == error_mark_node)
return;
}
if (processing_template_decl)
stmt = build2 (OMP_ATOMIC, void_type_node, integer_zero_node,
build2 (code, void_type_node, orig_lhs, orig_rhs));
{
if (code == OMP_ATOMIC_READ)
{
stmt = build_min_nt (OMP_ATOMIC_READ, orig_lhs);
stmt = build2 (MODIFY_EXPR, void_type_node, orig_v, stmt);
}
else
{
if (opcode == NOP_EXPR)
stmt = build2 (MODIFY_EXPR, void_type_node, orig_lhs, orig_rhs);
else
stmt = build2 (opcode, void_type_node, orig_lhs, orig_rhs);
if (orig_rhs1)
stmt = build_min_nt (COMPOUND_EXPR, orig_rhs1, stmt);
if (code != OMP_ATOMIC)
{
stmt = build_min_nt (code, orig_lhs1, stmt);
stmt = build2 (MODIFY_EXPR, void_type_node, orig_v, stmt);
}
}
stmt = build2 (OMP_ATOMIC, void_type_node, integer_zero_node, stmt);
}
add_stmt (stmt);
}
@ -4762,6 +4815,16 @@ finish_omp_taskwait (void)
release_tree_vector (vec);
finish_expr_stmt (stmt);
}
void
finish_omp_taskyield (void)
{
tree fn = built_in_decls[BUILT_IN_GOMP_TASKYIELD];
VEC(tree,gc) *vec = make_tree_vector ();
tree stmt = finish_call_expr (fn, &vec, false, false, tf_warning_or_error);
release_tree_vector (vec);
finish_expr_stmt (stmt);
}
void
init_cp_semantics (void)

View File

@ -2210,7 +2210,9 @@ Clauses are represented by separate sub-codes defined in
@code{OMP_CLAUSE_COPYPRIVATE}, @code{OMP_CLAUSE_IF},
@code{OMP_CLAUSE_NUM_THREADS}, @code{OMP_CLAUSE_SCHEDULE},
@code{OMP_CLAUSE_NOWAIT}, @code{OMP_CLAUSE_ORDERED},
@code{OMP_CLAUSE_DEFAULT}, and @code{OMP_CLAUSE_REDUCTION}. Each code
@code{OMP_CLAUSE_DEFAULT}, @code{OMP_CLAUSE_REDUCTION},
@code{OMP_CLAUSE_COLLAPSE}, @code{OMP_CLAUSE_UNTIED},
@code{OMP_CLAUSE_FINAL}, and @code{OMP_CLAUSE_MERGEABLE}. Each code
represents the corresponding OpenMP clause.
Clauses associated with the same directive are chained together

View File

@ -1,3 +1,60 @@
2011-08-02 Jakub Jelinek <jakub@redhat.com>
PR fortran/46752
* cpp.c (cpp_define_builtins): Change _OPENMP to 201107.
* openmp.c (gfc_free_omp_clauses): Free also final_expr.
(OMP_CLAUSE_FINAL, OMP_CLAUSE_MERGEABLE): Define.
(gfc_match_omp_clauses): Handle parsing final and mergeable
clauses.
(OMP_TASK_CLAUSES): Allow final and mergeable clauses.
(gfc_match_omp_taskyield): New function.
(resolve_omp_clauses): Resolve final clause. Allow POINTERs and
Cray pointers in clauses other than REDUCTION.
(gfc_match_omp_atomic): Match optional
read/write/update/capture keywords after !$omp atomic.
(resolve_omp_atomic): Handle all OpenMP 3.1 atomic forms.
* dump-parse-tree.c (show_omp_node): Handle EXEC_OMP_TASKYIELD,
print final and mergeable clauses.
(show_code_node): Handle EXEC_OMP_TASKYIELD.
* trans-openmp.c (gfc_trans_omp_clauses): Handle final and
mergeable clauses.
(gfc_trans_omp_taskyield): New function.
(gfc_trans_omp_directive): Handle EXEC_OMP_TASKYIELD.
(gfc_trans_omp_atomic): Handle all OpenMP 3.1 atomic forms.
(gfc_omp_clause_copy_ctor): Handle non-allocated allocatable.
(gfc_omp_predetermined_sharing): Adjust comment.
* gfortran.h (gfc_statement): Add ST_OMP_TASKYIELD and
ST_OMP_END_ATOMIC.
(gfc_omp_clauses): Add final_expr and mergeable fields.
(gfc_exec_op): Add EXEC_OMP_TASKYIELD.
(gfc_omp_atomic_op): New enum typedef.
(struct gfc_code): Add ext.omp_atomic.
* trans.c (trans_code): Handle EXEC_OMP_TASKYIELD.
* frontend-passes.c (gfc_code_walker): Also walk final_expr.
* resolve.c (gfc_resolve_blocks, resolve_code): Handle
EXEC_OMP_TASKYIELD.
* st.c (gfc_free_statement): Likewise.
* match.h (gfc_match_omp_taskyield): New prototype.
* parse.c (decode_omp_directive): Handle taskyield directive.
Handle !$omp end atomic.
(case_executable): Add ST_OMP_TASKYIELD case.
(gfc_ascii_statement): Handle ST_OMP_TASKYIELD.
(parse_omp_atomic): Return gfc_statement instead of void.
For !$omp atomic capture parse two assignments instead of
just one and require !$omp end atomic afterwards, for
other !$omp atomic forms just allow !$omp end atomic at the
end.
(parse_omp_structured_block, parse_executable): Adjust
parse_omp_atomic callers.
2011-08-02 Tobias Burnus <burnus@net-b.de>
* intrinsic.c (OMP_LIB): Updated openmp_version's
value to 201107.
* gfortran.texi (OpenMP): Update ref to OpenMP 3.1.
* intrinsic.texi (OpenMP Modules): Update ref to OpenMP 3.1;
remove deleted omp_integer_kind and omp_logical_kind constants.
2011-07-31 Janus Weil <janus@gcc.gnu.org>
PR fortran/49112

View File

@ -1,4 +1,4 @@
/* Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
/* Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
This file is part of GCC.
@ -166,7 +166,7 @@ cpp_define_builtins (cpp_reader *pfile)
cpp_define (pfile, "_LANGUAGE_FORTRAN=1");
if (gfc_option.gfc_flag_openmp)
cpp_define (pfile, "_OPENMP=200805");
cpp_define (pfile, "_OPENMP=201107");
/* The defines below are necessary for the TARGET_* macros.

View File

@ -1039,6 +1039,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_SINGLE: name = "SINGLE"; break;
case EXEC_OMP_TASK: name = "TASK"; break;
case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break;
case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break;
case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
default:
gcc_unreachable ();
@ -1071,6 +1072,7 @@ show_omp_node (int level, gfc_code *c)
return;
case EXEC_OMP_BARRIER:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
return;
default:
break;
@ -1085,6 +1087,12 @@ show_omp_node (int level, gfc_code *c)
show_expr (omp_clauses->if_expr);
fputc (')', dumpfile);
}
if (omp_clauses->final_expr)
{
fputs (" FINAL(", dumpfile);
show_expr (omp_clauses->final_expr);
fputc (')', dumpfile);
}
if (omp_clauses->num_threads)
{
fputs (" NUM_THREADS(", dumpfile);
@ -1130,6 +1138,8 @@ show_omp_node (int level, gfc_code *c)
fputs (" ORDERED", dumpfile);
if (omp_clauses->untied)
fputs (" UNTIED", dumpfile);
if (omp_clauses->mergeable)
fputs (" MERGEABLE", dumpfile);
if (omp_clauses->collapse)
fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
@ -2167,6 +2177,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_SINGLE:
case EXEC_OMP_TASK:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
case EXEC_OMP_WORKSHARE:
show_omp_node (level, c);
break;

View File

@ -1235,6 +1235,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
if (co->ext.omp_clauses)
{
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);
}

View File

@ -199,16 +199,16 @@ typedef enum
ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL,
ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL,
ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
ST_OMP_END_PARALLEL_WORKSHARE, ST_OMP_END_SECTIONS, ST_OMP_END_SINGLE,
ST_OMP_END_WORKSHARE, ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED,
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_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_PROCEDURE, ST_GENERIC, ST_CRITICAL,
ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_NONE
}
gfc_statement;
@ -1050,13 +1050,14 @@ enum gfc_omp_default_sharing
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];
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;
bool nowait, ordered, untied, mergeable;
}
gfc_omp_clauses;
@ -2064,10 +2065,20 @@ typedef enum
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
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_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT,
EXEC_OMP_TASKYIELD
}
gfc_exec_op;
typedef enum
{
GFC_OMP_ATOMIC_UPDATE,
GFC_OMP_ATOMIC_READ,
GFC_OMP_ATOMIC_WRITE,
GFC_OMP_ATOMIC_CAPTURE
}
gfc_omp_atomic_op;
typedef struct gfc_code
{
gfc_exec_op op;
@ -2118,6 +2129,7 @@ typedef struct gfc_code
const char *omp_name;
gfc_namelist *omp_namelist;
bool omp_bool;
gfc_omp_atomic_op omp_atomic;
}
ext; /* Points to additional structures required by statement */

View File

@ -530,7 +530,7 @@ support is reported in the @ref{Fortran 2003 status} and
@ref{Fortran 2008 status} sections of the documentation.
Additionally, the GNU Fortran compilers supports the OpenMP specification
(version 3.0, @url{http://openmp.org/@/wp/@/openmp-specifications/}).
(version 3.1, @url{http://openmp.org/@/wp/@/openmp-specifications/}).
@node Varying Length Character Strings
@subsection Varying Length Character Strings
@ -1762,8 +1762,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/spec30.pdf,
OpenMP Application Program Interface v3.0}.
@uref{http://www.openmp.org/mp-documents/spec31.pdf,
OpenMP Application Program Interface v3.1}.
To enable the processing of the OpenMP directive @code{!$omp} in
free-form source code; the @code{c$omp}, @code{*$omp} and @code{!$omp}

View File

@ -13072,7 +13072,7 @@ Both are equivalent to the value @code{NULL} in C.
@section OpenMP Modules @code{OMP_LIB} and @code{OMP_LIB_KINDS}
@table @asis
@item @emph{Standard}:
OpenMP Application Program Interface v3.0
OpenMP Application Program Interface v3.1
@end table
@ -13085,15 +13085,13 @@ the named constants defined in the modules are listed
below.
For details refer to the actual
@uref{http://www.openmp.org/mp-documents/spec30.pdf,
OpenMP Application Program Interface v3.0}.
@uref{http://www.openmp.org/mp-documents/spec31.pdf,
OpenMP Application Program Interface v3.1}.
@code{OMP_LIB_KINDS} provides the following scalar default-integer
named constants:
@table @asis
@item @code{omp_integer_kind}
@item @code{omp_logical_kind}
@item @code{omp_lock_kind}
@item @code{omp_nest_lock_kind}
@item @code{omp_sched_kind}
@ -13102,7 +13100,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.0 the value is @code{200805}.
of the OpenMP version; for OpenMP v3.1 the value is @code{201107}.
And the following scalar integer named constants of the
kind @code{omp_sched_kind}:

View File

@ -138,6 +138,7 @@ match gfc_match_omp_sections (void);
match gfc_match_omp_single (void);
match gfc_match_omp_task (void);
match gfc_match_omp_taskwait (void);
match gfc_match_omp_taskyield (void);
match gfc_match_omp_threadprivate (void);
match gfc_match_omp_workshare (void);
match gfc_match_omp_end_nowait (void);

View File

@ -1,5 +1,5 @@
/* OpenMP directive matching and resolving.
Copyright (C) 2005, 2006, 2007, 2008, 2010
Copyright (C) 2005, 2006, 2007, 2008, 2010, 2011
Free Software Foundation, Inc.
Contributed by Jakub Jelinek
@ -66,6 +66,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
return;
gfc_free_expr (c->if_expr);
gfc_free_expr (c->final_expr);
gfc_free_expr (c->num_threads);
gfc_free_expr (c->chunk_size);
for (i = 0; i < OMP_LIST_NUM; i++)
@ -182,6 +183,8 @@ cleanup:
#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)
/* Match OpenMP directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
@ -205,6 +208,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL
&& gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_FINAL) && c->final_expr == NULL
&& gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_NUM_THREADS) && c->num_threads == NULL
&& gfc_match ("num_threads ( %e )", &c->num_threads) == MATCH_YES)
continue;
@ -383,6 +389,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
c->untied = needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_MERGEABLE) && !c->mergeable
&& gfc_match ("mergeable") == MATCH_YES)
{
c->mergeable = needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_COLLAPSE) && !c->collapse)
{
gfc_expr *cexpr = NULL;
@ -435,7 +447,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
#define OMP_TASK_CLAUSES \
(OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
| OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED)
| OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
| OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE)
match
gfc_match_omp_parallel (void)
@ -475,6 +488,20 @@ gfc_match_omp_taskwait (void)
}
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_critical (void)
{
@ -700,13 +727,22 @@ gfc_match_omp_ordered (void)
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;
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;
new_st.ext.omp_clauses = NULL;
new_st.ext.omp_atomic = op;
return MATCH_YES;
}
@ -783,6 +819,14 @@ resolve_omp_clauses (gfc_code *code)
gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
&expr->where);
}
if (omp_clauses->final_expr)
{
gfc_expr *expr = omp_clauses->final_expr;
if (gfc_resolve_expr (expr) == FAILURE
|| expr->ts.type != BT_LOGICAL || expr->rank != 0)
gfc_error ("FINAL clause at %L requires a scalar LOGICAL expression",
&expr->where);
}
if (omp_clauses->num_threads)
{
gfc_expr *expr = omp_clauses->num_threads;
@ -940,15 +984,20 @@ resolve_omp_clauses (gfc_code *code)
n->sym->name, name, &code->loc);
if (list != OMP_LIST_PRIVATE)
{
if (n->sym->attr.pointer)
if (n->sym->attr.pointer
&& list >= OMP_LIST_REDUCTION_FIRST
&& list <= OMP_LIST_REDUCTION_LAST)
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)
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)
if (n->sym->attr.cray_pointer
&& list >= OMP_LIST_REDUCTION_FIRST
&& list <= OMP_LIST_REDUCTION_LAST)
gfc_error ("Cray pointer '%s' in %s clause at %L",
n->sym->name, name, &code->loc);
}
@ -1095,12 +1144,18 @@ is_conversion (gfc_expr *expr, bool widening)
static void
resolve_omp_atomic (gfc_code *code)
{
gfc_code *atomic_code = code;
gfc_symbol *var;
gfc_expr *expr2;
gfc_expr *expr2, *expr2_tmp;
code = code->block->next;
gcc_assert (code->op == EXEC_ASSIGN);
gcc_assert (code->next == NULL);
gcc_assert ((atomic_code->ext.omp_atomic != GFC_OMP_ATOMIC_CAPTURE
&& code->next == NULL)
|| (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE
&& code->next != NULL
&& code->next->op == EXEC_ASSIGN
&& code->next->next == NULL));
if (code->expr1->expr_type != EXPR_VARIABLE
|| code->expr1->symtree == NULL
@ -1118,7 +1173,86 @@ resolve_omp_atomic (gfc_code *code)
var = code->expr1->symtree->n.sym;
expr2 = is_conversion (code->expr2, false);
if (expr2 == NULL)
expr2 = code->expr2;
{
if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_READ
|| atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE)
expr2 = is_conversion (code->expr2, true);
if (expr2 == NULL)
expr2 = code->expr2;
}
switch (atomic_code->ext.omp_atomic)
{
case GFC_OMP_ATOMIC_READ:
if (expr2->expr_type != EXPR_VARIABLE
|| expr2->symtree == NULL
|| expr2->rank != 0
|| (expr2->ts.type != BT_INTEGER
&& expr2->ts.type != BT_REAL
&& expr2->ts.type != BT_COMPLEX
&& expr2->ts.type != BT_LOGICAL))
gfc_error ("!$OMP ATOMIC READ statement must read from a scalar "
"variable of intrinsic type at %L", &expr2->where);
return;
case GFC_OMP_ATOMIC_WRITE:
if (expr2->rank != 0 || expr_references_sym (code->expr2, var, NULL))
gfc_error ("expr in !$OMP ATOMIC WRITE assignment var = expr "
"must be scalar and cannot reference var at %L",
&expr2->where);
return;
case GFC_OMP_ATOMIC_CAPTURE:
expr2_tmp = expr2;
if (expr2 == code->expr2)
{
expr2_tmp = is_conversion (code->expr2, true);
if (expr2_tmp == NULL)
expr2_tmp = expr2;
}
if (expr2_tmp->expr_type == EXPR_VARIABLE)
{
if (expr2_tmp->symtree == NULL
|| expr2_tmp->rank != 0
|| (expr2_tmp->ts.type != BT_INTEGER
&& expr2_tmp->ts.type != BT_REAL
&& expr2_tmp->ts.type != BT_COMPLEX
&& expr2_tmp->ts.type != BT_LOGICAL)
|| expr2_tmp->symtree->n.sym == var)
{
gfc_error ("!$OMP ATOMIC CAPTURE capture statement must read from "
"a scalar variable of intrinsic type at %L",
&expr2_tmp->where);
return;
}
var = expr2_tmp->symtree->n.sym;
code = code->next;
if (code->expr1->expr_type != EXPR_VARIABLE
|| code->expr1->symtree == NULL
|| code->expr1->rank != 0
|| (code->expr1->ts.type != BT_INTEGER
&& code->expr1->ts.type != BT_REAL
&& code->expr1->ts.type != BT_COMPLEX
&& code->expr1->ts.type != BT_LOGICAL))
{
gfc_error ("!$OMP ATOMIC CAPTURE update statement must set "
"a scalar variable of intrinsic type at %L",
&code->expr1->where);
return;
}
if (code->expr1->symtree->n.sym != var)
{
gfc_error ("!$OMP ATOMIC CAPTURE capture statement reads from "
"different variable than update statement writes "
"into at %L", &code->expr1->where);
return;
}
expr2 = is_conversion (code->expr2, false);
if (expr2 == NULL)
expr2 = code->expr2;
}
break;
default:
break;
}
if (expr2->expr_type == EXPR_OP)
{
@ -1320,6 +1454,53 @@ 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);
if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE && code->next)
{
code = code->next;
if (code->expr1->expr_type != EXPR_VARIABLE
|| code->expr1->symtree == NULL
|| code->expr1->rank != 0
|| (code->expr1->ts.type != BT_INTEGER
&& code->expr1->ts.type != BT_REAL
&& code->expr1->ts.type != BT_COMPLEX
&& code->expr1->ts.type != BT_LOGICAL))
{
gfc_error ("!$OMP ATOMIC CAPTURE capture statement must set "
"a scalar variable of intrinsic type at %L",
&code->expr1->where);
return;
}
expr2 = is_conversion (code->expr2, false);
if (expr2 == NULL)
{
expr2 = is_conversion (code->expr2, true);
if (expr2 == NULL)
expr2 = code->expr2;
}
if (expr2->expr_type != EXPR_VARIABLE
|| expr2->symtree == NULL
|| expr2->rank != 0
|| (expr2->ts.type != BT_INTEGER
&& expr2->ts.type != BT_REAL
&& expr2->ts.type != BT_COMPLEX
&& expr2->ts.type != BT_LOGICAL))
{
gfc_error ("!$OMP ATOMIC CAPTURE capture statement must read "
"from a scalar variable of intrinsic type at %L",
&expr2->where);
return;
}
if (expr2->symtree->n.sym != var)
{
gfc_error ("!$OMP ATOMIC CAPTURE capture statement reads from "
"different variable than update statement writes "
"into at %L", &expr2->where);
return;
}
}
}

View File

@ -526,6 +526,7 @@ decode_omp_directive (void)
match ("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);
@ -567,6 +568,7 @@ decode_omp_directive (void)
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);
case 'w':
@ -957,9 +959,9 @@ next_statement (void)
case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \
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_ERROR_STOP: \
case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: \
case ST_LOCK: case ST_UNLOCK
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
/* Statements that mark other executable statements. */
@ -1470,6 +1472,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_DO:
p = "!$OMP DO";
break;
case ST_OMP_END_ATOMIC:
p = "!$OMP END ATOMIC";
break;
case ST_OMP_END_CRITICAL:
p = "!$OMP END CRITICAL";
break;
@ -1542,6 +1547,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_TASKWAIT:
p = "!$OMP TASKWAIT";
break;
case ST_OMP_TASKYIELD:
p = "!$OMP TASKYIELD";
break;
case ST_OMP_THREADPRIVATE:
p = "!$OMP THREADPRIVATE";
break;
@ -3420,12 +3428,13 @@ parse_omp_do (gfc_statement omp_st)
/* Parse the statements of OpenMP atomic directive. */
static void
static gfc_statement
parse_omp_atomic (void)
{
gfc_statement st;
gfc_code *cp, *np;
gfc_state_data s;
int count;
accept_statement (ST_OMP_ATOMIC);
@ -3434,21 +3443,35 @@ 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);
for (;;)
while (count)
{
st = next_statement ();
if (st == ST_NONE)
unexpected_eof ();
else if (st == ST_ASSIGNMENT)
break;
{
accept_statement (st);
count--;
}
else
unexpected_statement (st);
}
accept_statement (st);
pop_state ();
st = next_statement ();
if (st == ST_OMP_END_ATOMIC)
{
gfc_clear_new_st ();
gfc_commit_symbols ();
gfc_warning_check ();
st = next_statement ();
}
else if (cp->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE)
gfc_error ("Missing !$OMP END ATOMIC after !$OMP ATOMIC CAPTURE at %C");
return st;
}
@ -3558,8 +3581,8 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
continue;
case ST_OMP_ATOMIC:
parse_omp_atomic ();
break;
st = parse_omp_atomic ();
continue;
default:
cycle = false;
@ -3739,8 +3762,8 @@ parse_executable (gfc_statement st)
continue;
case ST_OMP_ATOMIC:
parse_omp_atomic ();
break;
st = parse_omp_atomic ();
continue;
default:
return st;

View File

@ -8824,6 +8824,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_OMP_SINGLE:
case EXEC_OMP_TASK:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
case EXEC_OMP_WORKSHARE:
break;
@ -9390,6 +9391,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
case EXEC_OMP_WORKSHARE:
gfc_resolve_omp_directive (code, ns);
break;

View File

@ -208,6 +208,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_ORDERED:
case EXEC_OMP_END_NOWAIT:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
break;
default:

View File

@ -88,9 +88,7 @@ gfc_omp_predetermined_sharing (tree decl)
if (GFC_DECL_CRAY_POINTEE (decl))
return OMP_CLAUSE_DEFAULT_PRIVATE;
/* Assumed-size arrays are predetermined to inherit sharing
attributes of the associated actual argument, which is shared
for all we care. */
/* Assumed-size arrays are predetermined shared. */
if (TREE_CODE (decl) == PARM_DECL
&& GFC_ARRAY_TYPE_P (TREE_TYPE (decl))
&& GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_UNKNOWN
@ -215,7 +213,8 @@ tree
gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
{
tree type = TREE_TYPE (dest), ptr, size, esize, rank, call;
stmtblock_t block;
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)
@ -227,7 +226,9 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
and copied from SRC. */
gfc_start_block (&block);
gfc_add_modify (&block, dest, 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,
@ -241,18 +242,30 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
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);
size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block);
ptr = gfc_create_var (pvoid_type_node, NULL);
gfc_allocate_using_malloc (&block, ptr, size, NULL_TREE);
gfc_conv_descriptor_data_set (&block, dest, ptr);
gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE);
gfc_conv_descriptor_data_set (&cond_block, dest, ptr);
call = build_call_expr_loc (input_location,
built_in_decls[BUILT_IN_MEMCPY], 3, ptr,
fold_convert (pvoid_type_node,
gfc_conv_descriptor_data_get (src)),
size);
gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
then_b = gfc_finish_block (&cond_block);
gfc_init_block (&cond_block);
gfc_conv_descriptor_data_set (&cond_block, dest, 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 (src)),
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);
}
@ -855,6 +868,21 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->final_expr)
{
tree final_var;
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, clauses->final_expr);
gfc_add_block_to_block (block, &se.pre);
final_var = gfc_evaluate_now (se.expr, block);
gfc_add_block_to_block (block, &se.post);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_FINAL);
OMP_CLAUSE_FINAL_EXPR (c) = final_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->num_threads)
{
tree num_threads;
@ -948,6 +976,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->mergeable)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_MERGEABLE);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->collapse)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_COLLAPSE);
@ -990,35 +1024,85 @@ static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
static tree
gfc_trans_omp_atomic (gfc_code *code)
{
gfc_code *atomic_code = code;
gfc_se lse;
gfc_se rse;
gfc_se vse;
gfc_expr *expr2, *e;
gfc_symbol *var;
stmtblock_t block;
tree lhsaddr, type, rhs, x;
enum tree_code op = ERROR_MARK;
enum tree_code aop = OMP_ATOMIC;
bool var_on_left = false;
code = code->block->next;
gcc_assert (code->op == EXEC_ASSIGN);
gcc_assert (code->next == NULL);
var = code->expr1->symtree->n.sym;
gfc_init_se (&lse, NULL);
gfc_init_se (&rse, NULL);
gfc_init_se (&vse, NULL);
gfc_start_block (&block);
gfc_conv_expr (&lse, code->expr1);
gfc_add_block_to_block (&block, &lse.pre);
type = TREE_TYPE (lse.expr);
lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
expr2 = code->expr2;
if (expr2->expr_type == EXPR_FUNCTION
&& expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
expr2 = expr2->value.function.actual->expr;
if (expr2->expr_type == EXPR_OP)
switch (atomic_code->ext.omp_atomic)
{
case GFC_OMP_ATOMIC_READ:
gfc_conv_expr (&vse, code->expr1);
gfc_add_block_to_block (&block, &vse.pre);
gfc_conv_expr (&lse, expr2);
gfc_add_block_to_block (&block, &lse.pre);
type = TREE_TYPE (lse.expr);
lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
x = build1 (OMP_ATOMIC_READ, type, lhsaddr);
x = convert (TREE_TYPE (vse.expr), x);
gfc_add_modify (&block, vse.expr, x);
gfc_add_block_to_block (&block, &lse.pre);
gfc_add_block_to_block (&block, &rse.pre);
return gfc_finish_block (&block);
case GFC_OMP_ATOMIC_CAPTURE:
aop = OMP_ATOMIC_CAPTURE_NEW;
if (expr2->expr_type == EXPR_VARIABLE)
{
aop = OMP_ATOMIC_CAPTURE_OLD;
gfc_conv_expr (&vse, code->expr1);
gfc_add_block_to_block (&block, &vse.pre);
gfc_conv_expr (&lse, expr2);
gfc_add_block_to_block (&block, &lse.pre);
gfc_init_se (&lse, NULL);
code = code->next;
var = code->expr1->symtree->n.sym;
expr2 = code->expr2;
if (expr2->expr_type == EXPR_FUNCTION
&& expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
expr2 = expr2->value.function.actual->expr;
}
break;
default:
break;
}
gfc_conv_expr (&lse, code->expr1);
gfc_add_block_to_block (&block, &lse.pre);
type = TREE_TYPE (lse.expr);
lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE)
{
gfc_conv_expr (&rse, expr2);
gfc_add_block_to_block (&block, &rse.pre);
}
else if (expr2->expr_type == EXPR_OP)
{
gfc_expr *e;
switch (expr2->value.op.op)
@ -1134,25 +1218,55 @@ gfc_trans_omp_atomic (gfc_code *code)
lhsaddr = save_expr (lhsaddr);
rhs = gfc_evaluate_now (rse.expr, &block);
x = convert (TREE_TYPE (rhs), build_fold_indirect_ref_loc (input_location,
lhsaddr));
if (var_on_left)
x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), x, rhs);
if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE)
x = rhs;
else
x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), rhs, x);
{
x = convert (TREE_TYPE (rhs),
build_fold_indirect_ref_loc (input_location, lhsaddr));
if (var_on_left)
x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), x, rhs);
else
x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), rhs, x);
}
if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
&& TREE_CODE (type) != COMPLEX_TYPE)
x = fold_build1_loc (input_location, REALPART_EXPR,
TREE_TYPE (TREE_TYPE (rhs)), x);
x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
gfc_add_expr_to_block (&block, x);
gfc_add_block_to_block (&block, &lse.pre);
gfc_add_block_to_block (&block, &rse.pre);
if (aop == OMP_ATOMIC)
{
x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
gfc_add_expr_to_block (&block, x);
}
else
{
if (aop == OMP_ATOMIC_CAPTURE_NEW)
{
code = code->next;
expr2 = code->expr2;
if (expr2->expr_type == EXPR_FUNCTION
&& expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
expr2 = expr2->value.function.actual->expr;
gcc_assert (expr2->expr_type == EXPR_VARIABLE);
gfc_conv_expr (&vse, code->expr1);
gfc_add_block_to_block (&block, &vse.pre);
gfc_init_se (&lse, NULL);
gfc_conv_expr (&lse, expr2);
gfc_add_block_to_block (&block, &lse.pre);
}
x = build2 (aop, type, lhsaddr, convert (type, x));
x = convert (TREE_TYPE (vse.expr), x);
gfc_add_modify (&block, vse.expr, x);
}
return gfc_finish_block (&block);
}
@ -1628,6 +1742,13 @@ gfc_trans_omp_taskwait (void)
return build_call_expr_loc (input_location, decl, 0);
}
static tree
gfc_trans_omp_taskyield (void)
{
tree decl = built_in_decls [BUILT_IN_GOMP_TASKYIELD];
return build_call_expr_loc (input_location, decl, 0);
}
static tree
gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
{
@ -1821,6 +1942,8 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_task (code);
case EXEC_OMP_TASKWAIT:
return gfc_trans_omp_taskwait ();
case EXEC_OMP_TASKYIELD:
return gfc_trans_omp_taskyield ();
case EXEC_OMP_WORKSHARE:
return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
default:

View File

@ -1410,6 +1410,7 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_SINGLE:
case EXEC_OMP_TASK:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
case EXEC_OMP_WORKSHARE:
res = gfc_trans_omp_directive (code);
break;

View File

@ -114,6 +114,7 @@ enum gf_mask {
GF_OMP_RETURN_NOWAIT = 1 << 0,
GF_OMP_SECTION_LAST = 1 << 0,
GF_OMP_ATOMIC_NEED_VALUE = 1 << 0,
GF_PREDICT_TAKEN = 1 << 15
};
@ -1634,6 +1635,29 @@ gimple_omp_parallel_set_combined_p (gimple g, bool combined_p)
}
/* Return true if OMP atomic load/store statement G has the
GF_OMP_ATOMIC_NEED_VALUE flag set. */
static inline bool
gimple_omp_atomic_need_value_p (const_gimple g)
{
if (gimple_code (g) != GIMPLE_OMP_ATOMIC_LOAD)
GIMPLE_CHECK (g, GIMPLE_OMP_ATOMIC_STORE);
return (gimple_omp_subcode (g) & GF_OMP_ATOMIC_NEED_VALUE) != 0;
}
/* Set the GF_OMP_ATOMIC_NEED_VALUE flag on G. */
static inline void
gimple_omp_atomic_set_need_value (gimple g)
{
if (gimple_code (g) != GIMPLE_OMP_ATOMIC_LOAD)
GIMPLE_CHECK (g, GIMPLE_OMP_ATOMIC_STORE);
g->gsbase.subcode |= GF_OMP_ATOMIC_NEED_VALUE;
}
/* Return the number of operands for statement GS. */
static inline unsigned

View File

@ -5932,6 +5932,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
}
break;
case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_IF:
OMP_CLAUSE_OPERAND (c, 0)
= gimple_boolify (OMP_CLAUSE_OPERAND (c, 0));
@ -5948,6 +5949,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
case OMP_CLAUSE_ORDERED:
case OMP_CLAUSE_UNTIED:
case OMP_CLAUSE_COLLAPSE:
case OMP_CLAUSE_MERGEABLE:
break;
case OMP_CLAUSE_DEFAULT:
@ -6088,6 +6090,8 @@ gimplify_adjust_omp_clauses (tree *list_p)
case OMP_CLAUSE_DEFAULT:
case OMP_CLAUSE_UNTIED:
case OMP_CLAUSE_COLLAPSE:
case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_MERGEABLE:
break;
default:
@ -6490,24 +6494,45 @@ static enum gimplify_status
gimplify_omp_atomic (tree *expr_p, gimple_seq *pre_p)
{
tree addr = TREE_OPERAND (*expr_p, 0);
tree rhs = TREE_OPERAND (*expr_p, 1);
tree rhs = TREE_CODE (*expr_p) == OMP_ATOMIC_READ
? NULL : TREE_OPERAND (*expr_p, 1);
tree type = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (addr)));
tree tmp_load;
gimple loadstmt, storestmt;
tmp_load = create_tmp_reg (type, NULL);
if (goa_stabilize_expr (&rhs, pre_p, addr, tmp_load) < 0)
return GS_ERROR;
tmp_load = create_tmp_reg (type, NULL);
if (rhs && goa_stabilize_expr (&rhs, pre_p, addr, tmp_load) < 0)
return GS_ERROR;
if (gimplify_expr (&addr, pre_p, NULL, is_gimple_val, fb_rvalue)
!= GS_ALL_DONE)
return GS_ERROR;
if (gimplify_expr (&addr, pre_p, NULL, is_gimple_val, fb_rvalue)
!= GS_ALL_DONE)
return GS_ERROR;
gimplify_seq_add_stmt (pre_p, gimple_build_omp_atomic_load (tmp_load, addr));
if (gimplify_expr (&rhs, pre_p, NULL, is_gimple_val, fb_rvalue)
!= GS_ALL_DONE)
return GS_ERROR;
gimplify_seq_add_stmt (pre_p, gimple_build_omp_atomic_store (rhs));
*expr_p = NULL;
loadstmt = gimple_build_omp_atomic_load (tmp_load, addr);
gimplify_seq_add_stmt (pre_p, loadstmt);
if (rhs && gimplify_expr (&rhs, pre_p, NULL, is_gimple_val, fb_rvalue)
!= GS_ALL_DONE)
return GS_ERROR;
if (TREE_CODE (*expr_p) == OMP_ATOMIC_READ)
rhs = tmp_load;
storestmt = gimple_build_omp_atomic_store (rhs);
gimplify_seq_add_stmt (pre_p, storestmt);
switch (TREE_CODE (*expr_p))
{
case OMP_ATOMIC_READ:
case OMP_ATOMIC_CAPTURE_OLD:
*expr_p = tmp_load;
gimple_omp_atomic_set_need_value (loadstmt);
break;
case OMP_ATOMIC_CAPTURE_NEW:
*expr_p = rhs;
gimple_omp_atomic_set_need_value (storestmt);
break;
default:
*expr_p = NULL;
break;
}
return GS_ALL_DONE;
}
@ -7230,6 +7255,9 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
}
case OMP_ATOMIC:
case OMP_ATOMIC_READ:
case OMP_ATOMIC_CAPTURE_OLD:
case OMP_ATOMIC_CAPTURE_NEW:
ret = gimplify_omp_atomic (expr_p, pre_p);
break;

View File

@ -37,6 +37,8 @@ DEF_GOMP_BUILTIN (BUILT_IN_GOMP_BARRIER, "GOMP_barrier",
BT_FN_VOID, ATTR_NOTHROW_LEAF_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_GOMP_TASKWAIT, "GOMP_taskwait",
BT_FN_VOID, ATTR_NOTHROW_LEAF_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_GOMP_TASKYIELD, "GOMP_taskyield",
BT_FN_VOID, ATTR_NOTHROW_LEAF_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_GOMP_CRITICAL_START, "GOMP_critical_start",
BT_FN_VOID, ATTR_NOTHROW_LEAF_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_GOMP_CRITICAL_END, "GOMP_critical_end",

View File

@ -1443,6 +1443,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
ctx->default_kind = OMP_CLAUSE_DEFAULT_KIND (c);
break;
case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_IF:
case OMP_CLAUSE_NUM_THREADS:
case OMP_CLAUSE_SCHEDULE:
@ -1454,6 +1455,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_ORDERED:
case OMP_CLAUSE_COLLAPSE:
case OMP_CLAUSE_UNTIED:
case OMP_CLAUSE_MERGEABLE:
break;
default:
@ -1504,6 +1506,8 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_ORDERED:
case OMP_CLAUSE_COLLAPSE:
case OMP_CLAUSE_UNTIED:
case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_MERGEABLE:
break;
default:
@ -3081,7 +3085,7 @@ expand_parallel_call (struct omp_region *region, basic_block bb,
static void
expand_task_call (basic_block bb, gimple entry_stmt)
{
tree t, t1, t2, t3, flags, cond, c, clauses;
tree t, t1, t2, t3, flags, cond, c, c2, clauses;
gimple_stmt_iterator gsi;
location_t loc = gimple_location (entry_stmt);
@ -3094,7 +3098,19 @@ expand_task_call (basic_block bb, gimple entry_stmt)
cond = boolean_true_node;
c = find_omp_clause (clauses, OMP_CLAUSE_UNTIED);
flags = build_int_cst (unsigned_type_node, (c ? 1 : 0));
c2 = find_omp_clause (clauses, OMP_CLAUSE_MERGEABLE);
flags = build_int_cst (unsigned_type_node,
(c ? 1 : 0) + (c2 ? 4 : 0));
c = find_omp_clause (clauses, OMP_CLAUSE_FINAL);
if (c)
{
c = gimple_boolify (OMP_CLAUSE_FINAL_EXPR (c));
c = fold_build3_loc (loc, COND_EXPR, unsigned_type_node, c,
build_int_cst (unsigned_type_node, 2),
build_int_cst (unsigned_type_node, 0));
flags = fold_build2_loc (loc, PLUS_EXPR, unsigned_type_node, flags, c);
}
gsi = gsi_last_bb (bb);
t = gimple_omp_task_data_arg (entry_stmt);
@ -4944,6 +4960,31 @@ expand_omp_synch (struct omp_region *region)
}
}
/* A subroutine of expand_omp_atomic. Attempt to implement the atomic
operation as a normal volatile load. */
static bool
expand_omp_atomic_load (basic_block load_bb, tree addr, tree loaded_val)
{
/* FIXME */
(void) load_bb;
(void) addr;
(void) loaded_val;
return false;
}
/* A subroutine of expand_omp_atomic. Attempt to implement the atomic
operation as a normal volatile store. */
static bool
expand_omp_atomic_store (basic_block load_bb, tree addr)
{
/* FIXME */
(void) load_bb;
(void) addr;
return false;
}
/* A subroutine of expand_omp_atomic. Attempt to implement the atomic
operation as a __sync_fetch_and_op builtin. INDEX is log2 of the
size of the data type, and thus usable to find the index of the builtin
@ -4954,14 +4995,15 @@ expand_omp_atomic_fetch_op (basic_block load_bb,
tree addr, tree loaded_val,
tree stored_val, int index)
{
enum built_in_function base;
enum built_in_function oldbase, newbase;
tree decl, itype, call;
direct_optab optab;
tree rhs;
direct_optab optab, oldoptab, newoptab;
tree lhs, rhs;
basic_block store_bb = single_succ (load_bb);
gimple_stmt_iterator gsi;
gimple stmt;
location_t loc;
bool need_old, need_new;
/* We expect to find the following sequences:
@ -4985,6 +5027,9 @@ expand_omp_atomic_fetch_op (basic_block load_bb,
gsi_next (&gsi);
if (gimple_code (gsi_stmt (gsi)) != GIMPLE_OMP_ATOMIC_STORE)
return false;
need_new = gimple_omp_atomic_need_value_p (gsi_stmt (gsi));
need_old = gimple_omp_atomic_need_value_p (last_stmt (load_bb));
gcc_checking_assert (!need_old || !need_new);
if (!operand_equal_p (gimple_assign_lhs (stmt), stored_val, 0))
return false;
@ -4994,24 +5039,39 @@ expand_omp_atomic_fetch_op (basic_block load_bb,
{
case PLUS_EXPR:
case POINTER_PLUS_EXPR:
base = BUILT_IN_SYNC_FETCH_AND_ADD_N;
oldbase = BUILT_IN_SYNC_FETCH_AND_ADD_N;
newbase = BUILT_IN_SYNC_ADD_AND_FETCH_N;
optab = sync_add_optab;
oldoptab = sync_old_add_optab;
newoptab = sync_new_add_optab;
break;
case MINUS_EXPR:
base = BUILT_IN_SYNC_FETCH_AND_SUB_N;
oldbase = BUILT_IN_SYNC_FETCH_AND_SUB_N;
newbase = BUILT_IN_SYNC_SUB_AND_FETCH_N;
optab = sync_add_optab;
oldoptab = sync_old_add_optab;
newoptab = sync_new_add_optab;
break;
case BIT_AND_EXPR:
base = BUILT_IN_SYNC_FETCH_AND_AND_N;
oldbase = BUILT_IN_SYNC_FETCH_AND_AND_N;
newbase = BUILT_IN_SYNC_AND_AND_FETCH_N;
optab = sync_and_optab;
oldoptab = sync_old_and_optab;
newoptab = sync_new_and_optab;
break;
case BIT_IOR_EXPR:
base = BUILT_IN_SYNC_FETCH_AND_OR_N;
oldbase = BUILT_IN_SYNC_FETCH_AND_OR_N;
newbase = BUILT_IN_SYNC_OR_AND_FETCH_N;
optab = sync_ior_optab;
oldoptab = sync_old_ior_optab;
newoptab = sync_new_ior_optab;
break;
case BIT_XOR_EXPR:
base = BUILT_IN_SYNC_FETCH_AND_XOR_N;
oldbase = BUILT_IN_SYNC_FETCH_AND_XOR_N;
newbase = BUILT_IN_SYNC_XOR_AND_FETCH_N;
optab = sync_xor_optab;
oldoptab = sync_old_xor_optab;
newoptab = sync_new_xor_optab;
break;
default:
return false;
@ -5025,20 +5085,49 @@ expand_omp_atomic_fetch_op (basic_block load_bb,
else
return false;
decl = built_in_decls[base + index + 1];
decl = built_in_decls[(need_new ? newbase : oldbase) + index + 1];
if (decl == NULL_TREE)
return false;
itype = TREE_TYPE (TREE_TYPE (decl));
if (direct_optab_handler (optab, TYPE_MODE (itype)) == CODE_FOR_nothing)
if (need_new)
{
/* expand_sync_fetch_operation can always compensate when interested
in the new value. */
if (direct_optab_handler (newoptab, TYPE_MODE (itype))
== CODE_FOR_nothing
&& direct_optab_handler (oldoptab, TYPE_MODE (itype))
== CODE_FOR_nothing)
return false;
}
else if (need_old)
{
/* When interested in the old value, expand_sync_fetch_operation
can compensate only if the operation is reversible. AND and OR
are not reversible. */
if (direct_optab_handler (oldoptab, TYPE_MODE (itype))
== CODE_FOR_nothing
&& (oldbase == BUILT_IN_SYNC_FETCH_AND_AND_N
|| oldbase == BUILT_IN_SYNC_FETCH_AND_OR_N
|| direct_optab_handler (newoptab, TYPE_MODE (itype))
== CODE_FOR_nothing))
return false;
}
else if (direct_optab_handler (optab, TYPE_MODE (itype)) == CODE_FOR_nothing)
return false;
gsi = gsi_last_bb (load_bb);
gcc_assert (gimple_code (gsi_stmt (gsi)) == GIMPLE_OMP_ATOMIC_LOAD);
call = build_call_expr_loc (loc,
decl, 2, addr,
fold_convert_loc (loc, itype, rhs));
call = fold_convert_loc (loc, void_type_node, call);
call = build_call_expr_loc (loc, decl, 2, addr,
fold_convert_loc (loc, itype, rhs));
if (need_old || need_new)
{
lhs = need_old ? loaded_val : stored_val;
call = fold_convert_loc (loc, TREE_TYPE (lhs), call);
call = build2_loc (loc, MODIFY_EXPR, void_type_node, lhs, call);
}
else
call = fold_convert_loc (loc, void_type_node, call);
force_gimple_operand_gsi (&gsi, call, true, NULL_TREE, true, GSI_SAME_STMT);
gsi_remove (&gsi, true);
@ -5319,6 +5408,25 @@ expand_omp_atomic (struct omp_region *region)
/* __sync builtins require strict data alignment. */
if (exact_log2 (align) >= index)
{
/* Atomic load. FIXME: have some target hook signalize what loads
are actually atomic? */
if (loaded_val == stored_val
&& (GET_MODE_CLASS (TYPE_MODE (type)) == MODE_INT
|| GET_MODE_CLASS (TYPE_MODE (type)) == MODE_FLOAT)
&& GET_MODE_BITSIZE (TYPE_MODE (type)) <= BITS_PER_WORD
&& expand_omp_atomic_load (load_bb, addr, loaded_val))
return;
/* Atomic store. FIXME: have some target hook signalize what
stores are actually atomic? */
if ((GET_MODE_CLASS (TYPE_MODE (type)) == MODE_INT
|| GET_MODE_CLASS (TYPE_MODE (type)) == MODE_FLOAT)
&& GET_MODE_BITSIZE (TYPE_MODE (type)) <= BITS_PER_WORD
&& store_bb == single_succ (load_bb)
&& first_stmt (store_bb) == store
&& expand_omp_atomic_store (load_bb, addr))
return;
/* When possible, use specialized atomic update functions. */
if ((INTEGRAL_TYPE_P (type) || POINTER_TYPE_P (type))
&& store_bb == single_succ (load_bb))

View File

@ -1,3 +1,16 @@
2011-08-02 Jakub Jelinek <jakub@redhat.com>
PR fortran/46752
* gcc.dg/gomp/atomic-5.c: Adjust expected diagnostics.
* gcc.dg/gomp/atomic-15.c: New test.
* g++.dg/gomp/atomic-5.C: Adjust expected diagnostics.
* g++.dg/gomp/atomic-15.C: New test.
* g++.dg/gomp/private-1.C: New test.
* g++.dg/gomp/sharing-2.C: New test.
* gfortran.dg/gomp/crayptr1.f90: Don't expect error
about Cray pointer in FIRSTPRIVATE/LASTPRIVATE.
* gfortran.dg/gomp/omp_atomic2.f90: New test.
2011-08-02 Tobias Burnus <burnus@net-b.de>
* trim_optimize_5.f90: Remove spurious "use foo".

View File

@ -0,0 +1,46 @@
// { dg-do compile }
// { dg-options "-fopenmp" }
int x = 6;
int
main ()
{
int v;
#pragma omp atomic
x = x * 7 + 6; // { dg-error "expected" }
#pragma omp atomic
x = x * 7 ^ 6; // { dg-error "expected" }
#pragma omp atomic update
x = x - 8 + 6; // { dg-error "expected" }
#pragma omp atomic
x = x ^ 7 | 2; // { dg-error "expected" }
#pragma omp atomic
x = x / 7 * 2; // { dg-error "expected" }
#pragma omp atomic
x = x / 7 / 2; // { dg-error "expected" }
#pragma omp atomic capture
v = x = x | 6; // { dg-error "invalid operator" }
#pragma omp atomic capture
{ v = x; x = x * 7 + 6; } // { dg-error "expected" }
#pragma omp atomic capture
{ v = x; x = x * 7 ^ 6; } // { dg-error "expected" }
#pragma omp atomic capture
{ v = x; x = x - 8 + 6; } // { dg-error "expected" }
#pragma omp atomic capture
{ v = x; x = x ^ 7 | 2; } // { dg-error "expected" }
#pragma omp atomic capture
{ v = x; x = x / 7 * 2; } // { dg-error "expected" }
#pragma omp atomic capture
{ v = x; x = x / 7 / 2; } // { dg-error "expected" }
#pragma omp atomic capture
{ x = x * 7 + 6; v = x; } // { dg-error "expected" }
#pragma omp atomic capture
{ x = x * 7 ^ 6; v = x; } // { dg-error "expected" }
#pragma omp atomic capture
{ x = x - 8 + 6; v = x; } // { dg-error "expected" }
#pragma omp atomic capture
{ x = x ^ 7 | 2; v = x; } // { dg-error "expected" }
(void) v;
return 0;
}

View File

@ -9,9 +9,9 @@ void f1(void)
#pragma omp atomic
x %= 2; /* { dg-error "invalid operator" } */
#pragma omp atomic
x = x + 1; /* { dg-error "invalid operator" } */
x = x + 1;
#pragma omp atomic
x = 1; /* { dg-error "invalid operator" } */
x = 1; /* { dg-error "invalid form" } */
#pragma omp atomic
++y; /* { dg-error "read-only variable" } */
#pragma omp atomic

View File

@ -84,7 +84,7 @@ foo (int x)
;
#pragma omp p private (c) // { dg-error "predetermined 'shared'" }
;
#pragma omp p firstprivate (c) // { dg-error "predetermined 'shared'" }
#pragma omp p firstprivate (c)
;
#pragma omp p for lastprivate (c) // { dg-error "predetermined 'shared'" }
for (i = 0; i < 10; i++)

View File

@ -0,0 +1,33 @@
// { dg-do compile }
// { dg-options "-fopenmp" }
struct A { int i; A (); ~A (); };
struct B { int i; };
struct C { int i; mutable int j; C (); ~C (); };
template <typename T> void bar (const T *);
const A a;
const C c;
const A foo (const A d, const C e)
{
const A f;
const B b = { 4 };
A g;
#pragma omp parallel private (a) // { dg-error "predetermined" }
bar (&a);
#pragma omp parallel private (b) // { dg-error "predetermined" }
bar (&b);
#pragma omp parallel private (c)
bar (&c);
#pragma omp parallel private (d) // { dg-error "predetermined" }
bar (&d);
#pragma omp parallel private (e)
bar (&e);
#pragma omp parallel private (f) // { dg-error "predetermined" }
bar (&f);
#pragma omp parallel private (g)
bar (&g);
return f;
}

View File

@ -0,0 +1,47 @@
// { dg-do compile }
struct T
{
int i;
mutable int j;
};
struct S
{
const static int d = 1;
const static T e;
void foo (int, T);
};
const int S::d;
const T S::e = { 2, 3 };
void bar (const int &);
void
S::foo (const int x, const T y)
{
#pragma omp parallel firstprivate (x)
bar (x);
#pragma omp parallel firstprivate (d)
bar (d);
#pragma omp parallel firstprivate (y)
bar (y.i);
#pragma omp parallel firstprivate (e) // { dg-error "is predetermined" }
bar (e.i);
#pragma omp parallel shared (x) // { dg-error "is predetermined" }
bar (x);
#pragma omp parallel shared (d) // { dg-error "is predetermined" }
bar (d);
#pragma omp parallel shared (e) // { dg-error "is predetermined" }
bar (e.i);
#pragma omp parallel shared (y)
bar (y.i);
#pragma omp parallel private (x) // { dg-error "is predetermined" }
bar (x);
#pragma omp parallel private (d) // { dg-error "is predetermined" }
bar (d);
#pragma omp parallel private (y)
bar (y.i);
#pragma omp parallel private (e) // { dg-error "is predetermined" }
bar (e.i);
}

View File

@ -0,0 +1,46 @@
/* { dg-do compile } */
/* { dg-options "-fopenmp" } */
int x = 6;
int
main ()
{
int v;
#pragma omp atomic
x = x * 7 + 6; /* { dg-error "expected" } */
#pragma omp atomic
x = x * 7 ^ 6; /* { dg-error "expected" } */
#pragma omp atomic update
x = x - 8 + 6; /* { dg-error "expected" } */
#pragma omp atomic
x = x ^ 7 | 2; /* { dg-error "expected" } */
#pragma omp atomic
x = x / 7 * 2; /* { dg-error "expected" } */
#pragma omp atomic
x = x / 7 / 2; /* { dg-error "expected" } */
#pragma omp atomic capture
v = x = x | 6; /* { dg-error "invalid operator" } */
#pragma omp atomic capture
{ v = x; x = x * 7 + 6; } /* { dg-error "expected" } */
#pragma omp atomic capture
{ v = x; x = x * 7 ^ 6; } /* { dg-error "expected" } */
#pragma omp atomic capture
{ v = x; x = x - 8 + 6; } /* { dg-error "expected" } */
#pragma omp atomic capture
{ v = x; x = x ^ 7 | 2; } /* { dg-error "expected" } */
#pragma omp atomic capture
{ v = x; x = x / 7 * 2; } /* { dg-error "expected" } */
#pragma omp atomic capture
{ v = x; x = x / 7 / 2; } /* { dg-error "expected" } */
#pragma omp atomic capture
{ x = x * 7 + 6; v = x; } /* { dg-error "expected" } */
#pragma omp atomic capture
{ x = x * 7 ^ 6; v = x; } /* { dg-error "expected" } */
#pragma omp atomic capture
{ x = x - 8 + 6; v = x; } /* { dg-error "expected" } */
#pragma omp atomic capture
{ x = x ^ 7 | 2; v = x; } /* { dg-error "expected" } */
(void) v;
return 0;
}

View File

@ -11,9 +11,9 @@ void f1(void)
#pragma omp atomic
x %= 2; /* { dg-error "invalid operator" } */
#pragma omp atomic
x = x + 1; /* { dg-error "invalid operator" } */
x = x + 1;
#pragma omp atomic
x = 1; /* { dg-error "invalid operator" } */
x = 1; /* { dg-error "invalid form" } */
#pragma omp atomic
++y; /* { dg-error "read-only variable" } */
#pragma omp atomic

View File

@ -84,7 +84,7 @@ foo (int x)
;
#pragma omp p private (c) /* { dg-error "predetermined 'shared'" } */
;
#pragma omp p firstprivate (c) /* { dg-error "predetermined 'shared'" } */
#pragma omp p firstprivate (c)
;
#pragma omp p for lastprivate (c) /* { dg-error "predetermined 'shared'" } */
for (i = 0; i < 10; i++)

View File

@ -36,10 +36,10 @@
!$omp end parallel
ip3 = loc (i)
!$omp parallel firstprivate (ip3) ! { dg-error "Cray pointer 'ip3' in FIRSTPRIVATE clause" }
!$omp parallel firstprivate (ip3)
!$omp end parallel
!$omp parallel do lastprivate (ip4) ! { dg-error "Cray pointer 'ip4' in LASTPRIVATE clause" }
!$omp parallel do lastprivate (ip4)
do i = 1, 10
if (i .eq. 10) ip4 = loc (i)
end do

View File

@ -0,0 +1,54 @@
real :: r1, r2
complex :: c1, c2
integer :: i1, i2
!$omp atomic write
c1 = 0
!$omp atomic write
r2 = 0
!$omp atomic write
i2 = 0
!$omp atomic read
r1 = c1
!$omp atomic read
c2 = r2
!$omp atomic read
i1 = r2
!$omp atomic read
c2 = i2
!$omp atomic write
c1 = r1
!$omp atomic write
r2 = c2
!$omp atomic write
r2 = i1
!$omp atomic write
i2 = c2
!$omp end atomic
!$omp atomic write
c1 = 1 + 2 + r1
!$omp atomic write
r2 = c2 + 2 + 3
!$omp atomic write
r2 = 3 + 4 + i1
!$omp atomic write
i2 = c2 + 4 + 5
!$omp atomic
c1 = c1 * 2.
!$omp atomic update
r2 = r2 / 4
!$omp end atomic
!$omp atomic update
i2 = i2 + 8
!$omp atomic capture
c1 = c1 * 2.
r1 = c1
!$omp end atomic
!$omp atomic capture
c2 = r2
r2 = r2 / 4
!$omp end atomic
!$omp atomic capture
i2 = i2 + 8
c2 = i2
!$omp end atomic
end

View File

@ -1097,6 +1097,7 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
if (OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (clause) == NULL)
break;
/* FALLTHRU */
case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_IF:
case OMP_CLAUSE_NUM_THREADS:
wi->val_only = true;
@ -1111,6 +1112,7 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
case OMP_CLAUSE_COPYIN:
case OMP_CLAUSE_COLLAPSE:
case OMP_CLAUSE_UNTIED:
case OMP_CLAUSE_MERGEABLE:
break;
default:
@ -1594,6 +1596,7 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
if (OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (clause) == NULL)
break;
/* FALLTHRU */
case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_IF:
case OMP_CLAUSE_NUM_THREADS:
wi->val_only = true;
@ -1608,6 +1611,7 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
case OMP_CLAUSE_COPYIN:
case OMP_CLAUSE_COLLAPSE:
case OMP_CLAUSE_UNTIED:
case OMP_CLAUSE_MERGEABLE:
break;
default:

View File

@ -421,6 +421,17 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags)
pp_character (buffer, ')');
break;
case OMP_CLAUSE_FINAL:
pp_string (buffer, "final(");
dump_generic_node (buffer, OMP_CLAUSE_FINAL_EXPR (clause),
spc, flags, false);
pp_character (buffer, ')');
break;
case OMP_CLAUSE_MERGEABLE:
pp_string (buffer, "mergeable");
break;
default:
/* Should never happen. */
dump_generic_node (buffer, clause, spc, flags, false);
@ -2208,6 +2219,24 @@ dump_generic_node (pretty_printer *buffer, tree node, int spc, int flags,
dump_generic_node (buffer, TREE_OPERAND (node, 1), spc, flags, false);
break;
case OMP_ATOMIC_READ:
pp_string (buffer, "#pragma omp atomic read");
newline_and_indent (buffer, spc + 2);
dump_generic_node (buffer, TREE_OPERAND (node, 0), spc, flags, false);
pp_space (buffer);
break;
case OMP_ATOMIC_CAPTURE_OLD:
case OMP_ATOMIC_CAPTURE_NEW:
pp_string (buffer, "#pragma omp atomic capture");
newline_and_indent (buffer, spc + 2);
dump_generic_node (buffer, TREE_OPERAND (node, 0), spc, flags, false);
pp_space (buffer);
pp_character (buffer, '=');
pp_space (buffer);
dump_generic_node (buffer, TREE_OPERAND (node, 1), spc, flags, false);
break;
case OMP_SINGLE:
pp_string (buffer, "#pragma omp single");
dump_omp_clauses (buffer, OMP_SINGLE_CLAUSES (node), spc, flags);

View File

@ -247,7 +247,9 @@ unsigned const char omp_clause_num_ops[] =
0, /* OMP_CLAUSE_ORDERED */
0, /* OMP_CLAUSE_DEFAULT */
3, /* OMP_CLAUSE_COLLAPSE */
0 /* OMP_CLAUSE_UNTIED */
0, /* OMP_CLAUSE_UNTIED */
1, /* OMP_CLAUSE_FINAL */
0 /* OMP_CLAUSE_MERGEABLE */
};
const char * const omp_clause_code_name[] =
@ -267,7 +269,9 @@ const char * const omp_clause_code_name[] =
"ordered",
"default",
"collapse",
"untied"
"untied",
"final",
"mergeable"
};
@ -10546,6 +10550,7 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
case OMP_CLAUSE_FIRSTPRIVATE:
case OMP_CLAUSE_COPYIN:
case OMP_CLAUSE_COPYPRIVATE:
case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_IF:
case OMP_CLAUSE_NUM_THREADS:
case OMP_CLAUSE_SCHEDULE:
@ -10556,6 +10561,7 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
case OMP_CLAUSE_ORDERED:
case OMP_CLAUSE_DEFAULT:
case OMP_CLAUSE_UNTIED:
case OMP_CLAUSE_MERGEABLE:
WALK_SUBTREE_TAIL (OMP_CLAUSE_CHAIN (*tp));
case OMP_CLAUSE_LASTPRIVATE:

View File

@ -1040,6 +1040,22 @@ DEFTREECODE (OMP_CRITICAL, "omp_critical", tcc_statement, 2)
build_fold_indirect_ref of the address. */
DEFTREECODE (OMP_ATOMIC, "omp_atomic", tcc_statement, 2)
/* OpenMP - #pragma omp atomic read
Operand 0: The address at which the atomic operation is to be performed.
This address should be stabilized with save_expr. */
DEFTREECODE (OMP_ATOMIC_READ, "omp_atomic_read", tcc_statement, 1)
/* OpenMP - #pragma omp atomic capture
Operand 0: The address at which the atomic operation is to be performed.
This address should be stabilized with save_expr.
Operand 1: The expression to evaluate. When the old value of the object
at the address is used in the expression, it should appear as if
build_fold_indirect_ref of the address.
OMP_ATOMIC_CAPTURE_OLD returns the old memory content,
OMP_ATOMIC_CAPTURE_NEW the new value. */
DEFTREECODE (OMP_ATOMIC_CAPTURE_OLD, "omp_atomic_capture_old", tcc_statement, 2)
DEFTREECODE (OMP_ATOMIC_CAPTURE_NEW, "omp_atomic_capture_new", tcc_statement, 2)
/* OpenMP clauses. */
DEFTREECODE (OMP_CLAUSE, "omp_clause", tcc_exceptional, 0)

View File

@ -403,7 +403,13 @@ enum omp_clause_code
OMP_CLAUSE_COLLAPSE,
/* OpenMP clause: untied. */
OMP_CLAUSE_UNTIED
OMP_CLAUSE_UNTIED,
/* OpenMP clause: final (scalar-expression). */
OMP_CLAUSE_FINAL,
/* OpenMP clause: mergeable. */
OMP_CLAUSE_MERGEABLE
};
/* The definition of tree nodes fills the next several pages. */
@ -1879,6 +1885,8 @@ extern void protected_set_expr_location (tree, location_t);
#define OMP_CLAUSE_LASTPRIVATE_GIMPLE_SEQ(NODE) \
(OMP_CLAUSE_CHECK (NODE))->omp_clause.gimple_reduction_init
#define OMP_CLAUSE_FINAL_EXPR(NODE) \
OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_FINAL), 0)
#define OMP_CLAUSE_IF_EXPR(NODE) \
OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_IF), 0)
#define OMP_CLAUSE_NUM_THREADS_EXPR(NODE) \

View File

@ -1,3 +1,74 @@
2011-08-02 Jakub Jelinek <jakub@redhat.com>
PR fortran/42041
PR fortran/46752
* omp.h.in (omp_in_final): New prototype.
* omp_lib.f90.in (omp_in_final): New interface.
(omp_integer_kind, omp_logical_kind): Remove
and replace all its uses in the module with 4.
(openmp_version): Change to 201107.
* omp_lib.h.in (omp_sched_static, omp_sched_dynamic,
omp_sched_guided, omp_sched_auto): Use omp_sched_kind
kind for the parameters.
(omp_in_final): New external.
(openmp_version): Change to 201107.
* task.c (omp_in_final): New function.
(gomp_init_task): Initialize final_task.
(GOMP_task): Remove unused attribute from flags. Handle final
tasks.
(GOMP_taskyield): New function.
(omp_in_final): Return true if if (false) or final (true) task
or descendant of final (true).
* fortran.c (omp_in_final_): New function.
* libgomp.map (OMP_3.1): Export omp_in_final and omp_in_final_.
(GOMP_3.0): Export GOMP_taskyield.
* env.c (gomp_nthreads_var_list, gomp_nthreads_var_list_len): New
variables.
(parse_unsigned_long_list): New function.
(initialize_env): Use it for OMP_NUM_THREADS. Call parse_boolean
with "OMP_PROC_BIND". If OMP_PROC_BIND=true, call gomp_init_affinity
even if parse_affinity returned false.
* config/linux/affinity.c (gomp_init_affinity): Handle
gomp_cpu_affinity_len == 0.
* libgomp_g.h (GOMP_taskyield): New prototype.
* libgomp.h (struct gomp_task): Add final_task field.
(gomp_nthreads_var_list, gomp_nthreads_var_list_len): New externs.
* team.c (gomp_team_start): Override new task's nthreads_var icv
if list form OMP_NUM_THREADS has been used and it has value for
the new nesting level.
* testsuite/libgomp.c/atomic-11.c: New test.
* testsuite/libgomp.c/atomic-12.c: New test.
* testsuite/libgomp.c/atomic-13.c: New test.
* testsuite/libgomp.c/atomic-14.c: New test.
* testsuite/libgomp.c/reduction-6.c: New test.
* testsuite/libgomp.c/task-5.c: New test.
* testsuite/libgomp.c++/atomic-2.C: New test.
* testsuite/libgomp.c++/atomic-3.C: New test.
* testsuite/libgomp.c++/atomic-4.C: New test.
* testsuite/libgomp.c++/atomic-5.C: New test.
* testsuite/libgomp.c++/atomic-6.C: New test.
* testsuite/libgomp.c++/atomic-7.C: New test.
* testsuite/libgomp.c++/atomic-8.C: New test.
* testsuite/libgomp.c++/atomic-9.C: New test.
* testsuite/libgomp.c++/task-8.C: New test.
* testsuite/libgomp.c++/reduction-4.C: New test.
* testsuite/libgomp.fortran/allocatable7.f90: New test.
* testsuite/libgomp.fortran/allocatable8.f90: New test.
* testsuite/libgomp.fortran/crayptr3.f90: New test.
* testsuite/libgomp.fortran/omp_atomic3.f90: New test.
* testsuite/libgomp.fortran/omp_atomic4.f90: New test.
* testsuite/libgomp.fortran/pointer1.f90: New test.
* testsuite/libgomp.fortran/pointer2.f90: New test.
* testsuite/libgomp.fortran/task4.f90: New test.
2011-08-02 Tobias Burnus <burnus@net-b.de>
* libgomp.texi: Update OpenMP spec references to 3.1.
(omp_in_final,OMP_PROC_BIND): New sections.
(OMP_NUM_THREADS): Document that the value can be now a list.
(GOMP_STACKSIZE,GOMP_CPU_AFFINITY): Update @ref.
2011-08-02 H.J. Lu <hongjiu.lu@intel.com>
* config/linux/x86/futex.h: Check __x86_64__ instead of

View File

@ -1,4 +1,5 @@
/* Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
/* Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
Free Software Foundation, Inc.
Contributed by Jakub Jelinek <jakub@redhat.com>.
This file is part of the GNU OpenMP Library (libgomp).
@ -53,17 +54,36 @@ gomp_init_affinity (void)
}
CPU_ZERO (&cpusetnew);
for (widx = idx = 0; idx < gomp_cpu_affinity_len; idx++)
if (gomp_cpu_affinity[idx] < CPU_SETSIZE
&& CPU_ISSET (gomp_cpu_affinity[idx], &cpuset))
{
if (! CPU_ISSET (gomp_cpu_affinity[idx], &cpusetnew))
if (gomp_cpu_affinity_len == 0)
{
unsigned long count = CPU_COUNT (&cpuset);
if (count >= 65536)
count = 65536;
gomp_cpu_affinity = malloc (count * sizeof (unsigned short));
if (gomp_cpu_affinity == NULL)
{
gomp_error ("not enough memory to store CPU affinity list");
return;
}
for (widx = idx = 0; widx < count && idx < 65536; idx++)
if (CPU_ISSET (idx, &cpuset))
{
cpus++;
CPU_SET (gomp_cpu_affinity[idx], &cpusetnew);
gomp_cpu_affinity[widx++] = idx;
}
gomp_cpu_affinity[widx++] = gomp_cpu_affinity[idx];
}
}
else
for (widx = idx = 0; idx < gomp_cpu_affinity_len; idx++)
if (gomp_cpu_affinity[idx] < CPU_SETSIZE
&& CPU_ISSET (gomp_cpu_affinity[idx], &cpuset))
{
if (! CPU_ISSET (gomp_cpu_affinity[idx], &cpusetnew))
{
cpus++;
CPU_SET (gomp_cpu_affinity[idx], &cpusetnew);
}
gomp_cpu_affinity[widx++] = gomp_cpu_affinity[idx];
}
if (widx == 0)
{

View File

@ -67,6 +67,7 @@ gomp_mutex_t gomp_remaining_threads_lock;
#endif
unsigned long gomp_available_cpus = 1, gomp_managed_threads = 1;
unsigned long long gomp_spin_count_var, gomp_throttled_spin_count_var;
unsigned long *gomp_nthreads_var_list, gomp_nthreads_var_list_len;
/* Parse the OMP_SCHEDULE environment variable. */
@ -184,6 +185,95 @@ parse_unsigned_long (const char *name, unsigned long *pvalue, bool allow_zero)
return false;
}
/* Parse an unsigned long list environment variable. Return true if one was
present and it was successfully parsed. */
static bool
parse_unsigned_long_list (const char *name, unsigned long *p1stvalue,
unsigned long **pvalues,
unsigned long *pnvalues)
{
char *env, *end;
unsigned long value, *values = NULL;
env = getenv (name);
if (env == NULL)
return false;
while (isspace ((unsigned char) *env))
++env;
if (*env == '\0')
goto invalid;
errno = 0;
value = strtoul (env, &end, 10);
if (errno || (long) value <= 0)
goto invalid;
while (isspace ((unsigned char) *end))
++end;
if (*end != '\0')
{
if (*end == ',')
{
unsigned long nvalues = 0, nalloced = 0;
do
{
env = end + 1;
if (nvalues == nalloced)
{
unsigned long *n;
nalloced = nalloced ? nalloced * 2 : 16;
n = realloc (values, nalloced * sizeof (unsigned long));
if (n == NULL)
{
free (values);
gomp_error ("Out of memory while trying to parse"
" environment variable %s", name);
return false;
}
values = n;
if (nvalues == 0)
values[nvalues++] = value;
}
while (isspace ((unsigned char) *env))
++env;
if (*env == '\0')
goto invalid;
errno = 0;
value = strtoul (env, &end, 10);
if (errno || (long) value <= 0)
goto invalid;
values[nvalues++] = value;
while (isspace ((unsigned char) *end))
++end;
if (*end == '\0')
break;
if (*end != ',')
goto invalid;
}
while (1);
*p1stvalue = values[0];
*pvalues = values;
*pnvalues = nvalues;
return true;
}
goto invalid;
}
*p1stvalue = value;
return true;
invalid:
free (values);
gomp_error ("Invalid value for environment variable %s", name);
return false;
}
/* Parse the OMP_STACKSIZE environment varible. Return true if one was
present and it was successfully parsed. */
@ -481,6 +571,7 @@ initialize_env (void)
{
unsigned long stacksize;
int wait_policy;
bool bind_var = false;
/* Do a compile time check that mkomp_h.pl did good job. */
omp_check_defines ();
@ -488,6 +579,7 @@ initialize_env (void)
parse_schedule ();
parse_boolean ("OMP_DYNAMIC", &gomp_global_icv.dyn_var);
parse_boolean ("OMP_NESTED", &gomp_global_icv.nest_var);
parse_boolean ("OMP_PROC_BIND", &bind_var);
parse_unsigned_long ("OMP_MAX_ACTIVE_LEVELS", &gomp_max_active_levels_var,
true);
parse_unsigned_long ("OMP_THREAD_LIMIT", &gomp_thread_limit_var, false);
@ -498,10 +590,12 @@ initialize_env (void)
#endif
gomp_init_num_threads ();
gomp_available_cpus = gomp_global_icv.nthreads_var;
if (!parse_unsigned_long ("OMP_NUM_THREADS", &gomp_global_icv.nthreads_var,
false))
if (!parse_unsigned_long_list ("OMP_NUM_THREADS",
&gomp_global_icv.nthreads_var,
&gomp_nthreads_var_list,
&gomp_nthreads_var_list_len))
gomp_global_icv.nthreads_var = gomp_available_cpus;
if (parse_affinity ())
if (parse_affinity () || bind_var)
gomp_init_affinity ();
wait_policy = parse_wait_policy ();
if (!parse_spincount ("GOMP_SPINCOUNT", &gomp_spin_count_var))

View File

@ -69,6 +69,7 @@ ialias_redirect (omp_get_level)
ialias_redirect (omp_get_ancestor_thread_num)
ialias_redirect (omp_get_team_size)
ialias_redirect (omp_get_active_level)
ialias_redirect (omp_in_final)
#endif
#ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
@ -428,3 +429,9 @@ omp_get_active_level_ (void)
{
return omp_get_active_level ();
}
int32_t
omp_in_final_ (void)
{
return omp_in_final ();
}

View File

@ -1,4 +1,5 @@
/* Copyright (C) 2005, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
/* Copyright (C) 2005, 2007, 2008, 2009, 2010, 2011
Free Software Foundation, Inc.
Contributed by Richard Henderson <rth@redhat.com>.
This file is part of the GNU OpenMP Library (libgomp).
@ -226,6 +227,7 @@ extern gomp_mutex_t gomp_remaining_threads_lock;
extern unsigned long gomp_max_active_levels_var;
extern unsigned long long gomp_spin_count_var, gomp_throttled_spin_count_var;
extern unsigned long gomp_available_cpus, gomp_managed_threads;
extern unsigned long *gomp_nthreads_var_list, gomp_nthreads_var_list_len;
enum gomp_task_kind
{
@ -251,6 +253,7 @@ struct gomp_task
enum gomp_task_kind kind;
bool in_taskwait;
bool in_tied_task;
bool final_task;
gomp_sem_t taskwait_sem;
};

View File

@ -107,6 +107,12 @@ OMP_3.0 {
omp_unset_nest_lock_;
} OMP_2.0;
OMP_3.1 {
global:
omp_in_final;
omp_in_final_;
} OMP_3.0;
GOMP_1.0 {
global:
GOMP_atomic_end;
@ -173,3 +179,8 @@ GOMP_2.0 {
GOMP_loop_ull_static_next;
GOMP_loop_ull_static_start;
} GOMP_1.0;
GOMP_3.0 {
global:
GOMP_taskyield;
} GOMP_2.0;

View File

@ -116,7 +116,7 @@ arranges for automatic linking of the OpenMP runtime library
A complete description of all OpenMP directives accepted may be found in
the @uref{http://www.openmp.org, OpenMP Application Program Interface} manual,
version 3.0.
version 3.1.
@c ---------------------------------------------------------------------
@ -127,7 +127,7 @@ version 3.0.
@chapter Runtime Library Routines
The runtime routines described here are defined by section 3 of the OpenMP
specifications in version 3.0. The routines are structured in following
specifications in version 3.1. The routines are structured in following
three parts:
Control threads, processors and the parallel environment.
@ -147,6 +147,7 @@ Control threads, processors and the parallel environment.
* omp_get_thread_limit:: Maximum number of threads
* omp_get_thread_num:: Current thread ID
* omp_in_parallel:: Whether a parallel region is active
* omp_in_final:: Whether in final or included task region
* omp_set_dynamic:: Enable/disable dynamic teams
* omp_set_max_active_levels:: Limits the number of active parallel regions
* omp_set_nested:: Enable/disable nested parallel regions
@ -199,7 +200,7 @@ which enclose the calling call.
@ref{omp_get_level}, @ref{omp_get_max_active_levels}, @ref{omp_set_max_active_levels}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.19.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.19.
@end table
@ -228,7 +229,7 @@ zero to @code{omp_get_level} -1 is returned; if @var{level} is
@ref{omp_get_level}, @ref{omp_get_thread_num}, @ref{omp_get_team_size}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.17.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.17.
@end table
@ -260,7 +261,7 @@ disabled by default.
@ref{omp_set_dynamic}, @ref{OMP_DYNAMIC}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.8.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.8.
@end table
@ -286,7 +287,7 @@ which enclose the calling call.
@ref{omp_get_active_level}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.16.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.16.
@end table
@ -311,7 +312,7 @@ This function obtains the maximum allowed number of nested, active parallel regi
@ref{omp_set_max_active_levels}, @ref{omp_get_active_level}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.14.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.15.
@end table
@ -337,7 +338,7 @@ that does not use the clause @code{num_threads}.
@ref{omp_set_num_threads}, @ref{omp_set_dynamic}, @ref{omp_get_thread_limit}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.3.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.3.
@end table
@ -369,7 +370,7 @@ disabled by default.
@ref{omp_set_nested}, @ref{OMP_NESTED}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.10.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.10.
@end table
@ -391,7 +392,7 @@ Returns the number of processors online.
@end multitable
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.5.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.5.
@end table
@ -424,7 +425,7 @@ one thread per CPU online is used.
@ref{omp_get_max_threads}, @ref{omp_set_num_threads}, @ref{OMP_NUM_THREADS}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.2.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.2.
@end table
@ -440,7 +441,7 @@ set to the value @code{omp_sched_static}, @code{omp_sched_dynamic},
@item @emph{C/C++}
@multitable @columnfractions .20 .80
@item @emph{Prototype}: @tab @code{omp_schedule(omp_sched_t *kind, int *modifier);}
@item @emph{Prototype}: @tab @code{void omp_schedule(omp_sched_t *kind, int *modifier);}
@end multitable
@item @emph{Fortran}:
@ -454,7 +455,7 @@ set to the value @code{omp_sched_static}, @code{omp_sched_dynamic},
@ref{omp_set_schedule}, @ref{OMP_SCHEDULE}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.12.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.12.
@end table
@ -484,7 +485,7 @@ to @code{omp_get_num_threads}.
@ref{omp_get_num_threads}, @ref{omp_get_level}, @ref{omp_get_ancestor_thread_num}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.18.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.18.
@end table
@ -509,7 +510,7 @@ Return the maximum number of threads of the program.
@ref{omp_get_max_threads}, @ref{OMP_THREAD_LIMIT}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.13.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.13.
@end table
@ -538,7 +539,7 @@ value of the master thread of a team is always 0.
@ref{omp_get_num_threads}, @ref{omp_get_ancestor_thread_num}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.4.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.4.
@end table
@ -562,7 +563,30 @@ their language-specific counterparts.
@end multitable
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.6.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.6.
@end table
@node omp_in_final
@section @code{omp_in_final} -- Whether in final or included task region
@table @asis
@item @emph{Description}:
This function returns @code{true} if currently running in a final
or included task region, @code{false} otherwise. Here, @code{true}
and @code{false} represent their language-specific counterparts.
@item @emph{C/C++}:
@multitable @columnfractions .20 .80
@item @emph{Prototype}: @tab @code{int omp_in_final(void);}
@end multitable
@item @emph{Fortran}:
@multitable @columnfractions .20 .80
@item @emph{Interface}: @tab @code{logical function omp_in_final()}
@end multitable
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.20.
@end table
@ -590,7 +614,7 @@ adjustment of team sizes and @code{false} disables it.
@ref{OMP_DYNAMIC}, @ref{omp_get_dynamic}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.7.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.7.
@end table
@ -617,7 +641,7 @@ parallel regions.
@ref{omp_get_max_active_levels}, @ref{omp_get_active_level}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.14.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.14.
@end table
@ -646,7 +670,7 @@ dynamic adjustment of team sizes and @code{false} disables it.
@ref{OMP_NESTED}, @ref{omp_get_nested}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.9.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.9.
@end table
@ -674,7 +698,7 @@ argument of @code{omp_set_num_threads} shall be a positive integer.
@ref{OMP_NUM_THREADS}, @ref{omp_get_num_threads}, @ref{omp_get_max_threads}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.1.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.1.
@end table
@ -692,7 +716,7 @@ For @code{omp_sched_auto} the @var{modifier} argument is ignored.
@item @emph{C/C++}
@multitable @columnfractions .20 .80
@item @emph{Prototype}: @tab @code{int omp_set_schedule(omp_sched_t *kind, int *modifier);}
@item @emph{Prototype}: @tab @code{void omp_set_schedule(omp_sched_t *kind, int *modifier);}
@end multitable
@item @emph{Fortran}:
@ -707,7 +731,7 @@ For @code{omp_sched_auto} the @var{modifier} argument is ignored.
@ref{OMP_SCHEDULE}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.2.11.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.2.11.
@end table
@ -734,7 +758,7 @@ an unlocked state.
@ref{omp_destroy_lock}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.1.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.1.
@end table
@ -763,7 +787,7 @@ a deadlock occurs.
@ref{omp_init_lock}, @ref{omp_test_lock}, @ref{omp_unset_lock}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.3.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.3.
@end table
@ -785,8 +809,7 @@ does not block if the lock is not available. This function returns
@item @emph{Fortran}:
@multitable @columnfractions .20 .80
@item @emph{Interface}: @tab @code{subroutine omp_test_lock(lock)}
@item @tab @code{logical(omp_logical_kind) :: omp_test_lock}
@item @emph{Interface}: @tab @code{logical function omp_test_lock(lock)}
@item @tab @code{integer(omp_lock_kind), intent(inout) :: lock}
@end multitable
@ -794,7 +817,7 @@ does not block if the lock is not available. This function returns
@ref{omp_init_lock}, @ref{omp_set_lock}, @ref{omp_set_lock}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.5.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.5.
@end table
@ -807,7 +830,7 @@ A simple lock about to be unset must have been locked by @code{omp_set_lock}
or @code{omp_test_lock} before. In addition, the lock must be held by the
thread calling @code{omp_unset_lock}. Then, the lock becomes unlocked. If one
or more threads attempted to set the lock before, one of them is chosen to,
again, set the lock for itself.
again, set the lock to itself.
@item @emph{C/C++}:
@multitable @columnfractions .20 .80
@ -824,7 +847,7 @@ again, set the lock for itself.
@ref{omp_set_lock}, @ref{omp_test_lock}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.4.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.4.
@end table
@ -851,7 +874,7 @@ in the unlocked state.
@ref{omp_init_lock}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.2.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.2.
@end table
@ -878,7 +901,7 @@ an unlocked state and the nesting count is set to zero.
@ref{omp_destroy_nest_lock}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.1.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.1.
@end table
@ -889,7 +912,7 @@ an unlocked state and the nesting count is set to zero.
Before setting a nested lock, the lock variable must be initialized by
@code{omp_init_nest_lock}. The calling thread is blocked until the lock
is available. If the lock is already held by the current thread, the
nesting count for the lock in incremented.
nesting count for the lock is incremented.
@item @emph{C/C++}:
@multitable @columnfractions .20 .80
@ -906,7 +929,7 @@ nesting count for the lock in incremented.
@ref{omp_init_nest_lock}, @ref{omp_unset_nest_lock}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.3.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.3.
@end table
@ -928,8 +951,7 @@ is returned. Otherwise, the return value equals zero.
@item @emph{Fortran}:
@multitable @columnfractions .20 .80
@item @emph{Interface}: @tab @code{integer function omp_test_nest_lock(lock)}
@item @tab @code{integer(omp_integer_kind) :: omp_test_nest_lock}
@item @emph{Interface}: @tab @code{logical function omp_test_nest_lock(lock)}
@item @tab @code{integer(omp_nest_lock_kind), intent(inout) :: lock}
@end multitable
@ -938,7 +960,7 @@ is returned. Otherwise, the return value equals zero.
@ref{omp_init_lock}, @ref{omp_set_lock}, @ref{omp_set_lock}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.5.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.5.
@end table
@ -951,7 +973,7 @@ A nested lock about to be unset must have been locked by @code{omp_set_nested_lo
or @code{omp_test_nested_lock} before. In addition, the lock must be held by the
thread calling @code{omp_unset_nested_lock}. If the nesting count drops to zero, the
lock becomes unlocked. If one ore more threads attempted to set the lock before,
one of them is chosen to, again, set the lock for itself.
one of them is chosen to, again, set the lock to itself.
@item @emph{C/C++}:
@multitable @columnfractions .20 .80
@ -968,7 +990,7 @@ one of them is chosen to, again, set the lock for itself.
@ref{omp_set_nest_lock}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.4.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.4.
@end table
@ -995,7 +1017,7 @@ in the unlocked state and its nesting count must equal zero.
@ref{omp_init_lock}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.3.2.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.3.2.
@end table
@ -1021,7 +1043,7 @@ successive clock ticks.
@ref{omp_get_wtime}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.4.2.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.4.2.
@end table
@ -1049,7 +1071,7 @@ guaranteed not to change during the execution of the program.
@ref{omp_get_wtick}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 3.4.1.
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 3.4.1.
@end table
@ -1064,7 +1086,7 @@ guaranteed not to change during the execution of the program.
The variables @env{OMP_DYNAMIC}, @env{OMP_MAX_ACTIVE_LEVELS},
@env{OMP_NESTED}, @env{OMP_NUM_THREADS}, @env{OMP_SCHEDULE},
@env{OMP_STACKSIZE},@env{OMP_THREAD_LIMIT} and @env{OMP_WAIT_POLICY}
are defined by section 4 of the OpenMP specifications in version 3.0,
are defined by section 4 of the OpenMP specifications in version 3.1,
while @env{GOMP_CPU_AFFINITY} and @env{GOMP_STACKSIZE} are GNU
extensions.
@ -1077,6 +1099,7 @@ extensions.
* OMP_SCHEDULE:: How threads are scheduled
* OMP_THREAD_LIMIT:: Set the maximum number of threads
* OMP_WAIT_POLICY:: How waiting threads are handled
* OMP_PROC_BIND:: Whether theads may be moved between CPUs
* GOMP_CPU_AFFINITY:: Bind threads to specific CPUs
* GOMP_STACKSIZE:: Set default thread stack size
@end menu
@ -1096,7 +1119,7 @@ disabled by default.
@ref{omp_set_dynamic}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 4.3
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 4.3
@end table
@ -1107,14 +1130,14 @@ disabled by default.
@table @asis
@item @emph{Description}:
Specifies the initial value for the maximum number of nested parallel
regions. The value of this variable shall be positive integer.
regions. The value of this variable shall be a positive integer.
If undefined, the number of active levels is unlimited.
@item @emph{See also}:
@ref{omp_set_max_active_levels}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 4.7
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 4.8
@end table
@ -1134,7 +1157,7 @@ regions are disabled by default.
@ref{omp_set_nested}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 4.4
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 4.5
@end table
@ -1146,14 +1169,15 @@ regions are disabled by default.
@table @asis
@item @emph{Description}:
Specifies the default number of threads to use in parallel regions. The
value of this variable shall be a positive integer. If undefined one thread
per CPU is used.
value of this variable shall be a comma-separated list of positive integers;
the value specified the number of threads to use for the corresponding nested
level. If undefined one thread per CPU is used.
@item @emph{See also}:
@ref{omp_set_num_threads}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 4.2
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 4.2
@end table
@ -1174,7 +1198,7 @@ dynamic scheduling and a chunk size of 1 is used.
@ref{omp_set_schedule}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, sections 2.5.1 and 4.1
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, sections 2.5.1 and 4.1
@end table
@ -1188,13 +1212,13 @@ Set the default thread stack size in kilobytes, unless the number
is suffixed by @code{B}, @code{K}, @code{M} or @code{G}, in which
case the size is, respectively, in bytes, kilobytes, megabytes
or gigabytes. This is different from @code{pthread_attr_setstacksize}
which gets the number of bytes as an argument. If the stacksize cannot
which gets the number of bytes as an argument. If the stack size cannot
be set due to system constraints, an error is reported and the initial
stacksize is left unchanged. If undefined, the stack size is system
stack size is left unchanged. If undefined, the stack size is system
dependent.
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, sections 4.5
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, sections 4.6
@end table
@ -1213,7 +1237,7 @@ the number of threads is not limited.
@ref{omp_get_thread_limit}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, section 4.8
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, section 4.9
@end table
@ -1229,7 +1253,25 @@ power while waiting; while the value is @code{ACTIVE} specifies that
they should.
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.0}, sections 4.6
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, sections 4.7
@end table
@node OMP_PROC_BIND
@section @env{OMP_PROC_BIND} -- Whether theads may be moved between CPUs
@cindex Environment Variable
@table @asis
@item @emph{Description}:
Specifies whether threads may be moved between processors. If set to
@code{true}, OpenMP theads should not be moved, if set to @code{false}
they may be moved.
@item @emph{See also}:
@ref{GOMP_CPU_AFFINITY}
@item @emph{Reference}:
@uref{http://www.openmp.org/, OpenMP specifications v3.1}, sections 4.4
@end table
@ -1258,6 +1300,9 @@ or disabled during the runtime of the application.
If this environment variable is omitted, the host system will handle the
assignment of threads to CPUs.
@item @emph{See also}:
@ref{OMP_PROC_BIND}
@end table
@ -1270,8 +1315,8 @@ assignment of threads to CPUs.
@item @emph{Description}:
Set the default thread stack size in kilobytes. This is different from
@code{pthread_attr_setstacksize} which gets the number of bytes as an
argument. If the stacksize cannot be set due to system constraints, an
error is reported and the initial stacksize is left unchanged. If undefined,
argument. If the stack size cannot be set due to system constraints, an
error is reported and the initial stack size is left unchanged. If undefined,
the stack size is system dependent.
@item @emph{See also}:

View File

@ -158,11 +158,12 @@ extern void GOMP_ordered_end (void);
extern void GOMP_parallel_start (void (*) (void *), void *, unsigned);
extern void GOMP_parallel_end (void);
/* team.c */
/* task.c */
extern void GOMP_task (void (*) (void *), void *, void (*) (void *, void *),
long, long, bool, unsigned);
extern void GOMP_taskwait (void);
extern void GOMP_taskyield (void);
/* sections.c */

View File

@ -1,4 +1,4 @@
/* Copyright (C) 2005, 2007, 2008, 2009 Free Software Foundation, Inc.
/* Copyright (C) 2005, 2007, 2008, 2009, 2011 Free Software Foundation, Inc.
Contributed by Richard Henderson <rth@redhat.com>.
This file is part of the GNU OpenMP Library (libgomp).
@ -98,6 +98,8 @@ int omp_get_ancestor_thread_num (int) __GOMP_NOTHROW;
int omp_get_team_size (int) __GOMP_NOTHROW;
int omp_get_active_level (void) __GOMP_NOTHROW;
int omp_in_final (void) __GOMP_NOTHROW;
#ifdef __cplusplus
}
#endif

View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2007, 2008, 2009 Free Software Foundation, Inc.
! Copyright (C) 2005, 2007, 2008, 2009, 2011 Free Software Foundation, Inc.
! Contributed by Jakub Jelinek <jakub@redhat.com>.
! This file is part of the GNU OpenMP Library (libgomp).
@ -24,8 +24,6 @@
module omp_lib_kinds
implicit none
integer, parameter :: omp_integer_kind = 4
integer, parameter :: omp_logical_kind = 4
integer, parameter :: omp_lock_kind = @OMP_LOCK_KIND@
integer, parameter :: omp_nest_lock_kind = @OMP_NEST_LOCK_KIND@
integer, parameter :: omp_sched_kind = 4
@ -34,7 +32,7 @@
module omp_lib
use omp_lib_kinds
implicit none
integer, parameter :: openmp_version = 200805
integer, parameter :: openmp_version = 201107
integer (omp_sched_kind), parameter :: omp_sched_static = 1
integer (omp_sched_kind), parameter :: omp_sched_dynamic = 2
integer (omp_sched_kind), parameter :: omp_sched_guided = 3
@ -126,28 +124,28 @@
interface
function omp_get_dynamic ()
use omp_lib_kinds
logical (omp_logical_kind) :: omp_get_dynamic
logical (4) :: omp_get_dynamic
end function omp_get_dynamic
end interface
interface
function omp_get_nested ()
use omp_lib_kinds
logical (omp_logical_kind) :: omp_get_nested
logical (4) :: omp_get_nested
end function omp_get_nested
end interface
interface
function omp_in_parallel ()
use omp_lib_kinds
logical (omp_logical_kind) :: omp_in_parallel
logical (4) :: omp_in_parallel
end function omp_in_parallel
end interface
interface
function omp_test_lock (lock)
use omp_lib_kinds
logical (omp_logical_kind) :: omp_test_lock
logical (4) :: omp_test_lock
integer (omp_lock_kind), intent (inout) :: lock
end function omp_test_lock
end interface
@ -155,35 +153,35 @@
interface
function omp_get_max_threads ()
use omp_lib_kinds
integer (omp_integer_kind) :: omp_get_max_threads
integer (4) :: omp_get_max_threads
end function omp_get_max_threads
end interface
interface
function omp_get_num_procs ()
use omp_lib_kinds
integer (omp_integer_kind) :: omp_get_num_procs
integer (4) :: omp_get_num_procs
end function omp_get_num_procs
end interface
interface
function omp_get_num_threads ()
use omp_lib_kinds
integer (omp_integer_kind) :: omp_get_num_threads
integer (4) :: omp_get_num_threads
end function omp_get_num_threads
end interface
interface
function omp_get_thread_num ()
use omp_lib_kinds
integer (omp_integer_kind) :: omp_get_thread_num
integer (4) :: omp_get_thread_num
end function omp_get_thread_num
end interface
interface
function omp_test_nest_lock (lock)
use omp_lib_kinds
integer (omp_integer_kind) :: omp_test_nest_lock
integer (4) :: omp_test_nest_lock
integer (omp_nest_lock_kind), intent (inout) :: lock
end function omp_test_nest_lock
end interface
@ -229,7 +227,7 @@
interface
function omp_get_thread_limit ()
use omp_lib_kinds
integer (omp_integer_kind) :: omp_get_thread_limit
integer (4) :: omp_get_thread_limit
end function omp_get_thread_limit
end interface
@ -247,14 +245,14 @@
interface
function omp_get_max_active_levels ()
use omp_lib_kinds
integer (omp_integer_kind) :: omp_get_max_active_levels
integer (4) :: omp_get_max_active_levels
end function omp_get_max_active_levels
end interface
interface
function omp_get_level ()
use omp_lib_kinds
integer (omp_integer_kind) :: omp_get_level
integer (4) :: omp_get_level
end function omp_get_level
end interface
@ -262,12 +260,12 @@
function omp_get_ancestor_thread_num (level)
use omp_lib_kinds
integer (4), intent (in) :: level
integer (omp_integer_kind) :: omp_get_ancestor_thread_num
integer (4) :: omp_get_ancestor_thread_num
end function omp_get_ancestor_thread_num
function omp_get_ancestor_thread_num_8 (level)
use omp_lib_kinds
integer (8), intent (in) :: level
integer (omp_integer_kind) :: omp_get_ancestor_thread_num_8
integer (4) :: omp_get_ancestor_thread_num_8
end function omp_get_ancestor_thread_num_8
end interface
@ -275,20 +273,27 @@
function omp_get_team_size (level)
use omp_lib_kinds
integer (4), intent (in) :: level
integer (omp_integer_kind) :: omp_get_team_size
integer (4) :: omp_get_team_size
end function omp_get_team_size
function omp_get_team_size_8 (level)
use omp_lib_kinds
integer (8), intent (in) :: level
integer (omp_integer_kind) :: omp_get_team_size_8
integer (4) :: omp_get_team_size_8
end function omp_get_team_size_8
end interface
interface
function omp_get_active_level ()
use omp_lib_kinds
integer (omp_integer_kind) :: omp_get_active_level
integer (4) :: omp_get_active_level
end function omp_get_active_level
end interface
interface
function omp_in_final ()
use omp_lib_kinds
logical (4) :: omp_in_final
end function omp_in_final
end interface
end module omp_lib

View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2007, 2008, 2009 Free Software Foundation, Inc.
! Copyright (C) 2005, 2007, 2008, 2009, 2011 Free Software Foundation, Inc.
! Contributed by Jakub Jelinek <jakub@redhat.com>.
! This file is part of the GNU OpenMP Library (libgomp).
@ -23,16 +23,17 @@
! <http://www.gnu.org/licenses/>.
integer omp_lock_kind, omp_nest_lock_kind, openmp_version
integer omp_sched_kind, omp_sched_static, omp_sched_dynamic
integer omp_sched_guided, omp_sched_auto
parameter (omp_lock_kind = @OMP_LOCK_KIND@)
parameter (omp_nest_lock_kind = @OMP_NEST_LOCK_KIND@)
integer omp_sched_kind
parameter (omp_sched_kind = 4)
integer (omp_sched_kind) omp_sched_static, omp_sched_dynamic
integer (omp_sched_kind) omp_sched_guided, omp_sched_auto
parameter (omp_sched_static = 1)
parameter (omp_sched_dynamic = 2)
parameter (omp_sched_guided = 3)
parameter (omp_sched_auto = 4)
parameter (openmp_version = 200805)
parameter (openmp_version = 201107)
external omp_init_lock, omp_init_nest_lock
external omp_destroy_lock, omp_destroy_nest_lock
@ -64,3 +65,6 @@
integer(4) omp_get_thread_limit, omp_get_max_active_levels
integer(4) omp_get_level, omp_get_ancestor_thread_num
integer(4) omp_get_team_size, omp_get_active_level
external omp_in_final
logical(4) omp_in_final

View File

@ -1,4 +1,4 @@
/* Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
/* Copyright (C) 2007, 2008, 2009, 2011 Free Software Foundation, Inc.
Contributed by Richard Henderson <rth@redhat.com>.
This file is part of the GNU OpenMP Library (libgomp).
@ -41,6 +41,7 @@ gomp_init_task (struct gomp_task *task, struct gomp_task *parent_task,
task->kind = GOMP_TASK_IMPLICIT;
task->in_taskwait = false;
task->in_tied_task = false;
task->final_task = false;
task->children = NULL;
gomp_sem_init (&task->taskwait_sem, 0);
}
@ -77,8 +78,7 @@ gomp_clear_parent (struct gomp_task *children)
void
GOMP_task (void (*fn) (void *), void *data, void (*cpyfn) (void *, void *),
long arg_size, long arg_align, bool if_clause,
unsigned flags __attribute__((unused)))
long arg_size, long arg_align, bool if_clause, unsigned flags)
{
struct gomp_thread *thr = gomp_thread ();
struct gomp_team *team = thr->ts.team;
@ -95,12 +95,14 @@ GOMP_task (void (*fn) (void *), void *data, void (*cpyfn) (void *, void *),
#endif
if (!if_clause || team == NULL
|| (thr->task && thr->task->final_task)
|| team->task_count > 64 * team->nthreads)
{
struct gomp_task task;
gomp_init_task (&task, thr->task, gomp_icv (false));
task.kind = GOMP_TASK_IFFALSE;
task.final_task = (thr->task && thr->task->final_task) || (flags & 2);
if (thr->task)
task.in_tied_task = thr->task->in_tied_task;
thr->task = &task;
@ -145,6 +147,7 @@ GOMP_task (void (*fn) (void *), void *data, void (*cpyfn) (void *, void *),
task->fn = fn;
task->fn_data = arg;
task->in_tied_task = true;
task->final_task = (flags & 2) >> 1;
gomp_mutex_lock (&team->task_lock);
if (parent->children)
{
@ -362,3 +365,20 @@ GOMP_taskwait (void)
}
}
}
/* Called when encountering a taskyield directive. */
void
GOMP_taskyield (void)
{
/* Nothing at the moment. */
}
int
omp_in_final (void)
{
struct gomp_thread *thr = gomp_thread ();
return thr->task && thr->task->final_task;
}
ialias (omp_in_final)

View File

@ -1,4 +1,5 @@
/* Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
/* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2011
Free Software Foundation, Inc.
Contributed by Richard Henderson <rth@redhat.com>.
This file is part of the GNU OpenMP Library (libgomp).
@ -260,6 +261,7 @@ gomp_team_start (void (*fn) (void *), void *data, unsigned nthreads,
struct gomp_thread_pool *pool;
unsigned i, n, old_threads_used = 0;
pthread_attr_t thread_attr, *attr;
unsigned long nthreads_var;
thr = gomp_thread ();
nested = thr->ts.team != NULL;
@ -289,7 +291,12 @@ gomp_team_start (void (*fn) (void *), void *data, unsigned nthreads,
#endif
thr->ts.static_trip = 0;
thr->task = &team->implicit_task[0];
nthreads_var = icv->nthreads_var;
if (__builtin_expect (gomp_nthreads_var_list != NULL, 0)
&& thr->ts.level < gomp_nthreads_var_list_len)
nthreads_var = gomp_nthreads_var_list[thr->ts.level];
gomp_init_task (thr->task, task, icv);
team->implicit_task[0].icv.nthreads_var = nthreads_var;
if (nthreads == 1)
return;
@ -342,6 +349,7 @@ gomp_team_start (void (*fn) (void *), void *data, unsigned nthreads,
nthr->ts.static_trip = 0;
nthr->task = &team->implicit_task[i];
gomp_init_task (nthr->task, task, icv);
team->implicit_task[i].icv.nthreads_var = nthreads_var;
nthr->fn = fn;
nthr->data = data;
team->ordered_release[i] = &nthr->release;
@ -413,6 +421,7 @@ gomp_team_start (void (*fn) (void *), void *data, unsigned nthreads,
start_data->ts.static_trip = 0;
start_data->task = &team->implicit_task[i];
gomp_init_task (start_data->task, task, icv);
team->implicit_task[i].icv.nthreads_var = nthreads_var;
start_data->thread_pool = pool;
start_data->nested = nested;

View File

@ -0,0 +1,156 @@
// { dg-do run }
extern "C" void abort (void);
int x = 6;
float y;
int
main (void)
{
int v;
float f;
#pragma omp atomic read
v = x;
if (v != 6)
abort ();
#pragma omp atomic write
x = 17;
#pragma omp atomic read
v = x;
if (v != 17)
abort ();
#pragma omp atomic update
x++;
#pragma omp atomic read
v = x;
if (v != 18)
abort ();
#pragma omp atomic capture
v = x++;
if (v != 18)
abort ();
#pragma omp atomic read
v = x;
if (v != 19)
abort ();
#pragma omp atomic capture
v = ++x;
if (v != 20)
abort ();
#pragma omp atomic read
v = x;
if (v != 20)
abort ();
#pragma omp atomic capture
{ v = x; x *= 3; }
if (v != 20)
abort ();
#pragma omp atomic read
v = x;
if (v != 60)
abort ();
#pragma omp atomic capture
{
x |= 2;
v = x;
}
if (v != 62)
abort ();
#pragma omp atomic read
v = x;
if (v != 62)
abort ();
#pragma omp atomic capture
{ v = x; x++; }
if (v != 62)
abort ();
#pragma omp atomic capture
{ v = x; ++x; }
if (v != 63)
abort ();
#pragma omp atomic capture
{
++x;
v = x;
}
if (v != 65)
abort ();
#pragma omp atomic capture
{x++;v=x;}if (v != 66)
abort ();
#pragma omp atomic read
v = x;
if (v != 66)
abort ();
#pragma omp atomic capture
{ v = x; x--; }
if (v != 66)
abort ();
#pragma omp atomic capture
{ v = x; --x; }
if (v != 65)
abort ();
#pragma omp atomic capture
{
--x;
v = x;
}
if (v != 63)
abort ();
#pragma omp atomic capture
{ x--; v = x; } if (v != 62)
abort ();
#pragma omp atomic read
v = x;
if (v != 62)
abort ();
#pragma omp atomic write
y = 17.5f;
#pragma omp atomic read
f = y;
if (f != 17.5)
abort ();
#pragma omp atomic update
y *= 2.0f;
#pragma omp atomic read
f = y;
if (y != 35.0)
abort ();
#pragma omp atomic capture
f = y *= 2.0f;
if (f != 70.0)
abort ();
#pragma omp atomic capture
f = y++;
if (f != 70.0)
abort ();
#pragma omp atomic read
f = y;
if (f != 71.0)
abort ();
#pragma omp atomic capture
f = --y;
if (f != 70.0)
abort ();
#pragma omp atomic read
f = y;
if (f != 70.0)
abort ();
#pragma omp atomic capture
{ f = y; y /= 2.0f; }
if (f != 70.0)
abort ();
#pragma omp atomic read
f = y;
if (f != 35.0)
abort ();
#pragma omp atomic capture
{ y /= 2.0f; f = y; }
if (f != 17.5)
abort ();
#pragma omp atomic read
f = y;
if (f != 17.5)
abort ();
return 0;
}

View File

@ -0,0 +1,74 @@
// { dg-do run }
extern "C" void abort (void);
bool v, x1, x2, x3, x4, x5, x6;
void
foo ()
{
#pragma omp atomic capture
v = ++x1;
if (!v)
abort ();
#pragma omp atomic capture
v = x2++;
if (v)
abort ();
#pragma omp atomic read
v = x3;
if (!v)
abort ();
#pragma omp atomic read
v = x4;
if (!v)
abort ();
#pragma omp atomic capture
{ v = x5; x5 |= 1; }
if (v)
abort ();
#pragma omp atomic capture
{ x6 |= 1; v = x6; }
if (!v)
abort ();
}
void
bar ()
{
#pragma omp atomic write
x1 = false;
#pragma omp atomic write
x2 = false;
#pragma omp atomic capture
{ ++x1; v = x1; }
if (!v)
abort ();
#pragma omp atomic capture
{ v = x2; x2++; }
if (v)
abort ();
#pragma omp atomic write
x1 = false;
#pragma omp atomic write
x2 = false;
#pragma omp atomic capture
{ x1++; v = x1; }
if (!v)
abort ();
#pragma omp atomic capture
{ v = x2; ++x2; }
if (v)
abort ();
}
int
main ()
{
#pragma omp atomic write
x3 = true;
#pragma omp atomic write
x4 = true;
foo ();
bar ();
return 0;
}

View File

@ -0,0 +1,166 @@
// { dg-do run }
extern "C" void abort (void);
template <typename T, typename T2>
int
foo (void)
{
extern T x;
extern T2 y;
T v;
T2 f;
#pragma omp atomic read
v = x;
if (v != 6)
abort ();
#pragma omp atomic write
x = 17;
#pragma omp atomic read
v = x;
if (v != 17)
abort ();
#pragma omp atomic update
x++;
#pragma omp atomic read
v = x;
if (v != 18)
abort ();
#pragma omp atomic capture
v = x++;
if (v != 18)
abort ();
#pragma omp atomic read
v = x;
if (v != 19)
abort ();
#pragma omp atomic capture
v = ++x;
if (v != 20)
abort ();
#pragma omp atomic read
v = x;
if (v != 20)
abort ();
#pragma omp atomic capture
{ v = x; x *= 3; }
if (v != 20)
abort ();
#pragma omp atomic read
v = x;
if (v != 60)
abort ();
#pragma omp atomic capture
{
x |= 2;
v = x;
}
if (v != 62)
abort ();
#pragma omp atomic read
v = x;
if (v != 62)
abort ();
#pragma omp atomic capture
{ v = x; x++; }
if (v != 62)
abort ();
#pragma omp atomic capture
{ v = x; ++x; }
if (v != 63)
abort ();
#pragma omp atomic capture
{
++x;
v = x;
}
if (v != 65)
abort ();
#pragma omp atomic capture
{x++;v=x;}if (v != 66)
abort ();
#pragma omp atomic read
v = x;
if (v != 66)
abort ();
#pragma omp atomic capture
{ v = x; x--; }
if (v != 66)
abort ();
#pragma omp atomic capture
{ v = x; --x; }
if (v != 65)
abort ();
#pragma omp atomic capture
{
--x;
v = x;
}
if (v != 63)
abort ();
#pragma omp atomic capture
{ x--; v = x; } if (v != 62)
abort ();
#pragma omp atomic read
v = x;
if (v != 62)
abort ();
#pragma omp atomic write
y = 17.5f;
#pragma omp atomic read
f = y;
if (f != 17.5)
abort ();
#pragma omp atomic update
y *= 2.0f;
#pragma omp atomic read
f = y;
if (y != 35.0)
abort ();
#pragma omp atomic capture
f = y *= 2.0f;
if (f != 70.0)
abort ();
#pragma omp atomic capture
f = y++;
if (f != 70.0)
abort ();
#pragma omp atomic read
f = y;
if (f != 71.0)
abort ();
#pragma omp atomic capture
f = --y;
if (f != 70.0)
abort ();
#pragma omp atomic read
f = y;
if (f != 70.0)
abort ();
#pragma omp atomic capture
{ f = y; y /= 2.0f; }
if (f != 70.0)
abort ();
#pragma omp atomic read
f = y;
if (f != 35.0)
abort ();
#pragma omp atomic capture
{ y /= 2.0f; f = y; }
if (f != 17.5)
abort ();
#pragma omp atomic read
f = y;
if (f != 17.5)
abort ();
return 0;
}
int x = 6;
float y;
int
main ()
{
foo <int, float> ();
return 0;
}

View File

@ -0,0 +1,79 @@
// { dg-do run }
extern "C" void abort (void);
template <typename T>
void
foo ()
{
extern T v, x1, x2, x3, x4, x5, x6;
#pragma omp atomic capture
v = ++x1;
if (!v)
abort ();
#pragma omp atomic capture
v = x2++;
if (v)
abort ();
#pragma omp atomic read
v = x3;
if (!v)
abort ();
#pragma omp atomic read
v = x4;
if (!v)
abort ();
#pragma omp atomic capture
{ v = x5; x5 |= 1; }
if (v)
abort ();
#pragma omp atomic capture
{ x6 |= 1; v = x6; }
if (!v)
abort ();
}
template <typename T>
void
bar ()
{
extern T v, x1, x2;
#pragma omp atomic write
x1 = false;
#pragma omp atomic write
x2 = false;
#pragma omp atomic capture
{ ++x1; v = x1; }
if (!v)
abort ();
#pragma omp atomic capture
{ v = x2; x2++; }
if (v)
abort ();
#pragma omp atomic write
x1 = false;
#pragma omp atomic write
x2 = false;
#pragma omp atomic capture
{ x1++; v = x1; }
if (!v)
abort ();
#pragma omp atomic capture
{ v = x2; ++x2; }
if (v)
abort ();
}
bool v, x1, x2, x3, x4, x5, x6;
int
main ()
{
#pragma omp atomic write
x3 = true;
#pragma omp atomic write
x4 = true;
foo <bool> ();
bar <bool> ();
return 0;
}

View File

@ -0,0 +1,58 @@
// { dg-do run }
extern "C" void abort (void);
long long l, m;
int i, j;
void
foo (void)
{
#pragma omp atomic read
i = l;
#pragma omp atomic read
m = j;
if (i != 77 || m != 88)
abort ();
#pragma omp atomic write
l = 1 + i + 6 * 1;
#pragma omp atomic write
j = 170 - 170 + m + 1 * 7;
#pragma omp atomic capture
i = l += 4;
#pragma omp atomic capture
m = j += 4;
if (i != 88 || m != 99)
abort ();
#pragma omp atomic capture
{
i = l;
l += 4;
}
#pragma omp atomic capture
{
m = j;
j += 4;
}
if (i != 88 || m != 99)
abort ();
#pragma omp atomic capture
{
l += 4;
i = l;
}
#pragma omp atomic capture
{
j += 4;
m = j;
}
if (i != 96 || m != 107)
abort ();
}
int
main ()
{
l = 77;
j = 88;
foo ();
}

View File

@ -0,0 +1,63 @@
// { dg-do run }
extern "C" void abort (void);
template <typename S, typename T>
void
foo (void)
{
extern S l, m;
extern T i, j;
#pragma omp atomic read
i = l;
#pragma omp atomic read
m = j;
if (i != 77 || m != 88)
abort ();
#pragma omp atomic write
l = 1 + i + 6 * 1;
#pragma omp atomic write
j = 170 - 170 + m + 1 * 7;
#pragma omp atomic capture
i = l += 4;
#pragma omp atomic capture
m = j += 4;
if (i != 88 || m != 99)
abort ();
#pragma omp atomic capture
{
i = l;
l += 4;
}
#pragma omp atomic capture
{
m = j;
j += 4;
}
if (i != 88 || m != 99)
abort ();
#pragma omp atomic capture
{
l += 4;
i = l;
}
#pragma omp atomic capture
{
j += 4;
m = j;
}
if (i != 96 || m != 107)
abort ();
}
long long l, m;
int i, j;
int
main ()
{
l = 77;
j = 88;
foo <long long, int> ();
}

View File

@ -0,0 +1,137 @@
// { dg-do run }
extern "C" void abort ();
int x = 6, cnt;
int
foo ()
{
return cnt++;
}
int
main ()
{
int v, *p;
#pragma omp atomic update
x = x + 7;
#pragma omp atomic
x = x + 7 + 6;
#pragma omp atomic update
x = x + 2 * 3;
#pragma omp atomic
x = x * (2 - 1);
#pragma omp atomic read
v = x;
if (v != 32)
abort ();
#pragma omp atomic write
x = 0;
#pragma omp atomic capture
{
v = x;
x = x | 1 ^ 2;
}
if (v != 0)
abort ();
#pragma omp atomic capture
{
v = x;
x = x | 4 | 2;
}
if (v != 3)
abort ();
#pragma omp atomic read
v = x;
if (v != 7)
abort ();
#pragma omp atomic capture
{
x = x ^ 6 & 2;
v = x;
}
if (v != 5)
abort ();
#pragma omp atomic capture
{ x = x - (6 + 4); v = x; }
if (v != -5)
abort ();
#pragma omp atomic capture
{ v = x; x = x - (1 | 2); }
if (v != -5)
abort ();
#pragma omp atomic read
v = x;
if (v != -8)
abort ();
#pragma omp atomic
x = x * -4 / 2;
#pragma omp atomic read
v = x;
if (v != 16)
abort ();
p = &x;
#pragma omp atomic update
p[foo (), 0] = p[foo (), 0] - 16;
#pragma omp atomic read
v = x;
if (cnt != 2 || v != 0)
abort ();
#pragma omp atomic capture
{
p[foo (), 0] += 6;
v = p[foo (), 0];
}
if (cnt != 4 || v != 6)
abort ();
#pragma omp atomic capture
{
v = p[foo (), 0];
p[foo (), 0] += 6;
}
if (cnt != 6 || v != 6)
abort ();
#pragma omp atomic read
v = x;
if (v != 12)
abort ();
#pragma omp atomic capture
{
p[foo (), 0] = p[foo (), 0] + 6;
v = p[foo (), 0];
}
if (cnt != 9 || v != 18)
abort ();
#pragma omp atomic capture
{
v = p[foo (), 0];
p[foo (), 0] = p[foo (), 0] + 6;
}
if (cnt != 12 || v != 18)
abort ();
#pragma omp atomic read
v = x;
if (v != 24)
abort ();
#pragma omp atomic capture
{ v = p[foo (), 0]; p[foo (), 0]++; }
#pragma omp atomic capture
{ v = p[foo (), 0]; ++p[foo (), 0]; }
#pragma omp atomic capture
{ p[foo (), 0]++; v = p[foo (), 0]; }
#pragma omp atomic capture
{ ++p[foo (), 0]; v = p[foo (), 0]; }
if (cnt != 20 || v != 28)
abort ();
#pragma omp atomic capture
{ v = p[foo (), 0]; p[foo (), 0]--; }
#pragma omp atomic capture
{ v = p[foo (), 0]; --p[foo (), 0]; }
#pragma omp atomic capture
{ p[foo (), 0]--; v = p[foo (), 0]; }
#pragma omp atomic capture
{ --p[foo (), 0]; v = p[foo (), 0]; }
if (cnt != 28 || v != 24)
abort ();
return 0;
}

View File

@ -0,0 +1,148 @@
// { dg-do run }
extern "C" void abort ();
int cnt;
int
foo ()
{
return cnt++;
}
template <typename T>
void
bar ()
{
extern T x;
T v, *p;
#pragma omp atomic update
x = x + 7;
#pragma omp atomic
x = x + 7 + 6;
#pragma omp atomic update
x = x + 2 * 3;
#pragma omp atomic
x = x * (2 - 1);
#pragma omp atomic read
v = x;
if (v != 32)
abort ();
#pragma omp atomic write
x = 0;
#pragma omp atomic capture
{
v = x;
x = x | 1 ^ 2;
}
if (v != 0)
abort ();
#pragma omp atomic capture
{
v = x;
x = x | 4 | 2;
}
if (v != 3)
abort ();
#pragma omp atomic read
v = x;
if (v != 7)
abort ();
#pragma omp atomic capture
{
x = x ^ 6 & 2;
v = x;
}
if (v != 5)
abort ();
#pragma omp atomic capture
{ x = x - (6 + 4); v = x; }
if (v != -5)
abort ();
#pragma omp atomic capture
{ v = x; x = x - (1 | 2); }
if (v != -5)
abort ();
#pragma omp atomic read
v = x;
if (v != -8)
abort ();
#pragma omp atomic
x = x * -4 / 2;
#pragma omp atomic read
v = x;
if (v != 16)
abort ();
p = &x;
#pragma omp atomic update
p[foo (), 0] = p[foo (), 0] - 16;
#pragma omp atomic read
v = x;
if (cnt != 2 || v != 0)
abort ();
#pragma omp atomic capture
{
p[foo (), 0] += 6;
v = p[foo (), 0];
}
if (cnt != 4 || v != 6)
abort ();
#pragma omp atomic capture
{
v = p[foo (), 0];
p[foo (), 0] += 6;
}
if (cnt != 6 || v != 6)
abort ();
#pragma omp atomic read
v = x;
if (v != 12)
abort ();
#pragma omp atomic capture
{
p[foo (), 0] = p[foo (), 0] + 6;
v = p[foo (), 0];
}
if (cnt != 9 || v != 18)
abort ();
#pragma omp atomic capture
{
v = p[foo (), 0];
p[foo (), 0] = p[foo (), 0] + 6;
}
if (cnt != 12 || v != 18)
abort ();
#pragma omp atomic read
v = x;
if (v != 24)
abort ();
#pragma omp atomic capture
{ v = p[foo (), 0]; p[foo (), 0]++; }
#pragma omp atomic capture
{ v = p[foo (), 0]; ++p[foo (), 0]; }
#pragma omp atomic capture
{ p[foo (), 0]++; v = p[foo (), 0]; }
#pragma omp atomic capture
{ ++p[foo (), 0]; v = p[foo (), 0]; }
if (cnt != 20 || v != 28)
abort ();
#pragma omp atomic capture
{ v = p[foo (), 0]; p[foo (), 0]--; }
#pragma omp atomic capture
{ v = p[foo (), 0]; --p[foo (), 0]; }
#pragma omp atomic capture
{ p[foo (), 0]--; v = p[foo (), 0]; }
#pragma omp atomic capture
{ --p[foo (), 0]; v = p[foo (), 0]; }
if (cnt != 28 || v != 24)
abort ();
}
int x = 6;
int
main ()
{
bar <int> ();
return 0;
}

View File

@ -0,0 +1,54 @@
// { dg-do run }
extern "C" void abort (void);
template <typename I, typename F>
void
foo ()
{
I j = -10000;
F f = 1024.0;
int i;
#pragma omp parallel for reduction (min:f) reduction (max:j)
for (i = 0; i < 4; i++)
switch (i)
{
case 0:
if (j < -16) j = -16; break;
case 1:
if (f > -2.0) f = -2.0; break;
case 2:
if (j < 8) j = 8; if (f > 9.0) f = 9.0; break;
case 3:
break;
}
if (j != 8 || f != -2.0)
abort ();
}
int
main ()
{
int j = -10000;
float f = 1024.0;
int i;
#pragma omp parallel for reduction (min:f) reduction (max:j)
for (i = 0; i < 4; i++)
switch (i)
{
case 0:
if (j < -16) j = -16; break;
case 1:
if (f > -2.0) f = -2.0; break;
case 2:
if (j < 8) j = 8; if (f > 9.0) f = 9.0; break;
case 3:
break;
}
if (j != 8 || f != -2.0)
abort ();
foo <int, float> ();
foo <long, double> ();
foo <long long, long double> ();
return 0;
}

View File

@ -0,0 +1,44 @@
// { dg-do run }
#include <omp.h>
#include <cstdlib>
int err;
int
main ()
{
int e;
#pragma omp parallel shared(err)
{
if (omp_in_final ())
#pragma omp atomic write
err = 1;
#pragma omp task if (0) shared(err)
{
if (omp_in_final ())
#pragma omp atomic write
err = 1;
#pragma omp task if (0) shared(err)
if (omp_in_final ())
#pragma omp atomic write
err = 1;
}
#pragma omp task final (1) shared(err)
{
if (!omp_in_final ())
#pragma omp atomic write
err = 1;
#pragma omp taskyield
#pragma omp taskwait
#pragma omp task shared(err)
if (!omp_in_final ())
#pragma omp atomic write
err = 1;
}
}
#pragma omp atomic read
e = err;
if (e)
abort ();
}

View File

@ -0,0 +1,156 @@
/* { dg-do run } */
extern void abort (void);
int x = 6;
float y;
int
main (void)
{
int v;
float f;
#pragma omp atomic read
v = x;
if (v != 6)
abort ();
#pragma omp atomic write
x = 17;
#pragma omp atomic read
v = x;
if (v != 17)
abort ();
#pragma omp atomic update
x++;
#pragma omp atomic read
v = x;
if (v != 18)
abort ();
#pragma omp atomic capture
v = x++;
if (v != 18)
abort ();
#pragma omp atomic read
v = x;
if (v != 19)
abort ();
#pragma omp atomic capture
v = ++x;
if (v != 20)
abort ();
#pragma omp atomic read
v = x;
if (v != 20)
abort ();
#pragma omp atomic capture
{ v = x; x *= 3; }
if (v != 20)
abort ();
#pragma omp atomic read
v = x;
if (v != 60)
abort ();
#pragma omp atomic capture
{
x |= 2;
v = x;
}
if (v != 62)
abort ();
#pragma omp atomic read
v = x;
if (v != 62)
abort ();
#pragma omp atomic capture
{ v = x; x++; }
if (v != 62)
abort ();
#pragma omp atomic capture
{ v = x; ++x; }
if (v != 63)
abort ();
#pragma omp atomic capture
{
++x;
v = x;
}
if (v != 65)
abort ();
#pragma omp atomic capture
{x++;v=x;}if (v != 66)
abort ();
#pragma omp atomic read
v = x;
if (v != 66)
abort ();
#pragma omp atomic capture
{ v = x; x--; }
if (v != 66)
abort ();
#pragma omp atomic capture
{ v = x; --x; }
if (v != 65)
abort ();
#pragma omp atomic capture
{
--x;
v = x;
}
if (v != 63)
abort ();
#pragma omp atomic capture
{ x--; v = x; } if (v != 62)
abort ();
#pragma omp atomic read
v = x;
if (v != 62)
abort ();
#pragma omp atomic write
y = 17.5f;
#pragma omp atomic read
f = y;
if (f != 17.5)
abort ();
#pragma omp atomic update
y *= 2.0f;
#pragma omp atomic read
f = y;
if (y != 35.0)
abort ();
#pragma omp atomic capture
f = y *= 2.0f;
if (f != 70.0)
abort ();
#pragma omp atomic capture
f = y++;
if (f != 70.0)
abort ();
#pragma omp atomic read
f = y;
if (f != 71.0)
abort ();
#pragma omp atomic capture
f = --y;
if (f != 70.0)
abort ();
#pragma omp atomic read
f = y;
if (f != 70.0)
abort ();
#pragma omp atomic capture
{ f = y; y /= 2.0f; }
if (f != 70.0)
abort ();
#pragma omp atomic read
f = y;
if (f != 35.0)
abort ();
#pragma omp atomic capture
{ y /= 2.0f; f = y; }
if (f != 17.5)
abort ();
#pragma omp atomic read
f = y;
if (f != 17.5)
abort ();
return 0;
}

View File

@ -0,0 +1,98 @@
/* { dg-do run } */
extern void abort (void);
_Bool v, x1, x2, x3, x4, x5, x6;
void
foo (void)
{
#pragma omp atomic capture
v = ++x1;
if (!v)
abort ();
#pragma omp atomic capture
v = x2++;
if (v)
abort ();
#pragma omp atomic capture
v = --x3;
if (v)
abort ();
#pragma omp atomic capture
v = x4--;
if (!v)
abort ();
#pragma omp atomic capture
{ v = x5; x5 |= 1; }
if (v)
abort ();
#pragma omp atomic capture
{ x6 |= 1; v = x6; }
if (!v)
abort ();
}
void
bar (void)
{
#pragma omp atomic write
x1 = 0;
#pragma omp atomic write
x2 = 0;
#pragma omp atomic write
x3 = 1;
#pragma omp atomic write
x4 = 1;
#pragma omp atomic capture
{ ++x1; v = x1; }
if (!v)
abort ();
#pragma omp atomic capture
{ v = x2; x2++; }
if (v)
abort ();
#pragma omp atomic capture
{ --x3; v = x3; }
if (v)
abort ();
#pragma omp atomic capture
{ v = x4; x4--; }
if (!v)
abort ();
#pragma omp atomic write
x1 = 0;
#pragma omp atomic write
x2 = 0;
#pragma omp atomic write
x3 = 1;
#pragma omp atomic write
x4 = 1;
#pragma omp atomic capture
{ x1++; v = x1; }
if (!v)
abort ();
#pragma omp atomic capture
{ v = x2; ++x2; }
if (v)
abort ();
#pragma omp atomic capture
{ x3--; v = x3; }
if (v)
abort ();
#pragma omp atomic capture
{ v = x4; --x4; }
if (!v)
abort ();
}
int
main ()
{
#pragma omp atomic write
x3 = 1;
#pragma omp atomic write
x4 = 1;
foo ();
bar ();
return 0;
}

View File

@ -0,0 +1,59 @@
/* { dg-do run } */
extern void abort (void);
long long l, m;
int i, j;
void
foo (void)
{
#pragma omp atomic read
i = l;
#pragma omp atomic read
m = j;
if (i != 77 || m != 88)
abort ();
#pragma omp atomic write
l = 1 + i + 6 * 1;
#pragma omp atomic write
j = 170 - 170 + m + 1 * 7;
#pragma omp atomic capture
i = l += 4;
#pragma omp atomic capture
m = j += 4;
if (i != 88 || m != 99)
abort ();
#pragma omp atomic capture
{
i = l;
l += 4;
}
#pragma omp atomic capture
{
m = j;
j += 4;
}
if (i != 88 || m != 99)
abort ();
#pragma omp atomic capture
{
l += 4;
i = l;
}
#pragma omp atomic capture
{
j += 4;
m = j;
}
if (i != 96 || m != 107)
abort ();
}
int
main ()
{
l = 77;
j = 88;
foo ();
return 0;
}

View File

@ -0,0 +1,137 @@
/* { dg-do run } */
extern void abort (void);
int x = 6, cnt;
int
foo (void)
{
return cnt++;
}
int
main ()
{
int v, *p;
#pragma omp atomic update
x = x + 7;
#pragma omp atomic
x = x + 7 + 6;
#pragma omp atomic update
x = x + 2 * 3;
#pragma omp atomic
x = x * (2 - 1);
#pragma omp atomic read
v = x;
if (v != 32)
abort ();
#pragma omp atomic write
x = 0;
#pragma omp atomic capture
{
v = x;
x = x | 1 ^ 2;
}
if (v != 0)
abort ();
#pragma omp atomic capture
{
v = x;
x = x | 4 | 2;
}
if (v != 3)
abort ();
#pragma omp atomic read
v = x;
if (v != 7)
abort ();
#pragma omp atomic capture
{
x = x ^ 6 & 2;
v = x;
}
if (v != 5)
abort ();
#pragma omp atomic capture
{ x = x - (6 + 4); v = x; }
if (v != -5)
abort ();
#pragma omp atomic capture
{ v = x; x = x - (1 | 2); }
if (v != -5)
abort ();
#pragma omp atomic read
v = x;
if (v != -8)
abort ();
#pragma omp atomic
x = x * -4 / 2;
#pragma omp atomic read
v = x;
if (v != 16)
abort ();
p = &x;
#pragma omp atomic update
p[foo (), 0] = p[foo (), 0] - 16;
#pragma omp atomic read
v = x;
if (cnt != 2 || v != 0)
abort ();
#pragma omp atomic capture
{
p[foo (), 0] += 6;
v = p[foo (), 0];
}
if (cnt != 4 || v != 6)
abort ();
#pragma omp atomic capture
{
v = p[foo (), 0];
p[foo (), 0] += 6;
}
if (cnt != 6 || v != 6)
abort ();
#pragma omp atomic read
v = x;
if (v != 12)
abort ();
#pragma omp atomic capture
{
p[foo (), 0] = p[foo (), 0] + 6;
v = p[foo (), 0];
}
if (cnt != 9 || v != 18)
abort ();
#pragma omp atomic capture
{
v = p[foo (), 0];
p[foo (), 0] = p[foo (), 0] + 6;
}
if (cnt != 12 || v != 18)
abort ();
#pragma omp atomic read
v = x;
if (v != 24)
abort ();
#pragma omp atomic capture
{ v = p[foo (), 0]; p[foo (), 0]++; }
#pragma omp atomic capture
{ v = p[foo (), 0]; ++p[foo (), 0]; }
#pragma omp atomic capture
{ p[foo (), 0]++; v = p[foo (), 0]; }
#pragma omp atomic capture
{ ++p[foo (), 0]; v = p[foo (), 0]; }
if (cnt != 20 || v != 28)
abort ();
#pragma omp atomic capture
{ v = p[foo (), 0]; p[foo (), 0]--; }
#pragma omp atomic capture
{ v = p[foo (), 0]; --p[foo (), 0]; }
#pragma omp atomic capture
{ p[foo (), 0]--; v = p[foo (), 0]; }
#pragma omp atomic capture
{ --p[foo (), 0]; v = p[foo (), 0]; }
if (cnt != 28 || v != 24)
abort ();
return 0;
}

View File

@ -0,0 +1,29 @@
/* { dg-do run } */
extern void abort (void);
int j;
float f;
int
main ()
{
j = -10000;
f = 1024.0;
int i;
#pragma omp parallel for reduction (min:f) reduction (max:j)
for (i = 0; i < 4; i++)
switch (i)
{
case 0:
if (j < -16) j = -16; break;
case 1:
if (f > -2.0) f = -2.0; break;
case 2:
if (j < 8) j = 8; if (f > 9.0) f = 9.0; break;
case 3:
break;
}
if (j != 8 || f != -2.0)
abort ();
return 0;
}

View File

@ -0,0 +1,45 @@
/* { dg-do run } */
#include <omp.h>
#include <stdlib.h>
int err;
int
main ()
{
int e;
#pragma omp parallel shared(err)
{
if (omp_in_final ())
#pragma omp atomic write
err = 1;
#pragma omp task if (0) shared(err)
{
if (omp_in_final ())
#pragma omp atomic write
err = 1;
#pragma omp task if (0) shared(err)
if (omp_in_final ())
#pragma omp atomic write
err = 1;
}
#pragma omp task final (1) shared(err)
{
if (!omp_in_final ())
#pragma omp atomic write
err = 1;
#pragma omp taskyield
#pragma omp taskwait
#pragma omp task shared(err)
if (!omp_in_final ())
#pragma omp atomic write
err = 1;
}
}
#pragma omp atomic read
e = err;
if (e)
abort ();
return 0;
}

View File

@ -0,0 +1,16 @@
! { dg-do run }
integer, allocatable :: a(:)
logical :: l
l = .false.
!$omp parallel firstprivate (a) reduction (.or.:l)
l = allocated (a)
allocate (a(10))
l = l .or. .not. allocated (a)
a = 10
if (any (a .ne. 10)) l = .true.
deallocate (a)
l = l .or. allocated (a)
!$omp end parallel
if (l) call abort
end

View File

@ -0,0 +1,14 @@
! { dg-do run }
! { dg-require-effective-target tls_runtime }
!$ use omp_lib
integer, save, allocatable :: a(:, :)
logical :: l
!$omp threadprivate (a)
if (allocated (a)) call abort
l = .false.
!$omp parallel copyin (a) num_threads (4) reduction(.or.:l)
l = l.or.allocated (a)
!$omp end parallel
if (l.or.allocated (a)) call abort
end

View File

@ -0,0 +1,36 @@
! { dg-do run }
! { dg-options "-fopenmp -fcray-pointer" }
use omp_lib
integer :: a, b, c, i, p
logical :: l
pointer (ip, p)
a = 1
b = 2
c = 3
l = .false.
ip = loc (a)
!$omp parallel num_threads (2) reduction (.or.:l) firstprivate (ip)
l = p .ne. 1
ip = loc (b)
if (omp_get_thread_num () .eq. 1) ip = loc (c)
l = l .or. (p .ne. (2 + omp_get_thread_num ()))
!$omp end parallel
if (l) call abort
l = .false.
ip = loc (a)
!$omp parallel do num_threads (2) reduction (.or.:l) &
!$omp & firstprivate (ip) lastprivate (ip)
do i = 0, 1
l = l .or. (p .ne. 1)
ip = loc (b)
if (i .eq. 1) ip = loc (c)
l = l .or. (p .ne. (2 + i))
end do
if (l) call abort
if (p .ne. 3) call abort
end

View File

@ -0,0 +1,58 @@
! { dg-do run }
integer (kind = 4) :: a, a2
integer (kind = 2) :: b, b2
real :: c, f
double precision :: d, d2, c2
integer, dimension (10) :: e
!$omp atomic write
a = 1
!$omp atomic write
b = 2
!$omp end atomic
!$omp atomic write
c = 3
!$omp atomic write
d = 1 + 2 + 3 - 2
e = 5
!$omp atomic write
f = 6
!$omp end atomic
!$omp atomic
a = a + 4
!$omp end atomic
!$omp atomic update
b = 4 - b
!$omp atomic
c = c * 2
!$omp atomic update
d = 2 / d
!$omp end atomic
!$omp atomic read
a2 = a
!$omp atomic read
b2 = b
!$omp end atomic
!$omp atomic read
c2 = c
!$omp atomic read
d2 = d
if (a2 .ne. 5 .or. b2 .ne. 2 .or. c2 .ne. 6 .or. d2 .ne. 0.5) call abort
!$omp atomic write
d = 1.2
!$omp atomic
a = a + c + d
!$omp atomic
b = b - (a + c + d)
if (a .ne. 12 .or. b .ne. -17) call abort
!$omp atomic
a = c + d + a
!$omp atomic
b = a + c + d - b
if (a .ne. 19 .or. b .ne. 43) call abort
!$omp atomic
b = (a + c + d) - b
a = 32
!$omp atomic
a = a / 3.4
if (a .ne. 9 .or. b .ne. -16) call abort
end

View File

@ -0,0 +1,37 @@
! { dg-do run }
integer (kind = 4) :: a, a2
integer (kind = 2) :: b, b2
real :: c
double precision :: d, d2, c2
integer, dimension (10) :: e
!$omp atomic write
a = 1
!$omp atomic write
b = 2
!$omp atomic write
c = 3
!$omp atomic write
d = 4
!$omp atomic capture
a2 = a
a = a + 4
!$omp end atomic
!$omp atomic capture
b = b - 18
b2 = b
!$omp end atomic
!$omp atomic capture
c2 = c
c = 2.0 * c
!$omp end atomic
!$omp atomic capture
d = d / 2.0
d2 = d
!$omp end atomic
if (a2 .ne. 1 .or. b2 .ne. -16 .or. c2 .ne. 3 .or. d2 .ne. 2) call abort
!$omp atomic read
a2 = a
!$omp atomic read
c2 = c
if (a2 .ne. 5 .or. b2 .ne. -16 .or. c2 .ne. 6 .or. d2 .ne. 2) call abort
end

View File

@ -0,0 +1,77 @@
! { dg-do run }
integer, pointer :: a, c(:)
integer, target :: b, d(10)
b = 0
a => b
d = 0
c => d
call foo (a, c)
b = 0
d = 0
call bar (a, c)
contains
subroutine foo (a, c)
integer, pointer :: a, c(:), b, d(:)
integer :: r, r2
r = 0
!$omp parallel firstprivate (a, c) reduction (+:r)
!$omp atomic
a = a + 1
!$omp atomic
c(1) = c(1) + 1
r = r + 1
!$omp end parallel
if (a.ne.r.or.c(1).ne.r) call abort
r2 = r
b => a
d => c
r = 0
!$omp parallel firstprivate (b, d) reduction (+:r)
!$omp atomic
b = b + 1
!$omp atomic
d(1) = d(1) + 1
r = r + 1
!$omp end parallel
if (b.ne.r+r2.or.d(1).ne.r+r2) call abort
end subroutine foo
subroutine bar (a, c)
integer, pointer :: a, c(:), b, d(:)
integer, target :: q, r(5)
integer :: i
q = 17
r = 21
b => a
d => c
!$omp parallel do firstprivate (a, c) lastprivate (a, c)
do i = 1, 100
!$omp atomic
a = a + 1
!$omp atomic
c((i+9)/10) = c((i+9)/10) + 1
if (i.eq.100) then
a => q
c => r
end if
end do
!$omp end parallel do
if (b.ne.100.or.any(d.ne.10)) call abort
if (a.ne.17.or.any(c.ne.21)) call abort
a => b
c => d
!$omp parallel do firstprivate (b, d) lastprivate (b, d)
do i = 1, 100
!$omp atomic
b = b + 1
!$omp atomic
d((i+9)/10) = d((i+9)/10) + 1
if (i.eq.100) then
b => q
d => r
end if
end do
!$omp end parallel do
if (a.ne.200.or.any(c.ne.20)) call abort
if (b.ne.17.or.any(d.ne.21)) call abort
end subroutine bar
end

View File

@ -0,0 +1,28 @@
! { dg-do run }
! { dg-require-effective-target tls_runtime }
integer, pointer, save :: thr(:)
!$omp threadprivate (thr)
integer, target :: s(3), t(3), u(3)
integer :: i
logical :: l
s = 2
t = 7
u = 13
thr => t
l = .false.
i = 0
!$omp parallel copyin (thr) reduction(.or.:l) reduction(+:i)
if (any (thr.ne.7)) l = .true.
thr => s
!$omp master
thr => u
!$omp end master
!$omp atomic
thr(1) = thr(1) + 1
i = i + 1
!$omp end parallel
if (l) call abort
if (thr(1).ne.14) call abort
if (s(1).ne.1+i) call abort
if (u(1).ne.14) call abort
end

View File

@ -0,0 +1,45 @@
! { dg-do run }
use omp_lib
integer :: err, e
!$omp atomic write
err = 0
!$omp parallel shared(err) private(e)
if (omp_in_final ()) then
!$omp atomic write
err = 1
endif
!$omp task if (.false.) shared(err)
if (omp_in_final ()) then
!$omp atomic write
err = 1
endif
!$omp task if (.false.) shared(err)
if (omp_in_final ()) then
!$omp atomic write
err = 1
endif
!$omp end task
!$omp end task
!$omp atomic read
e = err
!$omp task final (e .eq. 0) shared(err)
if (.not.omp_in_final ()) then
!$omp atomic write
err = 1
endif
!$omp taskyield
!$omp taskwait
!$omp task shared(err)
if (.not.omp_in_final ()) then
!$omp atomic write
err = 1
endif
!$omp end task
!$omp end task
!$omp end parallel
!$omp atomic read
e = err
if (e .ne. 0) call abort
end