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, 520 insertions, 15 deletions

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 4fb690b..8328482 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -300,6 +300,107 @@ decode_statement (void)
   return ST_NONE;
 }
 
+static gfc_statement
+decode_omp_directive (void)
+{
+  locus old_locus;
+  int c;
+
+#ifdef GFC_DEBUG
+  gfc_symbol_state ();
+#endif
+
+  gfc_clear_error ();	/* Clear any pending errors.  */
+  gfc_clear_warning ();	/* Clear any pending warnings.  */
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error_now ("OpenMP directives at %C may not appear in PURE or ELEMENTAL procedures");
+      gfc_error_recovery ();
+      return ST_NONE;
+    }
+
+  old_locus = gfc_current_locus;
+
+  /* General OpenMP directive matching: Instead of testing every possible
+     statement, we eliminate most possibilities by peeking at the
+     first character.  */
+
+  c = gfc_peek_char ();
+
+  switch (c)
+    {
+    case 'a':
+      match ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC);
+      break;
+    case 'b':
+      match ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
+      break;
+    case 'c':
+      match ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL);
+      break;
+    case 'd':
+      match ("do", gfc_match_omp_do, ST_OMP_DO);
+      break;
+    case 'e':
+      match ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL);
+      match ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO);
+      match ("end master", gfc_match_omp_eos, ST_OMP_END_MASTER);
+      match ("end ordered", gfc_match_omp_eos, ST_OMP_END_ORDERED);
+      match ("end parallel do", gfc_match_omp_eos, ST_OMP_END_PARALLEL_DO);
+      match ("end parallel sections", gfc_match_omp_eos,
+	     ST_OMP_END_PARALLEL_SECTIONS);
+      match ("end parallel workshare", gfc_match_omp_eos,
+	     ST_OMP_END_PARALLEL_WORKSHARE);
+      match ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL);
+      match ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS);
+      match ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE);
+      match ("end workshare", gfc_match_omp_end_nowait,
+	     ST_OMP_END_WORKSHARE);
+      break;
+    case 'f':
+      match ("flush", gfc_match_omp_flush, ST_OMP_FLUSH);
+      break;
+    case 'm':
+      match ("master", gfc_match_omp_master, ST_OMP_MASTER);
+      break;
+    case 'o':
+      match ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED);
+      break;
+    case 'p':
+      match ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO);
+      match ("parallel sections", gfc_match_omp_parallel_sections,
+	     ST_OMP_PARALLEL_SECTIONS);
+      match ("parallel workshare", gfc_match_omp_parallel_workshare,
+	     ST_OMP_PARALLEL_WORKSHARE);
+      match ("parallel", gfc_match_omp_parallel, ST_OMP_PARALLEL);
+      break;
+    case 's':
+      match ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS);
+      match ("section", gfc_match_omp_eos, ST_OMP_SECTION);
+      match ("single", gfc_match_omp_single, ST_OMP_SINGLE);
+      break;
+    case 't':
+      match ("threadprivate", gfc_match_omp_threadprivate,
+	     ST_OMP_THREADPRIVATE);
+    case 'w':
+      match ("workshare", gfc_match_omp_workshare, ST_OMP_WORKSHARE);
+      break;
+    }
+
+  /* All else has failed, so give up.  See if any of the matchers has
+     stored an error message of some sort.  */
+
+  if (gfc_error_check () == 0)
+    gfc_error_now ("Unclassifiable OpenMP directive at %C");
+
+  reject_statement ();
+
+  gfc_error_recovery ();
+
+  return ST_NONE;
+}
+
 #undef match
 
 
@@ -355,6 +456,22 @@ next_free (void)
 	    }
 	}
     }
+  else if (c == '!')
+    {
+      /* Comments have already been skipped by the time we get here,
+	 except for OpenMP directives.  */
+      if (gfc_option.flag_openmp)
+	{
+	  int i;
+
+	  c = gfc_next_char ();
+	  for (i = 0; i < 5; i++, c = gfc_next_char ())
+	    gcc_assert (c == "!$omp"[i]);
+
+	  gcc_assert (c == ' ');
+	  return decode_omp_directive ();
+	}
+    }
 
   return decode_statement ();
 }
@@ -405,7 +522,26 @@ next_fixed (void)
 	  digit_flag = 1;
 	  break;
 
-          /* Comments have already been skipped by the time we get
+	  /* Comments have already been skipped by the time we get
+	     here, except for OpenMP directives.  */
+	case '*':
+	  if (gfc_option.flag_openmp)
+	    {
+	      for (i = 0; i < 5; i++, c = gfc_next_char_literal (0))
+		gcc_assert (TOLOWER (c) == "*$omp"[i]);
+
+	      if (c != ' ' && c != '0')
+		{
+		  gfc_buffer_error (0);
+		  gfc_error ("Bad continuation line at %C");
+		  return ST_NONE;
+		}
+
+	      return decode_omp_directive ();
+	    }
+	  /* FALLTHROUGH */
+
+	  /* Comments have already been skipped by the time we get
 	     here so don't bother checking for them.  */
 
 	default:
