re PR fortran/25162 (Issue with OpenMP COPYIN and gfortran)

gcc/fortran/
2006-02-14  Jakub Jelinek  <jakub@redhat.com>
	    Richard Henderson  <rth@redhat.com>
	    Diego Novillo  <dnovillo@redhat.com>

	* invoke.texi: Document -fopenmp.
	* gfortran.texi (Extensions): Document OpenMP.

	Backport from gomp-20050608-branch
	* trans-openmp.c: Call build_omp_clause instead of
	make_node when creating OMP_CLAUSE_* trees.
	(gfc_trans_omp_reduction_list): Remove argument 'code'.
	Adjust all callers.

	* trans.h (build4_v): Define.
	* trans-openmp.c: Call build4_v to create OMP_PARALLEL nodes.
	Call build3_v to create OMP_SECTIONS nodes.

	PR fortran/25162
	* openmp.c (gfc_match_omp_variable_list): Call gfc_set_sym_referenced
	on all symbols added to the variable list.

	* openmp.c (gfc_match_omp_clauses): Fix check for non-INTRINSIC
	procedure symbol in REDUCTION.

	* trans-openmp.c (gfc_trans_omp_array_reduction): Use gfc_add
	for MINUS_EXPR OMP_CLAUSE_REDUCTION_CODE.

	* trans-openmp.c (gfc_trans_omp_do): Add PBLOCK argument.  If PBLOCK
	is non-NULL, evaluate INIT/COND/INCR and chunk size expressions in
	that statement block.
	(gfc_trans_omp_parallel_do): Pass non-NULL PBLOCK to gfc_trans_omp_do
	for non-ordered non-static combined loops.
	(gfc_trans_omp_directive): Pass NULL PBLOCK to gfc_trans_omp_do.

	* openmp.c: Include target.h and toplev.h.
	(gfc_match_omp_threadprivate): Emit diagnostic if target does
	not support TLS.
	* Make-lang.in (fortran/openmp.o): Add dependencies on
	target.h and toplev.h.

	* trans-decl.c (gfc_get_fake_result_decl): Set GFC_DECL_RESULT.
	* trans-openmp.c (gfc_omp_privatize_by_reference): Make
	DECL_ARTIFICIAL vars predetermined shared except GFC_DECL_RESULT.
	(gfc_omp_disregard_value_expr): Handle GFC_DECL_RESULT.
	(gfc_trans_omp_variable): New function.
	(gfc_trans_omp_variable_list, gfc_trans_omp_reduction_list): Use it.
	* trans.h (GFC_DECL_RESULT): Define.

	* trans-openmp.c (gfc_omp_firstprivatize_type_sizes): New function.
	* f95-lang.c (LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES): Define.
	* trans.h (gfc_omp_firstprivatize_type_sizes): New prototype.

	* trans-openmp.c (gfc_omp_privatize_by_reference): Return
	true if a pointer has GFC_DECL_SAVED_DESCRIPTOR set.
	(gfc_trans_omp_array_reduction, gfc_trans_omp_reduction_list): New
	functions.
	(gfc_trans_omp_clauses): Add WHERE argument.  Call
	gfc_trans_omp_reduction_list rather than gfc_trans_omp_variable_list
	for reductions.
	(gfc_trans_omp_do, gfc_trans_omp_parallel, gfc_trans_omp_parallel_do,
	gfc_trans_omp_parallel_sections, gfc_trans_omp_parallel_workshare,
	gfc_trans_omp_sections, gfc_trans_omp_single): Adjust
	gfc_trans_omp_clauses callers.

	* openmp.c (omp_current_do_code): New var.
	(gfc_resolve_omp_do_blocks): New function.
	(gfc_resolve_omp_parallel_blocks): Call it.
	(gfc_resolve_do_iterator): Add CODE argument.  Don't propagate
	predetermination if argument is !$omp do or !$omp parallel do
	iteration variable.
	* resolve.c (resolve_code): Call gfc_resolve_omp_do_blocks
	for EXEC_OMP_DO.  Adjust gfc_resolve_do_iterator caller.
	* fortran.h (gfc_resolve_omp_do_blocks): New prototype.
	(gfc_resolve_do_iterator): Add CODE argument.

	* trans.h (gfc_omp_predetermined_sharing,
	gfc_omp_disregard_value_expr, gfc_omp_private_debug_clause): New
	prototypes.
	(GFC_DECL_COMMON_OR_EQUIV, GFC_DECL_CRAY_POINTEE): Define.
	* trans-openmp.c (gfc_omp_predetermined_sharing,
	gfc_omp_disregard_value_expr, gfc_omp_private_debug_clause): New
	functions.
	* trans-common.c (build_equiv_decl, build_common_decl,
	create_common): Set GFC_DECL_COMMON_OR_EQUIV flag on the decls.
	* trans-decl.c (gfc_finish_cray_pointee): Set GFC_DECL_CRAY_POINTEE
	on the decl.
	* f95-lang.c (LANG_HOOKS_OMP_PREDETERMINED_SHARING,
	LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR,
	LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE): Define.

	* openmp.c (resolve_omp_clauses): Remove extraneous comma.

	* symbol.c (check_conflict): Add conflict between cray_pointee and
	threadprivate.
	* openmp.c (gfc_match_omp_threadprivate): Fail if
	gfc_add_threadprivate returned FAILURE.
	(resolve_omp_clauses): Diagnose Cray pointees in SHARED,
	{,FIRST,LAST}PRIVATE and REDUCTION clauses and Cray pointers in
	{FIRST,LAST}PRIVATE and REDUCTION clauses.

	* resolve.c (omp_workshare_flag): New variable.
	(resolve_function): Diagnose use of non-ELEMENTAL user defined
	function in WORKSHARE construct.
	(resolve_code): Cleanup forall_save use.  Make sure omp_workshare_flag
	is set to correct value in different contexts.

	* openmp.c (resolve_omp_clauses): Replace %s with '%s' when printing
	variable name.
	(resolve_omp_atomic): Likewise.

	PR fortran/24493
	* scanner.c (skip_free_comments): Set at_bol at the beginning of the
	loop, not before it.
	(skip_fixed_comments): Handle ! comments in the middle of line here
	as well.
	(gfc_skip_comments): Use skip_fixed_comments for FIXED_FORM even if
	not at BOL.
	(gfc_next_char_literal): Fix expected canonicalized *$omp string.

	* trans-openmp.c (gfc_trans_omp_do): Use make_node and explicit
	initialization to build OMP_FOR instead of build.

	* trans-decl.c (gfc_gimplify_function): Invoke
	diagnose_omp_structured_block_errors.

	* trans-openmp.c (gfc_trans_omp_master): Use OMP_MASTER.
	(gfc_trans_omp_ordered): Use OMP_ORDERED.

	* gfortran.h (gfc_resolve_do_iterator, gfc_resolve_blocks,
	gfc_resolve_omp_parallel_blocks): New prototypes.
	* resolve.c (resolve_blocks): Renamed to...
	(gfc_resolve_blocks): ... this.  Remove static.
	(gfc_resolve_forall): Adjust caller.
	(resolve_code): Only call gfc_resolve_blocks if code->block != 0
	and not for EXEC_OMP_PARALLEL* directives.  Call
	gfc_resolve_omp_parallel_blocks for EXEC_OMP_PARALLEL* directives.
	Call gfc_resolve_do_iterator if resolved successfully EXEC_DO
	iterator.
	* openmp.c: Include pointer-set.h.
	(omp_current_ctx): New variable.
	(gfc_resolve_omp_parallel_blocks, gfc_resolve_do_iterator): New
	functions.
	* Make-lang.in (fortran/openmp.o): Depend on pointer-set.h.

	* openmp.c (gfc_match_omp_clauses): For max/min/iand/ior/ieor,
	look up symbol if it exists, use its name instead and, if it is not
	INTRINSIC, issue diagnostics.

	* parse.c (parse_omp_do): Handle implied end do properly.
	(parse_executable): If parse_omp_do returned ST_IMPLIED_ENDDO,
	return it instead of continuing.

	* trans-openmp.c (gfc_trans_omp_critical): Update for changed
	operand numbering.
	(gfc_trans_omp_do, gfc_trans_omp_parallel, gfc_trans_omp_parallel_do,
	gfc_trans_omp_parallel_sections, gfc_trans_omp_parallel_workshare,
	gfc_trans_omp_sections, gfc_trans_omp_single): Likewise.

	* trans.h (gfc_omp_privatize_by_reference): New prototype.
	* f95-lang.c (LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE): Redefine
	to gfc_omp_privatize_by_reference.
	* trans-openmp.c (gfc_omp_privatize_by_reference): New function.

	* trans-stmt.h (gfc_trans_omp_directive): Add comment.

	* openmp.c (gfc_match_omp_variable_list): Add ALLOW_COMMON argument.
	Disallow COMMON matching if it is set.
	(gfc_match_omp_clauses, gfc_match_omp_flush): Adjust all callers.
	(resolve_omp_clauses): Show locus in error messages.  Check that
	variable types in reduction clauses are appropriate for reduction
	operators.

	* resolve.c (resolve_symbol): Don't error if a threadprivate module
	variable isn't SAVEd.

	* trans-openmp.c (gfc_trans_omp_do): Put count into BLOCK, not BODY.
	Fix typo in condition.  Fix DOVAR initialization.

	* openmp.c (gfc_match_omp_clauses): Match min/iand/ior/ieor
	rather than .min. etc.

	* trans-openmpc.c (omp_not_yet): Remove.
	(gfc_trans_omp_parallel_do): Keep listprivate clause on parallel.
	Force creation of BIND_EXPR around the workshare construct.
	(gfc_trans_omp_parallel_sections): Likewise.
	(gfc_trans_omp_parallel_workshare): Likewise.

	* types.def (BT_I16, BT_FN_I16_VPTR_I16,
	BT_FN_BOOL_VPTR_I16_I16, BT_FN_I16_VPTR_I16_I16): Add.

	* trans-openmp.c (gfc_trans_omp_clauses): Create OMP_CLAUSE_DEFAULT.
	(gfc_trans_omp_code): New function.
	(gfc_trans_omp_do): Use it, remove omp_not_yet uses.
	(gfc_trans_omp_parallel, gfc_trans_omp_single): Likewise.
	(gfc_trans_omp_sections): Likewise.  Only treat empty last section
	specially if lastprivate clause is present.
	* f95-lang.c (gfc_init_builtin_functions): Create BUILT_IN_TRAP
	builtin.

	* trans-openmp.c (gfc_trans_omp_variable_list): Update for
	OMP_CLAUSE_DECL name change.
	(gfc_trans_omp_do): Likewise.

	* trans-openmp.c (gfc_trans_omp_clauses): Create OMP_CLAUSE_REDUCTION
	clauses.
	(gfc_trans_omp_atomic): Build OMP_ATOMIC instead of expanding
	sync builtins directly.
	(gfc_trans_omp_single): Build OMP_SINGLE statement.

	* trans-openmp.c (gfc_trans_add_clause): New.
	(gfc_trans_omp_variable_list): Take a tree code and build the clause
	node here.  Link it to the head of a list.
	(gfc_trans_omp_clauses): Update to match.
	(gfc_trans_omp_do): Use gfc_trans_add_clause.

	* trans-openmp.c (gfc_trans_omp_clauses): Change second argument to
	gfc_omp_clauses *.  Use gfc_evaluate_now instead of creating
	temporaries by hand.
	(gfc_trans_omp_atomic, gfc_trans_omp_critical): Use buildN_v macros.
	(gfc_trans_omp_do): New function.
	(gfc_trans_omp_master): Dont' check for gfc_trans_code returning NULL.
	(gfc_trans_omp_parallel): Adjust gfc_trans_omp_clauses caller.
	Use buildN_v macros.
	(gfc_trans_omp_parallel_do, gfc_trans_omp_parallel_sections,
	gfc_trans_omp_parallel_workshare, gfc_trans_omp_sections,
	gfc_trans_omp_single, gfc_trans_omp_workshare): New functions.
	(gfc_trans_omp_directive): Use them.
	* parse.c (parse_omp_do): Allow new_st.op == EXEC_NOP.
	* openmp.c (resolve_omp_clauses): Check for list items present
	in multiple clauses.
	(resolve_omp_do): Check that iteration variable is not THREADPRIVATE
	and is not present in any clause variable lists other than PRIVATE
	or LASTPRIVATE.

	* gfortran.h (symbol_attribute): Add threadprivate bit.
	(gfc_common_head): Add threadprivate member, change use_assoc
	and saved into char to save space.
	(gfc_add_threadprivate): New prototype.
	* symbol.c (check_conflict): Handle threadprivate.
	(gfc_add_threadprivate): New function.
	(gfc_copy_attr): Copy threadprivate.
	* trans-openmp.c (gfc_trans_omp_clauses): Avoid creating a temporary
	if IF or NUM_THREADS is constant.  Create OMP_CLAUSE_SCHEDULE and
	OMP_CLAUSE_ORDERED.
	* resolve.c (resolve_symbol): Complain if a THREADPRIVATE symbol
	outside a module and not in COMMON has is not SAVEd.
	(resolve_equivalence): Ensure THREADPRIVATE objects don't get
	EQUIVALENCEd.
	* trans-common.c: Include target.h and rtl.h.
	(build_common_decl): Set DECL_TLS_MODEL if THREADPRIVATE.
	* trans-decl.c: Include rtl.h.
	(gfc_finish_var_decl): Set DECL_TLS_MODEL if THREADPRIVATE.
	* dump-parse-tree.c (gfc_show_attr): Handle THREADPRIVATE.
	* Make-lang.in (fortran/trans-decl.o): Depend on $(RTL_H).
	(fortran/trans-common.o): Depend on $(RTL_H) and $(TARGET_H).
	* openmp.c (gfc_match_omp_variable_list): Ensure COMMON block
	is from current namespace.
	(gfc_match_omp_threadprivate): Rewrite.
	(resolve_omp_clauses): Check some clause restrictions.
	* module.c (ab_attribute): Add AB_THREADPRIVATE.
	(attr_bits): Add THREADPRIVATE.
	(mio_symbol_attribute, mio_symbol_attribute): Handle threadprivate.
	(load_commons, write_common, write_blank_common): Adjust for type
	change of saved, store/load threadprivate bit from the integer
	as well.

	* types.def (BT_FN_UINT_UINT): New.
	(BT_FN_VOID_UINT_UINT): Remove.

	* trans-openmp.c (gfc_trans_omp_clauses, gfc_trans_omp_barrier,
	gfc_trans_omp_critical, gfc_trans_omp_flush, gfc_trans_omp_master,
	gfc_trans_omp_ordered, gfc_trans_omp_parallel): New functions.
	(gfc_trans_omp_directive): Use them.

	* openmp.c (expr_references_sym): Add SE argument, don't look
	into SE tree.
	(is_conversion): New function.
	(resolve_omp_atomic): Adjust expr_references_sym callers.  Handle
	promoted expressions.
	* trans-openmp.c (gfc_trans_omp_atomic): New function.
	(gfc_trans_omp_directive): Call it.

	* f95-lang.c (builtin_type_for_size): New function.
	(gfc_init_builtin_functions): Initialize synchronization and
	OpenMP builtins.
	* types.def: New file.
	* Make-lang.in (f95-lang.o): Depend on $(BUILTINS_DEF) and
	fortran/types.def.

	* trans-openmp.c: Rename GOMP_* tree codes into OMP_*.

	* dump-parse-tree.c (show_symtree): Don't crash if ns->proc_name
	is NULL.

	* dump-parse-tree.c (gfc_show_namelist, gfc_show_omp_node): New
	functions.
	(gfc_show_code_node): Call gfc_show_omp_node for EXEC_OMP_* nodes.

	* parse.c (parse_omp_do): Call pop_state before next_statement.
	* openmp.c (expr_references_sym, resolve_omp_atomic, resolve_omp_do):
	New functions.
	(gfc_resolve_omp_directive): Call them.
	* match.c (match_exit_cycle): Issue error if EXIT or CYCLE statement
	leaves an OpenMP structured block or if EXIT terminates !$omp do
	loop.

	* Make-lang.in (F95_PARSER_OBJS): Add fortran/openmp.o.
	(F95_OBJS): Add fortran/trans-openmp.o.
	(fortran/trans-openmp.o): Depend on $(GFORTRAN_TRANS_DEPS).
	* lang.opt: Add -fopenmp option.
	* options.c (gfc_init_options): Initialize it.
	(gfc_handle_option): Handle it.
	* gfortran.h (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_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): New
	statement codes.
	(OMP_LIST_PRIVATE, OMP_LIST_FIRSTPRIVATE, OMP_LIST_LASTPRIVATE,
	OMP_LIST_COPYPRIVATE, OMP_LIST_SHARED, OMP_LIST_COPYIN,
	OMP_LIST_PLUS, OMP_LIST_REDUCTION_FIRST, OMP_LIST_MULT,
	OMP_LIST_SUB, OMP_LIST_AND, OMP_LIST_OR, OMP_LIST_EQV,
	OMP_LIST_NEQV, OMP_LIST_MAX, OMP_LIST_MIN, OMP_LIST_IAND,
	OMP_LIST_IOR, OMP_LIST_IEOR, OMP_LIST_REDUCTION_LAST, OMP_LIST_NUM):
	New OpenMP variable list types.
	(gfc_omp_clauses): New typedef.
	(gfc_get_omp_clauses): Define.
	(EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
	EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
	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): New OpenMP gfc_exec_op codes.
	(struct gfc_code): Add omp_clauses, omp_name, omp_namelist
	and omp_bool fields to ext union.
	(flag_openmp): Declare.
	(gfc_free_omp_clauses, gfc_resolve_omp_directive): New prototypes.
	* scanner.c (openmp_flag, openmp_locus): New variables.
	(skip_free_comments, skip_fixed_comments, gfc_next_char_literal):
	Handle OpenMP directive lines and conditional compilation magic
	comments.
	* parse.h (COMP_OMP_STRUCTURED_BLOCK): New compile state.
	* parse.c (decode_omp_directive, parse_omp_do, parse_omp_atomic,
	parse_omp_structured_block): New functions.
	(next_free, next_fixed): Parse OpenMP directives.
	(case_executable, case_exec_markers, case_decl): Add ST_OMP_*
	codes.
	(gfc_ascii_statement): Handle ST_OMP_* codes.
	(parse_executable): Rearrange the loop slightly, so that
	parse_omp_do can return next_statement.
	* match.h (gfc_match_omp_eos, gfc_match_omp_atomic,
	gfc_match_omp_barrier, gfc_match_omp_critical, gfc_match_omp_do,
	gfc_match_omp_flush, gfc_match_omp_master, gfc_match_omp_ordered,
	gfc_match_omp_parallel, gfc_match_omp_parallel_do,
	gfc_match_omp_parallel_sections, gfc_match_omp_parallel_workshare,
	gfc_match_omp_sections, gfc_match_omp_single,
	gfc_match_omp_threadprivate, gfc_match_omp_workshare,
	gfc_match_omp_end_nowait, gfc_match_omp_end_single): New prototypes.
	* resolve.c (resolve_blocks): Ignore EXEC_OMP_* block directives.
	(resolve_code): Call gfc_resolve_omp_directive on EXEC_OMP_*
	directives.
	* trans.c (gfc_trans_code): Call gfc_trans_omp_directive for
	EXEC_OMP_* directives.
	* st.c (gfc_free_statement): Handle EXEC_OMP_* statement freeing.
	* trans-stmt.h (gfc_trans_omp_directive): New prototype.
	* openmp.c: New file.
	* trans-openmp.c: New file.