@@ -534,18 +670,23 @@ next_statement (void)
   case ST_PAUSE: case ST_STOP: case ST_WRITE: case ST_ASSIGNMENT: \
   case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \
   case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
-  case ST_LABEL_ASSIGNMENT: case ST_FLUSH
+  case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
+  case ST_OMP_BARRIER
 
 /* Statements that mark other executable statements.  */
 
 #define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: case ST_IF_BLOCK: \
-  case ST_WHERE_BLOCK: case ST_SELECT_CASE
+  case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_OMP_PARALLEL: \
+  case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \
+  case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
+  case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
+  case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE
 
 /* Declaration statements */
 
 #define case_decl case ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: \
   case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \
-  case ST_TYPE: case ST_INTERFACE
+  case ST_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE
 
 /* Block end statements.  Errors associated with interchanging these
    are detected in gfc_match_end().  */
@@ -963,6 +1104,87 @@ gfc_ascii_statement (gfc_statement st)
     case ST_END_ENUM:
       p = "END ENUM";
       break;
+    case ST_OMP_ATOMIC:
+      p = "!$OMP ATOMIC";
+      break;
+    case ST_OMP_BARRIER:
+      p = "!$OMP BARRIER";
+      break;
+    case ST_OMP_CRITICAL:
+      p = "!$OMP CRITICAL";
+      break;
+    case ST_OMP_DO:
+      p = "!$OMP DO";
+      break;
+    case ST_OMP_END_CRITICAL:
+      p = "!$OMP END CRITICAL";
+      break;
+    case ST_OMP_END_DO:
+      p = "!$OMP END DO";
+      break;
+    case ST_OMP_END_MASTER:
+      p = "!$OMP END MASTER";
+      break;
+    case ST_OMP_END_ORDERED:
+      p = "!$OMP END ORDERED";
+      break;
+    case ST_OMP_END_PARALLEL:
+      p = "!$OMP END PARALLEL";
+      break;
+    case ST_OMP_END_PARALLEL_DO:
+      p = "!$OMP END PARALLEL DO";
+      break;
+    case ST_OMP_END_PARALLEL_SECTIONS:
+      p = "!$OMP END PARALLEL SECTIONS";
+      break;
+    case ST_OMP_END_PARALLEL_WORKSHARE:
+      p = "!$OMP END PARALLEL WORKSHARE";
+      break;
+    case ST_OMP_END_SECTIONS:
+      p = "!$OMP END SECTIONS";
+      break;
+    case ST_OMP_END_SINGLE:
+      p = "!$OMP END SINGLE";
+      break;
+    case ST_OMP_END_WORKSHARE:
+      p = "!$OMP END WORKSHARE";
+      break;
+    case ST_OMP_FLUSH:
+      p = "!$OMP FLUSH";
+      break;
+    case ST_OMP_MASTER:
+      p = "!$OMP MASTER";
+      break;
+    case ST_OMP_ORDERED:
+      p = "!$OMP ORDERED";
+      break;
+    case ST_OMP_PARALLEL:
+      p = "!$OMP PARALLEL";
+      break;
+    case ST_OMP_PARALLEL_DO:
+      p = "!$OMP PARALLEL DO";
+      break;
+    case ST_OMP_PARALLEL_SECTIONS:
+      p = "!$OMP PARALLEL SECTIONS";
+      break;
+    case ST_OMP_PARALLEL_WORKSHARE:
+      p = "!$OMP PARALLEL WORKSHARE";
+      break;
+    case ST_OMP_SECTIONS:
+      p = "!$OMP SECTIONS";
+      break;
+    case ST_OMP_SECTION:
+      p = "!$OMP SECTION";
+      break;
+    case ST_OMP_SINGLE:
+      p = "!$OMP SINGLE";
+      break;
+    case ST_OMP_THREADPRIVATE:
+      p = "!$OMP THREADPRIVATE";
+      break;
+    case ST_OMP_WORKSHARE:
+      p = "!$OMP WORKSHARE";
+      break;
     default:
       gfc_internal_error ("gfc_ascii_statement(): Bad statement code");
     }
@@ -2070,6 +2292,266 @@ loop:
 }
 
 