gcc/testsuite/
2006-02-14  Jakub Jelinek  <jakub@redhat.com>
	    Diego Novillo  <dnovillo@redhat.com>
	    Uros Bizjak  <uros@kss-loka.si>

	* gfortran.dg/gomp: New directory.

libgomp/
2006-02-14  Jakub Jelinek  <jakub@redhat.com>

	* testsuite/libgomp.fortran/vla7.f90: Add -w to options.
	Remove tests for returning assumed character length arrays.

Co-Authored-By: Diego Novillo <dnovillo@redhat.com>
Co-Authored-By: Richard Henderson <rth@redhat.com>
Co-Authored-By: Uros Bizjak <uros@kss-loka.si>

From-SVN: r110984

1 files changed, 1203 insertions, 0 deletions

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
new file mode 100644
index 0000000..44be1b7
--- /dev/null
+++ b/gcc/fortran/trans-openmp.c
@@ -0,0 +1,1203 @@
+/* OpenMP directive translation -- generate GCC trees from gfc_code.
+   Copyright (C) 2005, 2006 Free Software Foundation, Inc.
+   Contributed by Jakub Jelinek <jakub@redhat.com>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to the Free
+Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.  */
+
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "tree-gimple.h"
+#include "ggc.h"
+#include "toplev.h"
+#include "real.h"
+#include "gfortran.h"
+#include "trans.h"
+#include "trans-stmt.h"
+#include "trans-types.h"
+#include "trans-array.h"
+#include "trans-const.h"
+#include "arith.h"
+
+
+/* True if OpenMP should privatize what this DECL points to rather
+   than the DECL itself.  */
+
+bool
+gfc_omp_privatize_by_reference (tree decl)
+{
+  tree type = TREE_TYPE (decl);
+
+  if (TREE_CODE (type) == REFERENCE_TYPE)
+    return true;
+
+  if (TREE_CODE (type) == POINTER_TYPE)
+    {
+      /* POINTER/ALLOCATABLE have aggregate types, all user variables
+	 that have POINTER_TYPE type are supposed to be privatized
+	 by reference.  */
+      if (!DECL_ARTIFICIAL (decl))
+	return true;
+
+      /* Some arrays are expanded as DECL_ARTIFICIAL pointers
+	 by the frontend.  */
+      if (DECL_LANG_SPECIFIC (decl)
+	  && GFC_DECL_SAVED_DESCRIPTOR (decl))
+	return true;
+    }
+
+  return false;
+}
+
+/* True if OpenMP sharing attribute of DECL is predetermined.  */
+
+enum omp_clause_default_kind
+gfc_omp_predetermined_sharing (tree decl)
+{
+  if (DECL_ARTIFICIAL (decl) && ! GFC_DECL_RESULT (decl))
+    return OMP_CLAUSE_DEFAULT_SHARED;
+
+  /* Cray pointees shouldn't be listed in any clauses and should be
+     gimplified to dereference of the corresponding Cray pointer.
+     Make them all private, so that they are emitted in the debug
+     information.  */
+  if (GFC_DECL_CRAY_POINTEE (decl))
+    return OMP_CLAUSE_DEFAULT_PRIVATE;
+
+  /* COMMON and EQUIVALENCE decls are shared.  They
+     are only referenced through DECL_VALUE_EXPR of the variables
+     contained in them.  If those are privatized, they will not be
+     gimplified to the COMMON or EQUIVALENCE decls.  */
+  if (GFC_DECL_COMMON_OR_EQUIV (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
+    return OMP_CLAUSE_DEFAULT_SHARED;
+
+  if (GFC_DECL_RESULT (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
+    return OMP_CLAUSE_DEFAULT_SHARED;
+
+  return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
+}
+
+/* Return true if DECL's DECL_VALUE_EXPR (if any) should be
+   disregarded in OpenMP construct, because it is going to be
+   remapped during OpenMP lowering.  SHARED is true if DECL
+   is going to be shared, false if it is going to be privatized.  */
+
+bool
+gfc_omp_disregard_value_expr (tree decl, bool shared)
+{
+  if (GFC_DECL_COMMON_OR_EQUIV (decl)
+      && DECL_HAS_VALUE_EXPR_P (decl))
+    {
+      tree value = DECL_VALUE_EXPR (decl);
+
+      if (TREE_CODE (value) == COMPONENT_REF
+	  && TREE_CODE (TREE_OPERAND (value, 0)) == VAR_DECL
+	  && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
+	{
+	  /* If variable in COMMON or EQUIVALENCE is privatized, return
+	     true, as just that variable is supposed to be privatized,
+	     not the whole COMMON or whole EQUIVALENCE.
+	     For shared variables in COMMON or EQUIVALENCE, let them be
+	     gimplified to DECL_VALUE_EXPR, so that for multiple shared vars
+	     from the same COMMON or EQUIVALENCE just one sharing of the
+	     whole COMMON or EQUIVALENCE is enough.  */
+	  return ! shared;
+	}
+    }
+
+  if (GFC_DECL_RESULT (decl) && DECL_HAS_VALUE_EXPR_P (decl))
+    return ! shared;
+
+  return false;
+}
+
+/* Return true if DECL that is shared iff SHARED is true should
+   be put into OMP_CLAUSE_PRIVATE with OMP_CLAUSE_PRIVATE_DEBUG
+   flag set.  */
+
+bool
+gfc_omp_private_debug_clause (tree decl, bool shared)
+{
+  if (GFC_DECL_CRAY_POINTEE (decl))
+    return true;
+
+  if (GFC_DECL_COMMON_OR_EQUIV (decl)
+      && DECL_HAS_VALUE_EXPR_P (decl))
+    {
+      tree value = DECL_VALUE_EXPR (decl);
+
+      if (TREE_CODE (value) == COMPONENT_REF
+	  && TREE_CODE (TREE_OPERAND (value, 0)) == VAR_DECL
+	  && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
+	return shared;
+    }
+
+  return false;
+}
+
+/* Register language specific type size variables as potentially OpenMP
+   firstprivate variables.  */
+
+void
+gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *ctx, tree type)
+{
+  if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
+    {
+      int r;
+
+      gcc_assert (TYPE_LANG_SPECIFIC (type) != NULL);
+      for (r = 0; r < GFC_TYPE_ARRAY_RANK (type); r++)
+	{
+	  omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_LBOUND (type, r));
+	  omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_UBOUND (type, r));
+	  omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_STRIDE (type, r));
+	}
+      omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SIZE (type));
+      omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_OFFSET (type));
+    }
+}
+
+
+static inline tree
+gfc_trans_add_clause (tree node, tree tail)
+{
+  OMP_CLAUSE_CHAIN (node) = tail;
+  return node;
+}
+
+static tree
+gfc_trans_omp_variable (gfc_symbol *sym)
+{
+  tree t = gfc_get_symbol_decl (sym);
+
+  /* Special case for assigning the return value of a function.
+     Self recursive functions must have an explicit return value.  */
+  if (t == current_function_decl && sym->attr.function
+      && (sym->result == sym))
+    t = gfc_get_fake_result_decl (sym);
+
+  /* Similarly for alternate entry points.  */
+  else if (sym->attr.function && sym->attr.entry
+	   && (sym->result == sym)
+	   && sym->ns->proc_name->backend_decl == current_function_decl)
+    {
+      gfc_entry_list *el = NULL;
+
+      for (el = sym->ns->entries; el; el = el->next)
+	if (sym == el->sym)
+	  {
+	    t = gfc_get_fake_result_decl (sym);
+	    break;
+	  }
+    }
+
+  else if (sym->attr.result
+	   && sym->ns->proc_name->backend_decl == current_function_decl
+	   && sym->ns->proc_name->attr.entry_master
+	   && !gfc_return_by_reference (sym->ns->proc_name))
+    t = gfc_get_fake_result_decl (sym);
+
+  return t;
+}
+
+static tree
+gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist,
+			     tree list)
+{
+  for (; namelist != NULL; namelist = namelist->next)
+    if (namelist->sym->attr.referenced)
+      {
+	tree t = gfc_trans_omp_variable (namelist->sym);
+	if (t != error_mark_node)
+	  {
+	    tree node = build_omp_clause (code);
+	    OMP_CLAUSE_DECL (node) = t;
+	    list = gfc_trans_add_clause (node, list);
+	  }
+      }
+  return list;
+}
+
+static void
+gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
+{
+  gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
+  gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL;
+  gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
+  gfc_expr *e1, *e2, *e3, *e4;
+  gfc_ref *ref;
+  tree decl, backend_decl;
+  locus old_loc = gfc_current_locus;
+  const char *iname;
+  try t;
+
+  decl = OMP_CLAUSE_DECL (c);
+  gfc_current_locus = where;
+
+  /* Create a fake symbol for init value.  */
+  memset (&init_val_sym, 0, sizeof (init_val_sym));
+  init_val_sym.ns = sym->ns;
+  init_val_sym.name = sym->name;
+  init_val_sym.ts = sym->ts;
+  init_val_sym.attr.referenced = 1;
+  init_val_sym.declared_at = where;
+  backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
+  init_val_sym.backend_decl = backend_decl;
+
+  /* Create a fake symbol for the outer array reference.  */
+  outer_sym = *sym;
+  outer_sym.as = gfc_copy_array_spec (sym->as);
+  outer_sym.attr.dummy = 0;
+  outer_sym.attr.result = 0;
+  outer_sym.backend_decl = create_tmp_var_raw (TREE_TYPE (decl), NULL);
+
+  /* Create fake symtrees for it.  */
+  symtree1 = gfc_new_symtree (&root1, sym->name);
+  symtree1->n.sym = sym;
+  gcc_assert (symtree1 == root1);
+
+  symtree2 = gfc_new_symtree (&root2, sym->name);
+  symtree2->n.sym = &init_val_sym;
+  gcc_assert (symtree2 == root2);
+
+  symtree3 = gfc_new_symtree (&root3, sym->name);
+  symtree3->n.sym = &outer_sym;
+  gcc_assert (symtree3 == root3);
+
+  /* Create expressions.  */
+  e1 = gfc_get_expr ();
+  e1->expr_type = EXPR_VARIABLE;
+  e1->where = where;
+  e1->symtree = symtree1;
+  e1->ts = sym->ts;
+  e1->ref = ref = gfc_get_ref ();
+  ref->u.ar.where = where;
+  ref->u.ar.as = sym->as;
+  ref->u.ar.type = AR_FULL;
+  ref->u.ar.dimen = 0;
+  t = gfc_resolve_expr (e1);
+  gcc_assert (t == SUCCESS);
+
+  e2 = gfc_get_expr ();
+  e2->expr_type = EXPR_VARIABLE;
+  e2->where = where;
+  e2->symtree = symtree2;
+  e2->ts = sym->ts;
+  t = gfc_resolve_expr (e2);
+  gcc_assert (t == SUCCESS);
+
+  e3 = gfc_copy_expr (e1);
+  e3->symtree = symtree3;
+  t = gfc_resolve_expr (e3);
+  gcc_assert (t == SUCCESS);
+
+  iname = NULL;
+  switch (OMP_CLAUSE_REDUCTION_CODE (c))
+    {
+    case PLUS_EXPR:
+    case MINUS_EXPR:
+      e4 = gfc_add (e3, e1);
+      break;
+    case MULT_EXPR:
+      e4 = gfc_multiply (e3, e1);
+      break;
+    case TRUTH_ANDIF_EXPR:
+      e4 = gfc_and (e3, e1);
+      break;
+    case TRUTH_ORIF_EXPR:
+      e4 = gfc_or (e3, e1);
+      break;
+    case EQ_EXPR:
+      e4 = gfc_eqv (e3, e1);
+      break;
+    case NE_EXPR:
+      e4 = gfc_neqv (e3, e1);
+      break;
+    case MIN_EXPR:
+      iname = "min";
+      break;
+    case MAX_EXPR:
+      iname = "max";
+      break;
+    case BIT_AND_EXPR:
+      iname = "iand";
+      break;
+    case BIT_IOR_EXPR:
+      iname = "ior";
+      break;
+    case BIT_XOR_EXPR:
+      iname = "ieor";
+      break;
+    default:
+      gcc_unreachable ();
+    }
+  if (iname != NULL)
+    {
+      memset (&intrinsic_sym, 0, sizeof (intrinsic_sym));
+      intrinsic_sym.ns = sym->ns;
+      intrinsic_sym.name = iname;
+      intrinsic_sym.ts = sym->ts;
+      intrinsic_sym.attr.referenced = 1;
+      intrinsic_sym.attr.intrinsic = 1;
+      intrinsic_sym.attr.function = 1;
+      intrinsic_sym.result = &intrinsic_sym;
+      intrinsic_sym.declared_at = where;
+
+      symtree4 = gfc_new_symtree (&root4, iname);
+      symtree4->n.sym = &intrinsic_sym;
+      gcc_assert (symtree4 == root4);
+
+      e4 = gfc_get_expr ();
+      e4->expr_type = EXPR_FUNCTION;
+      e4->where = where;
+      e4->symtree = symtree4;
+      e4->value.function.isym = gfc_find_function (iname);
+      e4->value.function.actual = gfc_get_actual_arglist ();
+      e4->value.function.actual->expr = e3;
+      e4->value.function.actual->next = gfc_get_actual_arglist ();
+      e4->value.function.actual->next->expr = e1;
+    }
+  /* e1 and e3 have been stored as arguments of e4, avoid sharing.  */
+  e1 = gfc_copy_expr (e1);
+  e3 = gfc_copy_expr (e3);
+  t = gfc_resolve_expr (e4);
+  gcc_assert (t == SUCCESS);
+
+  /* Create the init statement list.  */
+  OMP_CLAUSE_REDUCTION_INIT (c) = gfc_trans_assignment (e1, e2);
+
+  /* Create the merge statement list.  */
+  OMP_CLAUSE_REDUCTION_MERGE (c) = gfc_trans_assignment (e3, e4);
+
+  /* And stick the placeholder VAR_DECL into the clause as well.  */
+  OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_sym.backend_decl;
+
+  gfc_current_locus = old_loc;
+
+  gfc_free_expr (e1);
+  gfc_free_expr (e2);
+  gfc_free_expr (e3);
+  gfc_free_expr (e4);
+  gfc_free (symtree1);
+  gfc_free (symtree2);
+  gfc_free (symtree3);
+  if (symtree4)
+    gfc_free (symtree4);
+  gfc_free_array_spec (outer_sym.as);
+}
+
+static tree
+gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list, 
+                              enum tree_code reduction_code, locus where)
+{
+  for (; namelist != NULL; namelist = namelist->next)
+    if (namelist->sym->attr.referenced)
+      {
+	tree t = gfc_trans_omp_variable (namelist->sym);
+	if (t != error_mark_node)
+	  {
+	    tree node = build_omp_clause (OMP_CLAUSE_REDUCTION);
+	    OMP_CLAUSE_DECL (node) = t;
+	    OMP_CLAUSE_REDUCTION_CODE (node) = reduction_code;
+	    if (namelist->sym->attr.dimension)
+	      gfc_trans_omp_array_reduction (node, namelist->sym, where);
+	    list = gfc_trans_add_clause (node, list);
+	  }
+      }
+  return list;
+}
+
+static tree
+gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
+		       locus where)
+{
+  tree omp_clauses = NULL_TREE, chunk_size, c, old_clauses;
+  int list;
+  enum omp_clause_code clause_code;
+  gfc_se se;
+
+  if (clauses == NULL)
+    return NULL_TREE;
+
+  for (list = 0; list < OMP_LIST_NUM; list++)
+    {
+      gfc_namelist *n = clauses->lists[list];
+
+      if (n == NULL)
+	continue;
+      if (list >= OMP_LIST_REDUCTION_FIRST
+	  && list <= OMP_LIST_REDUCTION_LAST)
+	{
+	  enum tree_code reduction_code;
+	  switch (list)
+	    {
+	    case OMP_LIST_PLUS:
+	      reduction_code = PLUS_EXPR;
+	      break;
+	    case OMP_LIST_MULT:
+	      reduction_code = MULT_EXPR;
+	      break;
+	    case OMP_LIST_SUB:
+	      reduction_code = MINUS_EXPR;
+	      break;
+	    case OMP_LIST_AND:
+	      reduction_code = TRUTH_ANDIF_EXPR;
+	      break;
+	    case OMP_LIST_OR:
+	      reduction_code = TRUTH_ORIF_EXPR;
+	      break;
+	    case OMP_LIST_EQV:
+	      reduction_code = EQ_EXPR;
+	      break;
+	    case OMP_LIST_NEQV:
+	      reduction_code = NE_EXPR;
+	      break;
+	    case OMP_LIST_MAX:
+	      reduction_code = MAX_EXPR;
+	      break;
+	    case OMP_LIST_MIN:
+	      reduction_code = MIN_EXPR;
+	      break;
+	    case OMP_LIST_IAND:
+	      reduction_code = BIT_AND_EXPR;
+	      break;
+	    case OMP_LIST_IOR:
+	      reduction_code = BIT_IOR_EXPR;
+	      break;
+	    case OMP_LIST_IEOR:
+	      reduction_code = BIT_XOR_EXPR;
+	      break;
+	    default:
+	      gcc_unreachable ();
+	    }
+	  old_clauses = omp_clauses;
+	  omp_clauses
+	    = gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code,
+					    where);
+	  continue;
+	}
+      switch (list)
+	{
+	case OMP_LIST_PRIVATE:
+	  clause_code = OMP_CLAUSE_PRIVATE;
+	  goto add_clause;
+	case OMP_LIST_SHARED:
+	  clause_code = OMP_CLAUSE_SHARED;
+	  goto add_clause;
+	case OMP_LIST_FIRSTPRIVATE:
+	  clause_code = OMP_CLAUSE_FIRSTPRIVATE;
+	  goto add_clause;
+	case OMP_LIST_LASTPRIVATE:
+	  clause_code = OMP_CLAUSE_LASTPRIVATE;
+	  goto add_clause;
+	case OMP_LIST_COPYIN:
+	  clause_code = OMP_CLAUSE_COPYIN;
+	  goto add_clause;
+	case OMP_LIST_COPYPRIVATE:
+	  clause_code = OMP_CLAUSE_COPYPRIVATE;
+	  /* FALLTHROUGH */
+	add_clause:
+	  omp_clauses
+	    = gfc_trans_omp_variable_list (clause_code, n, omp_clauses);
+	  break;
+	default:
+	  break;
+	}
+    }
+
+  if (clauses->if_expr)
+    {
+      tree if_var;
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr (&se, clauses->if_expr);
+      gfc_add_block_to_block (block, &se.pre);
+      if_var = gfc_evaluate_now (se.expr, block);
+      gfc_add_block_to_block (block, &se.post);
+
+      c = build_omp_clause (OMP_CLAUSE_IF);
+      OMP_CLAUSE_IF_EXPR (c) = if_var;
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->num_threads)
+    {
+      tree num_threads;
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr (&se, clauses->num_threads);
+      gfc_add_block_to_block (block, &se.pre);
+      num_threads = gfc_evaluate_now (se.expr, block);
+      gfc_add_block_to_block (block, &se.post);
+
+      c = build_omp_clause (OMP_CLAUSE_NUM_THREADS);
+      OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  chunk_size = NULL_TREE;
+  if (clauses->chunk_size)
+    {
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr (&se, clauses->chunk_size);
+      gfc_add_block_to_block (block, &se.pre);
+      chunk_size = gfc_evaluate_now (se.expr, block);
+      gfc_add_block_to_block (block, &se.post);
+    }
+
+  if (clauses->sched_kind != OMP_SCHED_NONE)
+    {
+      c = build_omp_clause (OMP_CLAUSE_SCHEDULE);
+      OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
+      switch (clauses->sched_kind)
+	{
+	case OMP_SCHED_STATIC:
+	  OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC;
+	  break;
+	case OMP_SCHED_DYNAMIC:
+	  OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC;
+	  break;
+	case OMP_SCHED_GUIDED:
+	  OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED;
+	  break;
+	case OMP_SCHED_RUNTIME:
+	  OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
+    {
+      c = build_omp_clause (OMP_CLAUSE_DEFAULT);
+      switch (clauses->default_sharing)
+	{
+	case OMP_DEFAULT_NONE:
+	  OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE;
+	  break;
+	case OMP_DEFAULT_SHARED:
+	  OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED;
+	  break;
+	case OMP_DEFAULT_PRIVATE:
+	  OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->nowait)
+    {
+      c = build_omp_clause (OMP_CLAUSE_NOWAIT);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->ordered)
+    {
+      c = build_omp_clause (OMP_CLAUSE_ORDERED);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  return omp_clauses;
+}
+
+/* Like gfc_trans_code, but force creation of a BIND_EXPR around it.  */
+
+static tree
+gfc_trans_omp_code (gfc_code *code, bool force_empty)
+{
+  tree stmt;
+
+  pushlevel (0);
+  stmt = gfc_trans_code (code);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    {
+      if (!IS_EMPTY_STMT (stmt) || force_empty)
+	{
+	  tree block = poplevel (1, 0, 0);
+	  stmt = build3_v (BIND_EXPR, NULL, stmt, block);
+	}
+      else
+	poplevel (0, 0, 0);
+    }
+  else
+    poplevel (0, 0, 0);
+  return stmt;
+}
+
+
+static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
+static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
+
+static tree
+gfc_trans_omp_atomic (gfc_code *code)
+{
+  gfc_se lse;
+  gfc_se rse;
+  gfc_expr *expr2, *e;
+  gfc_symbol *var;
+  stmtblock_t block;
+  tree lhsaddr, type, rhs, x;
+  enum tree_code op = ERROR_MARK;
+  bool var_on_left = false;
+
+  code = code->block->next;
+  gcc_assert (code->op == EXEC_ASSIGN);
+  gcc_assert (code->next == NULL);
+  var = code->expr->symtree->n.sym;
+
+  gfc_init_se (&lse, NULL);
+  gfc_init_se (&rse, NULL);
+  gfc_start_block (&block);
+
+  gfc_conv_expr (&lse, code->expr);
+  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->generic_id == GFC_ISYM_CONVERSION)
+    expr2 = expr2->value.function.actual->expr;
+
+  if (expr2->expr_type == EXPR_OP)
+    {
+      gfc_expr *e;
+      switch (expr2->value.op.operator)
+	{
+	case INTRINSIC_PLUS:
+	  op = PLUS_EXPR;
+	  break;
+	case INTRINSIC_TIMES:
+	  op = MULT_EXPR;
+	  break;
+	case INTRINSIC_MINUS:
+	  op = MINUS_EXPR;
+	  break;
+	case INTRINSIC_DIVIDE:
+	  if (expr2->ts.type == BT_INTEGER)
+	    op = TRUNC_DIV_EXPR;
+	  else
+	    op = RDIV_EXPR;
+	  break;
+	case INTRINSIC_AND:
+	  op = TRUTH_ANDIF_EXPR;
+	  break;
+	case INTRINSIC_OR:
+	  op = TRUTH_ORIF_EXPR;
+	  break;
+	case INTRINSIC_EQV:
+	  op = EQ_EXPR;
+	  break;
+	case INTRINSIC_NEQV:
+	  op = NE_EXPR;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      e = expr2->value.op.op1;
+      if (e->expr_type == EXPR_FUNCTION
+	  && e->value.function.isym->generic_id == GFC_ISYM_CONVERSION)
+	e = e->value.function.actual->expr;
+      if (e->expr_type == EXPR_VARIABLE
+	  && e->symtree != NULL
+	  && e->symtree->n.sym == var)
+	{
+	  expr2 = expr2->value.op.op2;
+	  var_on_left = true;
+	}
+      else
+	{
+	  e = expr2->value.op.op2;
+	  if (e->expr_type == EXPR_FUNCTION
+	      && e->value.function.isym->generic_id == GFC_ISYM_CONVERSION)
+	    e = e->value.function.actual->expr;
+	  gcc_assert (e->expr_type == EXPR_VARIABLE
+		      && e->symtree != NULL
+		      && e->symtree->n.sym == var);
+	  expr2 = expr2->value.op.op1;
+	  var_on_left = false;
+	}
+      gfc_conv_expr (&rse, expr2);
+      gfc_add_block_to_block (&block, &rse.pre);
+    }
+  else
+    {
+      gcc_assert (expr2->expr_type == EXPR_FUNCTION);
+      switch (expr2->value.function.isym->generic_id)
+	{
+	case GFC_ISYM_MIN:
+	  op = MIN_EXPR;
+	  break;
+	case GFC_ISYM_MAX:
+	  op = MAX_EXPR;
+	  break;
+	case GFC_ISYM_IAND:
+	  op = BIT_AND_EXPR;
+	  break;
+	case GFC_ISYM_IOR:
+	  op = BIT_IOR_EXPR;
+	  break;
+	case GFC_ISYM_IEOR:
+	  op = BIT_XOR_EXPR;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      e = expr2->value.function.actual->expr;
+      gcc_assert (e->expr_type == EXPR_VARIABLE
+		  && e->symtree != NULL
+		  && e->symtree->n.sym == var);
+
+      gfc_conv_expr (&rse, expr2->value.function.actual->next->expr);
+      gfc_add_block_to_block (&block, &rse.pre);
+      if (expr2->value.function.actual->next->next != NULL)
+	{
+	  tree accum = gfc_create_var (TREE_TYPE (rse.expr), NULL);
+	  gfc_actual_arglist *arg;
+
+	  gfc_add_modify_expr (&block, accum, rse.expr);
+	  for (arg = expr2->value.function.actual->next->next; arg;
+	       arg = arg->next)
+	    {
+	      gfc_init_block (&rse.pre);
+	      gfc_conv_expr (&rse, arg->expr);
+	      gfc_add_block_to_block (&block, &rse.pre);
+	      x = fold_build2 (op, TREE_TYPE (accum), accum, rse.expr);
+	      gfc_add_modify_expr (&block, accum, x);
+	    }
+
+	  rse.expr = accum;
+	}
+
+      expr2 = expr2->value.function.actual->next->expr;
+    }
+
+  lhsaddr = save_expr (lhsaddr);
+  rhs = gfc_evaluate_now (rse.expr, &block);
+  x = convert (TREE_TYPE (rhs), build_fold_indirect_ref (lhsaddr));
+
+  if (var_on_left)
+    x = fold_build2 (op, TREE_TYPE (rhs), x, rhs);
+  else
+    x = fold_build2 (op, TREE_TYPE (rhs), rhs, x);
+
+  if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
+      && TREE_CODE (type) != COMPLEX_TYPE)
+    x = build1 (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);
+
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_barrier (void)
+{
+  tree decl = built_in_decls [BUILT_IN_GOMP_BARRIER];
+  return build_function_call_expr (decl, NULL);
+}
+
+static tree
+gfc_trans_omp_critical (gfc_code *code)
+{
+  tree name = NULL_TREE, stmt;
+  if (code->ext.omp_name != NULL)
+    name = get_identifier (code->ext.omp_name);
+  stmt = gfc_trans_code (code->block->next);
+  return build2_v (OMP_CRITICAL, stmt, name);
+}
+
+static tree
+gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
+		  gfc_omp_clauses *clauses)
+{
+  gfc_se se;
+  tree dovar, stmt, from, to, step, type, init, cond, incr;
+  tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
+  stmtblock_t block;
+  stmtblock_t body;
+  int simple = 0;
+  bool dovar_found = false;
+
+  code = code->block->next;
+  gcc_assert (code->op == EXEC_DO);
+
+  if (pblock == NULL)
+    {
+      gfc_start_block (&block);
+      pblock = &block;
+    }
+
+  omp_clauses = gfc_trans_omp_clauses (pblock, clauses, code->loc);
+  if (clauses)
+    {
+      gfc_namelist *n;
+      for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL; n = n->next)
+	if (code->ext.iterator->var->symtree->n.sym == n->sym)
+	  break;
+      if (n == NULL)
+	for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
+	  if (code->ext.iterator->var->symtree->n.sym == n->sym)
+	    break;
+      if (n != NULL)
+	dovar_found = true;
+    }
+
+  /* Evaluate all the expressions in the iterator.  */
+  gfc_init_se (&se, NULL);
+  gfc_conv_expr_lhs (&se, code->ext.iterator->var);
+  gfc_add_block_to_block (pblock, &se.pre);
+  dovar = se.expr;
+  type = TREE_TYPE (dovar);
+  gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
+
+  gfc_init_se (&se, NULL);
+  gfc_conv_expr_val (&se, code->ext.iterator->start);
+  gfc_add_block_to_block (pblock, &se.pre);
+  from = gfc_evaluate_now (se.expr, pblock);
+
+  gfc_init_se (&se, NULL);
+  gfc_conv_expr_val (&se, code->ext.iterator->end);
+  gfc_add_block_to_block (pblock, &se.pre);
+  to = gfc_evaluate_now (se.expr, pblock);
+
+  gfc_init_se (&se, NULL);
+  gfc_conv_expr_val (&se, code->ext.iterator->step);
+  gfc_add_block_to_block (pblock, &se.pre);
+  step = gfc_evaluate_now (se.expr, pblock);
+
+  /* Special case simple loops.  */
+  if (integer_onep (step))
+    simple = 1;
+  else if (tree_int_cst_equal (step, integer_minus_one_node))
+    simple = -1;
+
+  /* Loop body.  */
+  if (simple)
+    {
+      init = build2_v (MODIFY_EXPR, dovar, from);
+      cond = build2 (simple > 0 ? LE_EXPR : GE_EXPR, boolean_type_node,
+		     dovar, to);
+      incr = fold_build2 (PLUS_EXPR, type, dovar, step);
+      incr = fold_build2 (MODIFY_EXPR, type, dovar, incr);
+      if (pblock != &block)
+	{
+	  pushlevel (0);
+	  gfc_start_block (&block);
+	}
+      gfc_start_block (&body);
+    }
+  else
+    {
+      /* STEP is not 1 or -1.  Use:
+	 for (count = 0; count < (to + step - from) / step; count++)
+	   {
+	     dovar = from + count * step;
+	     body;
+	   cycle_label:;
+	   }  */
+      tmp = fold_build2 (MINUS_EXPR, type, step, from);
+      tmp = fold_build2 (PLUS_EXPR, type, to, tmp);
+      tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step);
+      tmp = gfc_evaluate_now (tmp, pblock);
+      count = gfc_create_var (type, "count");
+      init = build2_v (MODIFY_EXPR, count, build_int_cst (type, 0));
+      cond = build2 (LT_EXPR, boolean_type_node, count, tmp);
+      incr = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1));
+      incr = fold_build2 (MODIFY_EXPR, type, count, incr);
+
+      if (pblock != &block)
+	{
+	  pushlevel (0);
+	  gfc_start_block (&block);
+	}
+      gfc_start_block (&body);
+
+      /* Initialize DOVAR.  */
+      tmp = fold_build2 (MULT_EXPR, type, count, step);
+      tmp = build2 (PLUS_EXPR, type, from, tmp);
+      gfc_add_modify_expr (&body, dovar, tmp);
+    }
+
+  if (!dovar_found)
+    {
+      tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
+      OMP_CLAUSE_DECL (tmp) = dovar;
+      omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
+    }
+  if (!simple)
+    {
+      tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
+      OMP_CLAUSE_DECL (tmp) = count;
+      omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
+    }
+
+  /* Cycle statement is implemented with a goto.  Exit statement must not be
+     present for this loop.  */
+  cycle_label = gfc_build_label_decl (NULL_TREE);
+
+  /* Put these labels where they can be found later. We put the
+     labels in a TREE_LIST node (because TREE_CHAIN is already
+     used). cycle_label goes in TREE_PURPOSE (backend_decl), exit
+     label in TREE_VALUE (backend_decl).  */
+
+  code->block->backend_decl = tree_cons (cycle_label, NULL, NULL);
+
+  /* Main loop body.  */
+  tmp = gfc_trans_omp_code (code->block->next, true);
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Label for cycle statements (if needed).  */
+  if (TREE_USED (cycle_label))
+    {
+      tmp = build1_v (LABEL_EXPR, cycle_label);
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* End of loop body.  */
+  stmt = make_node (OMP_FOR);
+
+  TREE_TYPE (stmt) = void_type_node;
+  OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
+  OMP_FOR_CLAUSES (stmt) = omp_clauses;
+  OMP_FOR_INIT (stmt) = init;
+  OMP_FOR_COND (stmt) = cond;
+  OMP_FOR_INCR (stmt) = incr;
+  gfc_add_expr_to_block (&block, stmt);
+
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_flush (void)
+{
+  tree decl = built_in_decls [BUILT_IN_SYNCHRONIZE];
+  return build_function_call_expr (decl, NULL);
+}
+
+static tree
+gfc_trans_omp_master (gfc_code *code)
+{
+  tree stmt = gfc_trans_code (code->block->next);
+  if (IS_EMPTY_STMT (stmt))
+    return stmt;
+  return build1_v (OMP_MASTER, stmt);
+}
+
+static tree
+gfc_trans_omp_ordered (gfc_code *code)
+{
+  return build1_v (OMP_ORDERED, gfc_trans_code (code->block->next));
+}
+
+static tree
+gfc_trans_omp_parallel (gfc_code *code)
+{
+  stmtblock_t block;
+  tree stmt, omp_clauses;
+
+  gfc_start_block (&block);
+  omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+				       code->loc);
+  stmt = gfc_trans_omp_code (code->block->next, true);
+  stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_parallel_do (gfc_code *code)
+{
+  stmtblock_t block, *pblock = NULL;
+  gfc_omp_clauses parallel_clauses, do_clauses;
+  tree stmt, omp_clauses = NULL_TREE;
+
+  gfc_start_block (&block);
+
+  memset (&do_clauses, 0, sizeof (do_clauses));
+  if (code->ext.omp_clauses != NULL)
+    {
+      memcpy (&parallel_clauses, code->ext.omp_clauses,
+	      sizeof (parallel_clauses));
+      do_clauses.sched_kind = parallel_clauses.sched_kind;
+      do_clauses.chunk_size = parallel_clauses.chunk_size;
+      do_clauses.ordered = parallel_clauses.ordered;
+      parallel_clauses.sched_kind = OMP_SCHED_NONE;
+      parallel_clauses.chunk_size = NULL;
+      parallel_clauses.ordered = false;
+      omp_clauses = gfc_trans_omp_clauses (&block, &parallel_clauses,
+					   code->loc);
+    }
+  do_clauses.nowait = true;
+  if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC)
+    pblock = &block;
+  else
+    pushlevel (0);
+  stmt = gfc_trans_omp_do (code, pblock, &do_clauses);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
+  else
+    poplevel (0, 0, 0);
+  stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_parallel_sections (gfc_code *code)
+{
+  stmtblock_t block;
+  gfc_omp_clauses section_clauses;
+  tree stmt, omp_clauses;
+
+  memset (&section_clauses, 0, sizeof (section_clauses));
+  section_clauses.nowait = true;
+
+  gfc_start_block (&block);
+  omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+				       code->loc);
+  pushlevel (0);
+  stmt = gfc_trans_omp_sections (code, &section_clauses);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
+  else
+    poplevel (0, 0, 0);
+  stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_parallel_workshare (gfc_code *code)
+{
+  stmtblock_t block;
+  gfc_omp_clauses workshare_clauses;
+  tree stmt, omp_clauses;
+
+  memset (&workshare_clauses, 0, sizeof (workshare_clauses));
+  workshare_clauses.nowait = true;
+
+  gfc_start_block (&block);
+  omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+				       code->loc);
+  pushlevel (0);
+  stmt = gfc_trans_omp_workshare (code, &workshare_clauses);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
+  else
+    poplevel (0, 0, 0);
+  stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
+{
+  stmtblock_t block, body;
+  tree omp_clauses, stmt;
+  bool has_lastprivate = clauses->lists[OMP_LIST_LASTPRIVATE] != NULL;
+
+  gfc_start_block (&block);
+
+  omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
+
+  gfc_init_block (&body);
+  for (code = code->block; code; code = code->block)
+    {
+      /* Last section is special because of lastprivate, so even if it
+	 is empty, chain it in.  */
+      stmt = gfc_trans_omp_code (code->next,
+				 has_lastprivate && code->block == NULL);
+      if (! IS_EMPTY_STMT (stmt))
+	{
+	  stmt = build1_v (OMP_SECTION, stmt);
+	  gfc_add_expr_to_block (&body, stmt);
+	}
+    }
+  stmt = gfc_finish_block (&body);
+
+  stmt = build3_v (OMP_SECTIONS, stmt, omp_clauses, NULL);
+  gfc_add_expr_to_block (&block, stmt);
+
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
+{
+  tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
+  tree stmt = gfc_trans_omp_code (code->block->next, true);
+  stmt = build2_v (OMP_SINGLE, stmt, omp_clauses);
+  return stmt;
+}
+
+static tree
+gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
+{
+  /* XXX */
+  return gfc_trans_omp_single (code, clauses);
+}
+
+tree
+gfc_trans_omp_directive (gfc_code *code)
+{
+  switch (code->op)
+    {
+    case EXEC_OMP_ATOMIC:
+      return gfc_trans_omp_atomic (code);
+    case EXEC_OMP_BARRIER:
+      return gfc_trans_omp_barrier ();
+    case EXEC_OMP_CRITICAL:
+      return gfc_trans_omp_critical (code);
+    case EXEC_OMP_DO:
+      return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses);
+    case EXEC_OMP_FLUSH:
+      return gfc_trans_omp_flush ();
+    case EXEC_OMP_MASTER:
+      return gfc_trans_omp_master (code);
+    case EXEC_OMP_ORDERED:
+      return gfc_trans_omp_ordered (code);
+    case EXEC_OMP_PARALLEL:
+      return gfc_trans_omp_parallel (code);
+    case EXEC_OMP_PARALLEL_DO:
+      return gfc_trans_omp_parallel_do (code);
+    case EXEC_OMP_PARALLEL_SECTIONS:
+      return gfc_trans_omp_parallel_sections (code);
+    case EXEC_OMP_PARALLEL_WORKSHARE:
+      return gfc_trans_omp_parallel_workshare (code);
+    case EXEC_OMP_SECTIONS:
+      return gfc_trans_omp_sections (code, code->ext.omp_clauses);
+    case EXEC_OMP_SINGLE:
+      return gfc_trans_omp_single (code, code->ext.omp_clauses);
+    case EXEC_OMP_WORKSHARE:
+      return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
+    default:
+      gcc_unreachable ();
+    }
+}