+/* Parse the statements of OpenMP do/parallel do.  */
+
+static gfc_statement
+parse_omp_do (gfc_statement omp_st)
+{
+  gfc_statement st;
+  gfc_code *cp, *np;
+  gfc_state_data s;
+
+  accept_statement (omp_st);
+
+  cp = gfc_state_stack->tail;
+  push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+  np = new_level (cp);
+  np->op = cp->op;
+  np->block = NULL;
+
+  for (;;)
+    {
+      st = next_statement ();
+      if (st == ST_NONE)
+	unexpected_eof ();
+      else if (st == ST_DO)
+	break;
+      else
+	unexpected_statement (st);
+    }
+
+  parse_do_block ();
+  if (gfc_statement_label != NULL
+      && gfc_state_stack->previous != NULL
+      && gfc_state_stack->previous->state == COMP_DO
+      && gfc_state_stack->previous->ext.end_do_label == gfc_statement_label)
+    {
+      /* In
+         DO 100 I=1,10
+           !$OMP DO
+             DO J=1,10
+             ...
+             100 CONTINUE
+         there should be no !$OMP END DO.  */
+      pop_state ();
+      return ST_IMPLIED_ENDDO;
+    }
+
+  check_do_closure ();
+  pop_state ();
+
+  st = next_statement ();
+  if (st == (omp_st == ST_OMP_DO ? ST_OMP_END_DO : ST_OMP_END_PARALLEL_DO))
+    {
+      if (new_st.op == EXEC_OMP_END_NOWAIT)
+	cp->ext.omp_clauses->nowait |= new_st.ext.omp_bool;
+      else
+	gcc_assert (new_st.op == EXEC_NOP);
+      gfc_clear_new_st ();
+      st = next_statement ();
+    }
+  return st;
+}
+
+
+/* Parse the statements of OpenMP atomic directive.  */
+
+static void
+parse_omp_atomic (void)
+{
+  gfc_statement st;
+  gfc_code *cp, *np;
+  gfc_state_data s;
+
+  accept_statement (ST_OMP_ATOMIC);
+
+  cp = gfc_state_stack->tail;
+  push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+  np = new_level (cp);
+  np->op = cp->op;
+  np->block = NULL;
+
+  for (;;)
+    {
+      st = next_statement ();
+      if (st == ST_NONE)
+	unexpected_eof ();
+      else if (st == ST_ASSIGNMENT)
+	break;
+      else
+	unexpected_statement (st);
+    }
+
+  accept_statement (st);
+
+  pop_state ();
+}
+
+
+/* Parse the statements of an OpenMP structured block.  */
+
+static void
+parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
+{
+  gfc_statement st, omp_end_st;
+  gfc_code *cp, *np;
+  gfc_state_data s;
+
+  accept_statement (omp_st);
+
+  cp = gfc_state_stack->tail;
+  push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+  np = new_level (cp);
+  np->op = cp->op;
+  np->block = NULL;
+
+  switch (omp_st)
+    {
+    case ST_OMP_PARALLEL:
+      omp_end_st = ST_OMP_END_PARALLEL;
+      break;
+    case ST_OMP_PARALLEL_SECTIONS:
+      omp_end_st = ST_OMP_END_PARALLEL_SECTIONS;
+      break;
+    case ST_OMP_SECTIONS:
+      omp_end_st = ST_OMP_END_SECTIONS;
+      break;
+    case ST_OMP_ORDERED:
+      omp_end_st = ST_OMP_END_ORDERED;
+      break;
+    case ST_OMP_CRITICAL:
+      omp_end_st = ST_OMP_END_CRITICAL;
+      break;
+    case ST_OMP_MASTER:
+      omp_end_st = ST_OMP_END_MASTER;
+      break;
+    case ST_OMP_SINGLE:
+      omp_end_st = ST_OMP_END_SINGLE;
+      break;
+    case ST_OMP_WORKSHARE:
+      omp_end_st = ST_OMP_END_WORKSHARE;
+      break;
+    case ST_OMP_PARALLEL_WORKSHARE:
+      omp_end_st = ST_OMP_END_PARALLEL_WORKSHARE;
+      break;
+    default:
+      gcc_unreachable ();
+    }
+
+  do
+    {
+      if (workshare_stmts_only)
+	{
+	  /* Inside of !$omp workshare, only
+	     scalar assignments
+	     array assignments
+	     where statements and constructs
+	     forall statements and constructs
+	     !$omp atomic
+	     !$omp critical
+	     !$omp parallel
+	     are allowed.  For !$omp critical these
+	     restrictions apply recursively.  */
+	  bool cycle = true;
+
+	  st = next_statement ();
+	  for (;;)
+	    {
+	      switch (st)
+		{
+		case ST_NONE:
+		  unexpected_eof ();
+
+		case ST_ASSIGNMENT:
+		case ST_WHERE:
+		case ST_FORALL:
+		  accept_statement (st);
+		  break;
+
+		case ST_WHERE_BLOCK:
+		  parse_where_block ();
+		  break;
+
+		case ST_FORALL_BLOCK:
+		  parse_forall_block ();
+		  break;
+
+		case ST_OMP_PARALLEL:
+		case ST_OMP_PARALLEL_SECTIONS:
+		  parse_omp_structured_block (st, false);
+		  break;
+
+		case ST_OMP_PARALLEL_WORKSHARE:
+		case ST_OMP_CRITICAL:
+		  parse_omp_structured_block (st, true);
+		  break;
+
+		case ST_OMP_PARALLEL_DO:
+		  st = parse_omp_do (st);
+		  continue;
+
+		case ST_OMP_ATOMIC:
+		  parse_omp_atomic ();
+		  break;
+
+		default:
+		  cycle = false;
+		  break;
+		}
+
+	      if (!cycle)
+		break;
+
+	      st = next_statement ();
+	    }
+	}
+      else
+	st = parse_executable (ST_NONE);
+      if (st == ST_NONE)
+	unexpected_eof ();
+      else if (st == ST_OMP_SECTION
+	       && (omp_st == ST_OMP_SECTIONS
+		   || omp_st == ST_OMP_PARALLEL_SECTIONS))
+	{
+	  np = new_level (np);
+	  np->op = cp->op;
+	  np->block = NULL;
+	}
+      else if (st != omp_end_st)
+	unexpected_statement (st);
+    }
+  while (st != omp_end_st);
+
+  switch (new_st.op)
+    {
+    case EXEC_OMP_END_NOWAIT:
+      cp->ext.omp_clauses->nowait |= new_st.ext.omp_bool;
+      break;
+    case EXEC_OMP_CRITICAL:
+      if (((cp->ext.omp_name == NULL) ^ (new_st.ext.omp_name == NULL))
+	  || (new_st.ext.omp_name != NULL
+	      && strcmp (cp->ext.omp_name, new_st.ext.omp_name) != 0))
+	gfc_error ("Name after !$omp critical and !$omp end critical does"
+		   " not match at %C");
+      gfc_free ((char *) new_st.ext.omp_name);
+      break;
+    case EXEC_OMP_END_SINGLE:
+      cp->ext.omp_clauses->lists[OMP_LIST_COPYPRIVATE]
+	= new_st.ext.omp_clauses->lists[OMP_LIST_COPYPRIVATE];
+      new_st.ext.omp_clauses->lists[OMP_LIST_COPYPRIVATE] = NULL;
+      gfc_free_omp_clauses (new_st.ext.omp_clauses);
+      break;
+    case EXEC_NOP:
+      break;
+    default:
+      gcc_unreachable ();
+    }
+
+  gfc_clear_new_st ();
+  pop_state ();
+}
+
+
 /* Accept a series of executable statements.  We return the first
    statement that doesn't fit to the caller.  Any block statements are
    passed on to the correct handler, which usually passes the buck
@@ -2083,9 +2565,8 @@ parse_executable (gfc_statement st)
   if (st == ST_NONE)
     st = next_statement ();
 
-  for (;; st = next_statement ())
+  for (;;)
     {
-
       close_flag = check_do_closure ();
       if (close_flag)
 	switch (st)
@@ -2125,38 +2606,62 @@ parse_executable (gfc_statement st)
 	  accept_statement (st);
 	  if (close_flag == 1)
 	    return ST_IMPLIED_ENDDO;
-	  continue;
+	  break;
 
 	case ST_IF_BLOCK:
 	  parse_if_block ();
-	  continue;
+	  break;
 
 	case ST_SELECT_CASE:
 	  parse_select_block ();
-	  continue;
+	  break;
 
 	case ST_DO:
 	  parse_do_block ();
 	  if (check_do_closure () == 1)
 	    return ST_IMPLIED_ENDDO;
-	  continue;
+	  break;
 
 	case ST_WHERE_BLOCK:
 	  parse_where_block ();
-	  continue;
+	  break;
 
 	case ST_FORALL_BLOCK:
 	  parse_forall_block ();
+	  break;
+
+	case ST_OMP_PARALLEL:
+	case ST_OMP_PARALLEL_SECTIONS:
+	case ST_OMP_SECTIONS:
+	case ST_OMP_ORDERED:
+	case ST_OMP_CRITICAL:
+	case ST_OMP_MASTER:
+	case ST_OMP_SINGLE:
+	  parse_omp_structured_block (st, false);
+	  break;
+
+	case ST_OMP_WORKSHARE:
+	case ST_OMP_PARALLEL_WORKSHARE:
+	  parse_omp_structured_block (st, true);
+	  break;
+
+	case ST_OMP_DO:
+	case ST_OMP_PARALLEL_DO:
+	  st = parse_omp_do (st);
+	  if (st == ST_IMPLIED_ENDDO)
+	    return st;
 	  continue;
 
-	default:
+	case ST_OMP_ATOMIC:
+	  parse_omp_atomic ();
 	  break;
+
+	default:
+	  return st;
 	}
 
-      break;
+      st = next_statement ();
     }
-
-  return st;
 }