This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gomp] Fortran OpenMP parser
- From: Jakub Jelinek <jakub at redhat dot com>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Cc: Richard Henderson <rth at redhat dot com>, Diego Novillo <dnovillo at redhat dot com>
- Date: Mon, 19 Sep 2005 13:59:43 -0400
- Subject: [gomp] Fortran OpenMP parser
- Reply-to: Jakub Jelinek <jakub at redhat dot com>
Hi!
The following patch implements OpenMP parser for gfortran.
What it does ATM:
1) !$|c$|*$ conditional compilation (both fixed and free form)
should be finished
2) !$omp|c$omp|*$omp directive matching too
3) parsing phase as well
4) resolving (== checking) is limited ATM, e.g.
IF(), NUM_THREADS() and SCHEDULE() expressions are
checked, but some checking of variable lists will
need to be done (e.g. to check various requirements
that variables can't be present in multiple clauses
etc.), checking !$omp atomic requirements etc.,
there is a lot to do
5) translation (into trees) just throws the directives
away in this step; there is code to translate !$omp parallel
directive with most of its clauses, but I hit
middle end GOMP bugs as well as some clauses not representable
yet. FYI, the C GOMP parser doesn't translate into trees
much more ATM.
6) On the libgomp side, omp_lib.h as well as omp_lib module
are written, fortran wrappers added to the library and
a bunch of testcases added. They pass ATM, as gfc_trans_omp_directive
just throws the directives away and replaces them for translation
just with their bodies.
Can Fortran maintainers please comment on this?
I'd like to check this into the gomp branch after review even in its
current limited form, so that middle-end GOMP changes can be tested
also on Fortran. At least part of the resolving work can continue
(as time permits) without any dependencies on other changes, but
the translation phase is heavily dependent on the middle-end
changes it will be interfacing with.
2005-09-19 Jakub Jelinek <jakub@redhat.com>
gcc/fortran/
* 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): New prototype.
* 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.
* match.c (gfc_match_omp_eos, gfc_free_omp_clauses,
gfc_match_omp_variable_list, gfc_match_omp_clauses,
gfc_match_omp_parallel, gfc_match_omp_critical, gfc_match_omp_do,
gfc_match_omp_flush, gfc_match_omp_threadprivate,
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_workshare, gfc_match_omp_master,
gfc_match_omp_ordered, gfc_match_omp_atomic, gfc_match_omp_barrier,
gfc_match_omp_end_nowait, gfc_match_omp_end_single): New functions.
(OMP_CLAUSE_PRIVATE, OMP_CLAUSE_FIRSTPRIVATE, OMP_CLAUSE_LASTPRIVATE,
OMP_CLAUSE_COPYPRIVATE, OMP_CLAUSE_SHARED, OMP_CLAUSE_COPYIN,
OMP_CLAUSE_REDUCTION, OMP_CLAUSE_IF, OMP_CLAUSE_NUM_THREADS,
OMP_CLAUSE_SCHEDULE, OMP_CLAUSE_DEFAULT, OMP_CLAUSE_ORDERED,
OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES): Define.
* resolve.c (resolve_blocks): Ignore EXEC_OMP_* block directives.
(resolve_code): Do limited resolving 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.
* trans-stmt.c (gfc_trans_omp_variable_list,
gfc_trans_omp_directive): New functions.
gcc/
* c-cppbuiltin.c (c_cpp_builtins): If -fopenmp, #define _OPENMP
to 200505.
libgomp/
* configure.ac (AC_PROG_FC): Add.
(USE_FORTRAN): New automake conditional.
* configure: Rebuilt.
* Makefile.am (libgomp_la_SOURCES): Add fortran.c.
(nodist_include_HEADERS): Add omp_lib.h, omp_lib.f90 and libgomp_f.h.
If USE_FORTRAN, add also omp_lib.mod and omp_lib_kinds.mod.
Add rules to build them.
* Makefile.in: Rebuilt.
* mkomp_h.pl: Compute and replace also OMP_LOCK_KIND and
OMP_NEST_LOCK_KIND.
* libgomp.map: Add Fortran wrappers.
* libgomp_f.h.in: New file.
* omp_lib.h.in: New file.
* omp_lib.f90.in: New file.
* fortran.c: New file.
* testsuite/lib/libgomp-dg.exp: Load a few more .exp files.
Append libgfortran directory to LD_LIBRARY_PATH if it exists.
Add -Lpath_to_libgfortran and -lgfortran -lgfortranbegin if
libgfortran has been built.
* testsuite/libgomp.fortran/fortran.exp: New file.
* testsuite/libgomp.fortran/omp_cond1.f: New test.
* testsuite/libgomp.fortran/omp_cond2.f: New test.
* testsuite/libgomp.fortran/omp_cond3.F90: New test.
* testsuite/libgomp.fortran/omp_cond4.F90: New test.
* testsuite/libgomp.fortran/omp_hello.f: New test.
* testsuite/libgomp.fortran/omp_orphan.f: New test.
* testsuite/libgomp.fortran/omp_parse1.f90: New test.
* testsuite/libgomp.fortran/omp_parse2.f90: New test.
* testsuite/libgomp.fortran/omp_parse3.f90: New test.
* testsuite/libgomp.fortran/omp_parse4.f90: New test.
* testsuite/libgomp.fortran/omp_reduction.f: New test.
* testsuite/libgomp.fortran/omp_workshare1.f: New test.
* testsuite/libgomp.fortran/omp_workshare2.f: New test.
--- gcc/fortran/options.c.jj 2005-09-17 20:45:47.000000000 +0200
+++ gcc/fortran/options.c 2005-09-17 23:02:05.000000000 +0200
@@ -73,6 +73,7 @@ gfc_init_options (unsigned int argc ATTR
gfc_option.flag_automatic = 1;
gfc_option.flag_backslash = 1;
gfc_option.flag_d_lines = -1;
+ gfc_option.flag_openmp = 0;
gfc_option.q_kind = gfc_default_double_kind;
@@ -360,6 +361,10 @@ gfc_handle_option (size_t scode, const c
gfc_option.source_form = FORM_FREE;
break;
+ case OPT_fopenmp:
+ gfc_option.flag_openmp = value;
+ break;
+
case OPT_funderscoring:
gfc_option.flag_underscoring = value;
break;
--- gcc/fortran/match.c.jj 2005-09-17 20:45:47.000000000 +0200
+++ gcc/fortran/match.c 2005-09-19 19:11:59.000000000 +0200
@@ -3395,3 +3395,528 @@ cleanup:
gfc_free_statements (c);
return MATCH_NO;
}
+
+/******************** OpenMP directive matching subroutines ****************/
+
+/* Match an end of OpenMP directive. End of OpenMP directive is optional
+ whitespace, followed by '\n' or comment '!'. */
+
+match
+gfc_match_omp_eos (void)
+{
+ locus old_loc;
+ int c;
+
+ old_loc = gfc_current_locus;
+ gfc_gobble_whitespace ();
+
+ c = gfc_next_char ();
+ switch (c)
+ {
+ case '!':
+ do
+ c = gfc_next_char ();
+ while (c != '\n');
+ /* Fall through */
+
+ case '\n':
+ return MATCH_YES;
+ }
+
+ gfc_current_locus = old_loc;
+ return MATCH_NO;
+}
+
+/* Free an omp_clauses structure. */
+
+void
+gfc_free_omp_clauses (gfc_omp_clauses *c)
+{
+ int i;
+ if (c == NULL)
+ return;
+
+ gfc_free_expr (c->if_expr);
+ gfc_free_expr (c->num_threads);
+ gfc_free_expr (c->chunk_size);
+ for (i = 0; i < OMP_LIST_NUM; i++)
+ gfc_free_namelist (c->lists[i]);
+ gfc_free (c);
+}
+
+static match
+gfc_match_omp_variable_list (const char *str, gfc_namelist **list)
+{
+ gfc_namelist *head, *tail, *p;
+ locus old_loc;
+ char n[GFC_MAX_SYMBOL_LEN+1];
+ gfc_common_head *c;
+ gfc_symbol *sym;
+ match m;
+ gfc_namespace *ns;
+
+ head = tail = NULL;
+
+ old_loc = gfc_current_locus;
+
+ m = gfc_match (str);
+ if (m != MATCH_YES)
+ return m;
+
+ for (;;)
+ {
+ m = gfc_match_symbol (&sym, 1);
+ switch (m)
+ {
+ case MATCH_YES:
+ p = gfc_get_namelist ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ tail->sym = sym;
+ goto next_item;
+ case MATCH_NO:
+ break;
+ case MATCH_ERROR:
+ goto cleanup;
+ }
+
+ m = gfc_match (" / %n /", n);
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ if (m == MATCH_NO)
+ goto syntax;
+
+ c = NULL;
+ for (ns = gfc_current_ns; ns != NULL; ns = ns->parent)
+ {
+ gfc_symtree *st = gfc_find_symtree (ns->common_root, n);
+ if (st != NULL)
+ {
+ c = st->n.common;
+ break;
+ }
+ }
+ if (c == NULL)
+ {
+ gfc_error ("COMMON block /%s/ not found at %C", n);
+ goto cleanup;
+ }
+ for (sym = c->head; sym; sym = sym->common_next)
+ {
+ p = gfc_get_namelist ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ tail->sym = sym;
+ }
+
+ next_item:
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ while (*list)
+ list = &(*list)->next;
+
+ *list = head;
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in OpenMP variable list at %C");
+
+cleanup:
+ gfc_free_namelist (head);
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+}
+
+#define OMP_CLAUSE_PRIVATE (1 << 0)
+#define OMP_CLAUSE_FIRSTPRIVATE (1 << 1)
+#define OMP_CLAUSE_LASTPRIVATE (1 << 2)
+#define OMP_CLAUSE_COPYPRIVATE (1 << 3)
+#define OMP_CLAUSE_SHARED (1 << 4)
+#define OMP_CLAUSE_COPYIN (1 << 5)
+#define OMP_CLAUSE_REDUCTION (1 << 6)
+#define OMP_CLAUSE_IF (1 << 7)
+#define OMP_CLAUSE_NUM_THREADS (1 << 8)
+#define OMP_CLAUSE_SCHEDULE (1 << 9)
+#define OMP_CLAUSE_DEFAULT (1 << 10)
+#define OMP_CLAUSE_ORDERED (1 << 11)
+
+static match
+gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
+{
+ gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ locus old_loc;
+ bool needs_space = true, first = true;
+
+ *cp = NULL;
+ while (1)
+ {
+ if ((first || gfc_match_char (',') != MATCH_YES)
+ && (needs_space && gfc_match_space () != MATCH_YES))
+ break;
+ needs_space = false;
+ first = false;
+ gfc_gobble_whitespace ();
+ if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL
+ && gfc_match ("if ( %e )", &c->if_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;
+ if ((mask & OMP_CLAUSE_PRIVATE)
+ && gfc_match_omp_variable_list ("private (",
+ &c->lists[OMP_LIST_PRIVATE])
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_FIRSTPRIVATE)
+ && gfc_match_omp_variable_list ("firstprivate (",
+ &c->lists[OMP_LIST_FIRSTPRIVATE])
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_LASTPRIVATE)
+ && gfc_match_omp_variable_list ("lastprivate (",
+ &c->lists[OMP_LIST_LASTPRIVATE])
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_COPYPRIVATE)
+ && gfc_match_omp_variable_list ("copyprivate (",
+ &c->lists[OMP_LIST_COPYPRIVATE])
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_SHARED)
+ && gfc_match_omp_variable_list ("shared (",
+ &c->lists[OMP_LIST_SHARED])
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_COPYIN)
+ && gfc_match_omp_variable_list ("copyin (",
+ &c->lists[OMP_LIST_COPYIN])
+ == MATCH_YES)
+ continue;
+ old_loc = gfc_current_locus;
+ if ((mask & OMP_CLAUSE_REDUCTION)
+ && gfc_match ("reduction ( ") == MATCH_YES)
+ {
+ int reduction = OMP_LIST_NUM;
+ if (gfc_match_char ('+') == MATCH_YES)
+ reduction = OMP_LIST_PLUS;
+ else if (gfc_match_char ('*') == MATCH_YES)
+ reduction = OMP_LIST_MULT;
+ else if (gfc_match_char ('-') == MATCH_YES)
+ reduction = OMP_LIST_SUB;
+ else if (gfc_match (".and.") == MATCH_YES)
+ reduction = OMP_LIST_AND;
+ else if (gfc_match (".or.") == MATCH_YES)
+ reduction = OMP_LIST_OR;
+ else if (gfc_match (".eqv.") == MATCH_YES)
+ reduction = OMP_LIST_EQV;
+ else if (gfc_match (".neqv.") == MATCH_YES)
+ reduction = OMP_LIST_NEQV;
+ else if (gfc_match ("max") == MATCH_YES)
+ reduction = OMP_LIST_MAX;
+ else if (gfc_match (".min.") == MATCH_YES)
+ reduction = OMP_LIST_MIN;
+ else if (gfc_match (".iand.") == MATCH_YES)
+ reduction = OMP_LIST_IAND;
+ else if (gfc_match (".ior.") == MATCH_YES)
+ reduction = OMP_LIST_IOR;
+ else if (gfc_match (".ieor.") == MATCH_YES)
+ reduction = OMP_LIST_IEOR;
+ if (reduction != OMP_LIST_NUM
+ && gfc_match_omp_variable_list (" :", &c->lists[reduction])
+ == MATCH_YES)
+ continue;
+ else
+ gfc_current_locus = old_loc;
+ }
+ if ((mask & OMP_CLAUSE_DEFAULT)
+ && c->default_sharing == OMP_DEFAULT_UNKNOWN)
+ {
+ if (gfc_match ("default ( shared )") == MATCH_YES)
+ c->default_sharing = OMP_DEFAULT_SHARED;
+ else if (gfc_match ("default ( private )") == MATCH_YES)
+ c->default_sharing = OMP_DEFAULT_PRIVATE;
+ else if (gfc_match ("default ( none )") == MATCH_YES)
+ c->default_sharing = OMP_DEFAULT_NONE;
+ if (c->default_sharing != OMP_DEFAULT_UNKNOWN)
+ continue;
+ }
+ old_loc = gfc_current_locus;
+ if ((mask & OMP_CLAUSE_SCHEDULE)
+ && c->sched_kind == OMP_SCHED_NONE
+ && gfc_match ("schedule ( ") == MATCH_YES)
+ {
+ if (gfc_match ("static") == MATCH_YES)
+ c->sched_kind = OMP_SCHED_STATIC;
+ else if (gfc_match ("dynamic") == MATCH_YES)
+ c->sched_kind = OMP_SCHED_DYNAMIC;
+ else if (gfc_match ("guided") == MATCH_YES)
+ c->sched_kind = OMP_SCHED_GUIDED;
+ else if (gfc_match ("runtime") == MATCH_YES)
+ c->sched_kind = OMP_SCHED_RUNTIME;
+ if (c->sched_kind != OMP_SCHED_NONE)
+ {
+ match m = MATCH_NO;
+ if (c->sched_kind != OMP_SCHED_RUNTIME)
+ m = gfc_match (" , %e )", &c->chunk_size);
+ if (m != MATCH_YES)
+ m = gfc_match_char (')');
+ if (m != MATCH_YES)
+ c->sched_kind = OMP_SCHED_NONE;
+ }
+ if (c->sched_kind != OMP_SCHED_NONE)
+ continue;
+ else
+ gfc_current_locus = old_loc;
+ }
+ if ((mask & OMP_CLAUSE_ORDERED) && !c->ordered
+ && gfc_match ("ordered") == MATCH_YES)
+ {
+ c->ordered = needs_space = true;
+ continue;
+ }
+
+ break;
+ }
+
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_free_omp_clauses (c);
+ return MATCH_ERROR;
+ }
+
+ if (c->default_sharing == OMP_DEFAULT_UNKNOWN)
+ c->default_sharing = OMP_DEFAULT_SHARED;
+
+ *cp = c;
+ return MATCH_YES;
+}
+
+#define OMP_PARALLEL_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
+ | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \
+ | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT)
+#define OMP_DO_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
+ | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED)
+#define OMP_SECTIONS_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+
+match
+gfc_match_omp_parallel (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_PARALLEL;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_critical (void)
+{
+ char n[GFC_MAX_SYMBOL_LEN+1];
+
+ if (gfc_match (" ( %n )", n) != MATCH_YES)
+ n[0] = '\0';
+ if (gfc_match_omp_eos () != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_CRITICAL;
+ new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_do (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OMP_DO_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_DO;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_flush (void)
+{
+ gfc_namelist *list = NULL;
+ gfc_match_omp_variable_list (" (", &list);
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_free_namelist (list);
+ return MATCH_ERROR;
+ }
+ new_st.op = EXEC_OMP_FLUSH;
+ new_st.ext.omp_namelist = list;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_threadprivate (void)
+{
+ gfc_namelist *list = NULL;
+ gfc_match_omp_variable_list (" (", &list);
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_free_namelist (list);
+ return MATCH_ERROR;
+ }
+ /* XXX Mark vars thread private now. */
+ gfc_free_namelist (list);
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_parallel_do (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES)
+ != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_PARALLEL_DO;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_parallel_sections (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_SECTIONS_CLAUSES)
+ != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_PARALLEL_SECTIONS;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_parallel_workshare (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_PARALLEL_WORKSHARE;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_sections (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OMP_SECTIONS_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_SECTIONS;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_single (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE)
+ != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_SINGLE;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_workshare (void)
+{
+ if (gfc_match_omp_eos () != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_WORKSHARE;
+ new_st.ext.omp_clauses = gfc_get_omp_clauses ();
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_master (void)
+{
+ if (gfc_match_omp_eos () != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_MASTER;
+ new_st.ext.omp_clauses = NULL;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_ordered (void)
+{
+ if (gfc_match_omp_eos () != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_ORDERED;
+ new_st.ext.omp_clauses = NULL;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_atomic (void)
+{
+ if (gfc_match_omp_eos () != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_ATOMIC;
+ new_st.ext.omp_clauses = NULL;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_barrier (void)
+{
+ if (gfc_match_omp_eos () != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_BARRIER;
+ new_st.ext.omp_clauses = NULL;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_end_nowait (void)
+{
+ bool nowait = false;
+ if (gfc_match ("% nowait") == MATCH_YES)
+ nowait = true;
+ if (gfc_match_omp_eos () != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_END_NOWAIT;
+ new_st.ext.omp_bool = nowait;
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_end_single (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match ("% nowait") == MATCH_YES)
+ {
+ new_st.op = EXEC_OMP_END_NOWAIT;
+ new_st.ext.omp_bool = true;
+ return MATCH_YES;
+ }
+ if (gfc_match_omp_clauses (&c, OMP_CLAUSE_COPYPRIVATE) != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_END_SINGLE;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
--- gcc/fortran/resolve.c.jj 2005-09-13 15:16:42.000000000 +0200
+++ gcc/fortran/resolve.c 2005-09-19 19:10:21.000000000 +0200
@@ -3768,6 +3768,20 @@ resolve_blocks (gfc_code * b, gfc_namesp
case EXEC_DO_WHILE:
break;
+ case EXEC_OMP_ATOMIC:
+ case EXEC_OMP_CRITICAL:
+ case EXEC_OMP_DO:
+ case EXEC_OMP_MASTER:
+ case EXEC_OMP_ORDERED:
+ case EXEC_OMP_PARALLEL:
+ case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_SECTIONS:
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_SECTIONS:
+ case EXEC_OMP_SINGLE:
+ case EXEC_OMP_WORKSHARE:
+ break;
+
default:
gfc_internal_error ("resolve_block(): Bad block type");
}
@@ -4032,6 +4046,51 @@ resolve_code (gfc_code * code, gfc_names
&code->expr->where);
break;
+ case EXEC_OMP_ATOMIC:
+ case EXEC_OMP_BARRIER:
+ case EXEC_OMP_CRITICAL:
+ case EXEC_OMP_FLUSH:
+ break;
+
+ case EXEC_OMP_DO:
+ case EXEC_OMP_MASTER:
+ case EXEC_OMP_ORDERED:
+ case EXEC_OMP_PARALLEL:
+ case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_SECTIONS:
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_SECTIONS:
+ case EXEC_OMP_SINGLE:
+ case EXEC_OMP_WORKSHARE:
+ if (code->ext.omp_clauses)
+ {
+ if (code->ext.omp_clauses->if_expr)
+ {
+ gfc_expr *expr = code->ext.omp_clauses->if_expr;
+ if (gfc_resolve_expr (expr) == FAILURE
+ || expr->ts.type != BT_LOGICAL || expr->rank != 0)
+ gfc_error ("IF clause at %L requires a scalar LOGICAL"
+ " expression", &expr->where);
+ }
+ if (code->ext.omp_clauses->num_threads)
+ {
+ gfc_expr *expr = code->ext.omp_clauses->num_threads;
+ if (gfc_resolve_expr (expr) == FAILURE
+ || expr->ts.type != BT_INTEGER || expr->rank != 0)
+ gfc_error ("NUM_THREADS clause at %L requires a scalar"
+ " INTEGER expression", &expr->where);
+ }
+ if (code->ext.omp_clauses->chunk_size)
+ {
+ gfc_expr *expr = code->ext.omp_clauses->chunk_size;
+ if (gfc_resolve_expr (expr) == FAILURE
+ || expr->ts.type != BT_INTEGER || expr->rank != 0)
+ gfc_error ("SCHEDULE clause's chunk_size at %L requires"
+ " a scalar INTEGER expression", &expr->where);
+ }
+ }
+ break;
+
default:
gfc_internal_error ("resolve_code(): Bad statement code");
}
--- gcc/fortran/scanner.c.jj 2005-09-13 15:16:42.000000000 +0200
+++ gcc/fortran/scanner.c 2005-09-17 23:02:05.000000000 +0200
@@ -59,7 +59,8 @@ static gfc_directorylist *include_dirs;
static gfc_file *file_head, *current_file;
-static int continue_flag, end_flag;
+static int continue_flag, end_flag, openmp_flag;
+static locus openmp_locus;
gfc_source_form gfc_current_form;
static gfc_linebuf *line_head, *line_tail;
@@ -321,6 +322,7 @@ skip_free_comments (void)
{
locus start;
char c;
+ int at_bol = gfc_at_bol ();
for (;;)
{
@@ -342,6 +344,46 @@ skip_free_comments (void)
if (c == '!')
{
+ /* If -fopenmp, we need to handle here 2 things:
+ 1) don't treat !$omp as comments, but directives
+ 2) handle OpenMP conditional compilation, where
+ !$ should be treated as 2 spaces (for initial lines
+ only if followed by space). */
+ if (gfc_option.flag_openmp && at_bol)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'o' || c == 'O')
+ {
+ if (((c = next_char ()) == 'm' || c == 'M')
+ && ((c = next_char ()) == 'p' || c == 'P')
+ && ((c = next_char ()) == ' ' || continue_flag))
+ {
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ if (c != '\n' && c != '!')
+ {
+ openmp_flag = 1;
+ openmp_locus = old_loc;
+ gfc_current_locus = start;
+ return;
+ }
+ }
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ if (continue_flag || c == ' ')
+ {
+ gfc_current_locus = old_loc;
+ next_char ();
+ return;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
skip_comment_line ();
continue;
}
@@ -349,6 +391,8 @@ skip_free_comments (void)
break;
}
+ if (openmp_flag && at_bol)
+ openmp_flag = 0;
gfc_current_locus = start;
}
@@ -380,6 +424,66 @@ skip_fixed_comments (void)
if (c == '!' || c == 'c' || c == 'C' || c == '*')
{
+ /* If -fopenmp, we need to handle here 2 things:
+ 1) don't treat !$omp|c$omp|*$omp as comments, but directives
+ 2) handle OpenMP conditional compilation, where
+ !$|c$|*$ should be treated as 2 spaces if the characters
+ in columns 3 to 6 are valid fixed form label columns
+ characters. */
+ if (gfc_option.flag_openmp)
+ {
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'o' || c == 'O')
+ {
+ if (((c = next_char ()) == 'm' || c == 'M')
+ && ((c = next_char ()) == 'p' || c == 'P'))
+ {
+ c = next_char ();
+ if (c != '\n'
+ && ((openmp_flag && continue_flag)
+ || c == ' ' || c == '0'))
+ {
+ c = next_char ();
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ if (c != '\n' && c != '!')
+ {
+ /* Canonicalize to *$omp. */
+ *start.nextc = '*';
+ openmp_flag = 1;
+ gfc_current_locus = start;
+ return;
+ }
+ }
+ }
+ }
+ else
+ {
+ int digit_seen = 0;
+
+ for (col = 3; col < 6; col++, c = next_char ())
+ if (c == ' ')
+ continue;
+ else if (c < '0' || c > '9')
+ break;
+ else
+ digit_seen = 1;
+
+ if (col == 6 && c != '\n'
+ && ((continue_flag && !digit_seen)
+ || c == ' ' || c == '0'))
+ {
+ gfc_current_locus = start;
+ start.nextc[0] = ' ';
+ start.nextc[1] = ' ';
+ continue;
+ }
+ }
+ }
+ gfc_current_locus = start;
+ }
skip_comment_line ();
continue;
}
@@ -418,6 +522,7 @@ skip_fixed_comments (void)
break;
}
+ openmp_flag = 0;
gfc_current_locus = start;
}
@@ -447,7 +552,7 @@ int
gfc_next_char_literal (int in_string)
{
locus old_loc;
- int i, c;
+ int i, c, prev_openmp_flag;
continue_flag = 0;
@@ -458,9 +563,13 @@ restart:
if (gfc_current_form == FORM_FREE)
{
-
if (!in_string && c == '!')
{
+ if (openmp_flag
+ && memcmp (&gfc_current_locus, &openmp_locus,
+ sizeof (gfc_current_locus)) == 0)
+ goto done;
+
/* This line can't be continued */
do
{
@@ -478,7 +587,7 @@ restart:
goto done;
/* If the next nonblank character is a ! or \n, we've got a
- continuation line. */
+ continuation line. */
old_loc = gfc_current_locus;
c = next_char ();
@@ -486,7 +595,7 @@ restart:
c = next_char ();
/* Character constants to be continued cannot have commentary
- after the '&'. */
+ after the '&'. */
if (in_string && c != '\n')
{
@@ -502,6 +611,7 @@ restart:
goto done;
}
+ prev_openmp_flag = openmp_flag;
continue_flag = 1;
if (c == '!')
skip_comment_line ();
@@ -509,13 +619,21 @@ restart:
gfc_advance_line ();
/* We've got a continuation line and need to find where it continues.
- First eat any comment lines. */
+ First eat any comment lines. */
gfc_skip_comments ();
+ if (prev_openmp_flag != openmp_flag)
+ {
+ gfc_current_locus = old_loc;
+ openmp_flag = prev_openmp_flag;
+ c = '&';
+ goto done;
+ }
+
/* Now that we have a non-comment line, probe ahead for the
- first non-whitespace character. If it is another '&', then
- reading starts at the next character, otherwise we must back
- up to where the whitespace started and resume from there. */
+ first non-whitespace character. If it is another '&', then
+ reading starts at the next character, otherwise we must back
+ up to where the whitespace started and resume from there. */
old_loc = gfc_current_locus;
@@ -523,9 +641,16 @@ restart:
while (gfc_is_whitespace (c))
c = next_char ();
+ if (openmp_flag)
+ {
+ for (i = 0; i < 5; i++, c = next_char ())
+ gcc_assert (TOLOWER (c) == "!$omp"[i]);
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ }
+
if (c != '&')
gfc_current_locus = old_loc;
-
}
else
{
@@ -546,6 +671,7 @@ restart:
if (c != '\n')
goto done;
+ prev_openmp_flag = openmp_flag;
continue_flag = 1;
old_loc = gfc_current_locus;
@@ -553,15 +679,29 @@ restart:
gfc_skip_comments ();
/* See if this line is a continuation line. */
- for (i = 0; i < 5; i++)
+ if (openmp_flag != prev_openmp_flag)
{
- c = next_char ();
- if (c != ' ')
- goto not_continuation;
+ openmp_flag = prev_openmp_flag;
+ goto not_continuation;
}
+ if (!openmp_flag)
+ for (i = 0; i < 5; i++)
+ {
+ c = next_char ();
+ if (c != ' ')
+ goto not_continuation;
+ }
+ else
+ for (i = 0; i < 5; i++)
+ {
+ c = next_char ();
+ if (TOLOWER (c) != "!$omp"[i])
+ goto not_continuation;
+ }
+
c = next_char ();
- if (c == '0' || c == ' ')
+ if (c == '0' || c == ' ' || c == '\n')
goto not_continuation;
}
--- gcc/fortran/trans.c.jj 2005-09-13 15:16:44.000000000 +0200
+++ gcc/fortran/trans.c 2005-09-19 15:40:19.000000000 +0200
@@ -621,6 +621,23 @@ gfc_trans_code (gfc_code * code)
res = gfc_trans_dt_end (code);
break;
+ case EXEC_OMP_ATOMIC:
+ case EXEC_OMP_BARRIER:
+ case EXEC_OMP_CRITICAL:
+ case EXEC_OMP_DO:
+ case EXEC_OMP_FLUSH:
+ case EXEC_OMP_MASTER:
+ case EXEC_OMP_ORDERED:
+ case EXEC_OMP_PARALLEL:
+ case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_SECTIONS:
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_SECTIONS:
+ case EXEC_OMP_SINGLE:
+ case EXEC_OMP_WORKSHARE:
+ res = gfc_trans_omp_directive (code);
+ break;
+
default:
internal_error ("gfc_trans_code(): Bad statement code");
}
--- gcc/fortran/match.h.jj 2005-09-17 20:45:47.000000000 +0200
+++ gcc/fortran/match.h 2005-09-19 15:02:51.000000000 +0200
@@ -86,6 +86,26 @@ match gfc_match_where (gfc_statement *);
match gfc_match_elsewhere (void);
match gfc_match_forall (gfc_statement *);
+/* OpenMP directive matchers */
+match gfc_match_omp_eos (void);
+match gfc_match_omp_atomic (void);
+match gfc_match_omp_barrier (void);
+match gfc_match_omp_critical (void);
+match gfc_match_omp_do (void);
+match gfc_match_omp_flush (void);
+match gfc_match_omp_master (void);
+match gfc_match_omp_ordered (void);
+match gfc_match_omp_parallel (void);
+match gfc_match_omp_parallel_do (void);
+match gfc_match_omp_parallel_sections (void);
+match gfc_match_omp_parallel_workshare (void);
+match gfc_match_omp_sections (void);
+match gfc_match_omp_single (void);
+match gfc_match_omp_threadprivate (void);
+match gfc_match_omp_workshare (void);
+match gfc_match_omp_end_nowait (void);
+match gfc_match_omp_end_single (void);
+
/* Other functions. */
gfc_common_head *gfc_get_common (const char *, int);
--- gcc/fortran/st.c.jj 2005-09-13 15:16:42.000000000 +0200
+++ gcc/fortran/st.c 2005-09-19 19:09:53.000000000 +0200
@@ -161,6 +161,33 @@ gfc_free_statement (gfc_code * p)
gfc_free_forall_iterator (p->ext.forall_iterator);
break;
+ case EXEC_OMP_DO:
+ case EXEC_OMP_END_SINGLE:
+ case EXEC_OMP_PARALLEL:
+ case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_SECTIONS:
+ case EXEC_OMP_SECTIONS:
+ case EXEC_OMP_SINGLE:
+ case EXEC_OMP_WORKSHARE:
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ gfc_free_omp_clauses (p->ext.omp_clauses);
+ break;
+
+ case EXEC_OMP_CRITICAL:
+ gfc_free ((char *) p->ext.omp_name);
+ break;
+
+ case EXEC_OMP_FLUSH:
+ gfc_free_namelist (p->ext.omp_namelist);
+ break;
+
+ case EXEC_OMP_ATOMIC:
+ case EXEC_OMP_BARRIER:
+ case EXEC_OMP_MASTER:
+ case EXEC_OMP_ORDERED:
+ case EXEC_OMP_END_NOWAIT:
+ break;
+
default:
gfc_internal_error ("gfc_free_statement(): Bad statement");
}
--- gcc/fortran/trans-stmt.c.jj 2005-09-13 15:16:44.000000000 +0200
+++ gcc/fortran/trans-stmt.c 2005-09-19 15:42:58.000000000 +0200
@@ -3318,3 +3318,93 @@ gfc_trans_deallocate (gfc_code * code)
return gfc_finish_block (&block);
}
+static tree
+gfc_trans_omp_variable_list (gfc_namelist *namelist)
+{
+ tree list = NULL_TREE;
+ for (; namelist != NULL; namelist = namelist->next)
+ if (namelist->sym->attr.referenced)
+ {
+ tree t = gfc_get_symbol_decl (namelist->sym);
+ if (t != error_mark_node)
+ list = tree_cons (NULL_TREE, t, list);
+ }
+ return list;
+}
+
+tree
+gfc_trans_omp_directive (gfc_code *code)
+{
+ tree stmt, omp_clauses = NULL_TREE;
+ int clause;
+ enum tree_code clause_code;
+
+ /* FIXME */
+ if (1 || code->op != EXEC_OMP_PARALLEL)
+ {
+ if (code->op == EXEC_OMP_FLUSH || code->op == EXEC_OMP_BARRIER)
+ return build_empty_stmt ();
+ if (code->op == EXEC_OMP_SECTIONS
+ || code->op == EXEC_OMP_PARALLEL_SECTIONS)
+ {
+ stmtblock_t block;
+ gfc_start_block (&block);
+ for (code = code->block; code; code = code->block)
+ {
+ stmt = gfc_trans_code (code->next);
+ if (stmt != NULL_TREE && ! IS_EMPTY_STMT (stmt))
+ gfc_add_expr_to_block (&block, stmt);
+ }
+ return gfc_finish_block (&block);
+ }
+ return gfc_trans_code (code->block->next);
+ }
+
+ stmt = gfc_trans_code (code->block->next);
+ if (code->ext.omp_clauses)
+ for (clause = 0; clause < OMP_LIST_NUM; clause++)
+ if (code->ext.omp_clauses->lists[clause])
+ {
+ clause_code = ERROR_MARK;
+ if (clause >= OMP_LIST_REDUCTION_FIRST
+ && clause <= OMP_LIST_REDUCTION_LAST)
+ {
+ printf ("reduction not handled yet\n");
+ continue;
+ }
+ switch (clause)
+ {
+ case OMP_LIST_PRIVATE:
+ clause_code = GOMP_CLAUSE_PRIVATE;
+ break;
+ case OMP_LIST_SHARED:
+ clause_code = GOMP_CLAUSE_SHARED;
+ break;
+ case OMP_LIST_FIRSTPRIVATE:
+ clause_code = GOMP_CLAUSE_FIRSTPRIVATE;
+ break;
+ case OMP_LIST_LASTPRIVATE:
+ clause_code = GOMP_CLAUSE_LASTPRIVATE;
+ break;
+ case OMP_LIST_COPYIN:
+ clause_code = GOMP_CLAUSE_COPYIN;
+ break;
+ case OMP_LIST_COPYPRIVATE:
+ clause_code = GOMP_CLAUSE_COPYPRIVATE;
+ break;
+ default:
+ break;
+ }
+ if (clause_code != ERROR_MARK)
+ {
+ gfc_namelist *n = code->ext.omp_clauses->lists[clause];
+ tree list = gfc_trans_omp_variable_list (n);
+ if (list != NULL_TREE)
+ {
+ list = build1 (clause_code, NULL_TREE, list);
+ omp_clauses = tree_cons (NULL_TREE, list, omp_clauses);
+ }
+ }
+ }
+ return build2 (GOMP_PARALLEL, void_type_node, omp_clauses, stmt);
+}
--- gcc/fortran/gfortran.h.jj 2005-09-17 20:45:46.000000000 +0200
+++ gcc/fortran/gfortran.h 2005-09-19 15:04:24.000000000 +0200
@@ -204,6 +204,14 @@ typedef enum
ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, 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_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,
ST_NONE
}
gfc_statement;
@@ -631,6 +639,60 @@ gfc_namelist;
#define gfc_get_namelist() gfc_getmem(sizeof(gfc_namelist))
+enum
+{
+ 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_PLUS,
+ OMP_LIST_MULT,
+ OMP_LIST_SUB,
+ OMP_LIST_AND,
+ OMP_LIST_OR,
+ OMP_LIST_EQV,
+ OMP_LIST_NEQV,
+ OMP_LIST_MAX,
+ OMP_LIST_MIN,
+ OMP_LIST_IAND,
+ OMP_LIST_IOR,
+ OMP_LIST_IEOR,
+ OMP_LIST_REDUCTION_LAST = OMP_LIST_IEOR,
+ OMP_LIST_NUM
+};
+
+/* Because a symbol can belong to multiple namelists, they must be
+ linked externally to the symbol itself. */
+typedef struct gfc_omp_clauses
+{
+ struct gfc_expr *if_expr;
+ struct gfc_expr *num_threads;
+ gfc_namelist *lists[OMP_LIST_NUM];
+ enum
+ {
+ OMP_SCHED_NONE,
+ OMP_SCHED_STATIC,
+ OMP_SCHED_DYNAMIC,
+ OMP_SCHED_GUIDED,
+ OMP_SCHED_RUNTIME
+ } sched_kind;
+ struct gfc_expr *chunk_size;
+ enum
+ {
+ OMP_DEFAULT_UNKNOWN,
+ OMP_DEFAULT_NONE,
+ OMP_DEFAULT_PRIVATE,
+ OMP_DEFAULT_SHARED
+ } default_sharing;
+ bool nowait, ordered;
+}
+gfc_omp_clauses;
+
+#define gfc_get_omp_clauses() gfc_getmem(sizeof(gfc_omp_clauses))
+
/* The gfc_st_label structure is a doubly linked list attached to a
namespace that records the usage of statement labels within that
@@ -1338,7 +1400,13 @@ typedef enum
EXEC_ALLOCATE, EXEC_DEALLOCATE,
EXEC_OPEN, EXEC_CLOSE,
EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
- EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH
+ EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
+ 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
}
gfc_exec_op;
@@ -1372,6 +1440,10 @@ typedef struct gfc_code
struct gfc_code *whichloop;
int stop_code;
gfc_entry_list *entry;
+ gfc_omp_clauses *omp_clauses;
+ const char *omp_name;
+ gfc_namelist *omp_namelist;
+ bool omp_bool;
}
ext; /* Points to additional structures required by statement */
@@ -1449,6 +1521,7 @@ typedef struct
int flag_automatic;
int flag_backslash;
int flag_d_lines;
+ int flag_openmp;
int q_kind;
@@ -1737,6 +1810,7 @@ void gfc_free_iterator (gfc_iterator *,
void gfc_free_forall_iterator (gfc_forall_iterator *);
void gfc_free_alloc_list (gfc_alloc *);
void gfc_free_namelist (gfc_namelist *);
+void gfc_free_omp_clauses (gfc_omp_clauses *);
void gfc_free_equiv (gfc_equiv *);
void gfc_free_data (gfc_data *);
void gfc_free_case_list (gfc_case *);
--- gcc/fortran/trans-stmt.h.jj 2005-09-13 15:16:44.000000000 +0200
+++ gcc/fortran/trans-stmt.h 2005-09-17 23:02:05.000000000 +0200
@@ -1,5 +1,5 @@
/* Header for statement translation functions
- Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc.
Contributed by Paul Brook
This file is part of GCC.
@@ -50,6 +50,7 @@ tree gfc_trans_where (gfc_code *);
tree gfc_trans_allocate (gfc_code *);
tree gfc_trans_deallocate (gfc_code *);
tree gfc_trans_deallocate_array (tree);
+tree gfc_trans_omp_directive (gfc_code *);
/* trans-io.c */
tree gfc_trans_open (gfc_code *);
--- gcc/fortran/lang.opt.jj 2005-09-17 20:45:47.000000000 +0200
+++ gcc/fortran/lang.opt 2005-09-17 23:02:05.000000000 +0200
@@ -117,6 +117,10 @@ ffree-form
Fortran
Assume that the source file is free form
+fopenmp
+Fortran
+Enable OpenMP
+
funderscoring
Fortran
Append underscores to externally visible names
--- gcc/fortran/parse.c.jj 2005-09-13 15:16:42.000000000 +0200
+++ gcc/fortran/parse.c 2005-09-19 19:10:55.000000000 +0200
@@ -298,6 +298,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
@@ -352,6 +453,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 ();
}
@@ -402,7 +519,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:
@@ -531,18 +667,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(). */
@@ -951,6 +1092,87 @@ gfc_ascii_statement (gfc_statement st)
case ST_LABEL_ASSIGNMENT:
p = "LABEL ASSIGNMENT";
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");
}
@@ -2037,6 +2259,248 @@ 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 ();
+ check_do_closure ();
+ st = next_statement ();
+ if (st == (omp_st == ST_OMP_DO ? ST_OMP_END_DO : ST_OMP_END_PARALLEL_DO))
+ {
+ gcc_assert (new_st.op == EXEC_OMP_END_NOWAIT);
+ cp->ext.omp_clauses->nowait |= new_st.ext.omp_bool;
+ gfc_clear_new_st ();
+ st = next_statement ();
+ }
+
+ pop_state ();
+ 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
@@ -2050,9 +2514,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)
@@ -2092,38 +2555,60 @@ 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);
continue;
+ case ST_OMP_ATOMIC:
+ parse_omp_atomic ();
+ break;
+
default:
- break;
+ return st;
}
- break;
+ st = next_statement ();
}
-
- return st;
}
--- gcc/fortran/parse.h.jj 2005-09-13 15:16:42.000000000 +0200
+++ gcc/fortran/parse.h 2005-09-17 23:02:05.000000000 +0200
@@ -1,5 +1,5 @@
/* Parser header
- Copyright (C) 2003 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2005 Free Software Foundation, Inc.
Contributed by Steven Bosscher
This file is part of GCC.
@@ -30,7 +30,8 @@ typedef enum
{
COMP_NONE, COMP_PROGRAM, COMP_MODULE, COMP_SUBROUTINE, COMP_FUNCTION,
COMP_BLOCK_DATA, COMP_INTERFACE, COMP_DERIVED, COMP_IF, COMP_DO,
- COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS
+ COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS,
+ COMP_OMP_STRUCTURED_BLOCK
}
gfc_compile_state;
--- gcc/c-cppbuiltin.c.jj 2005-09-13 15:12:33.000000000 +0200
+++ gcc/c-cppbuiltin.c 2005-09-17 23:02:05.000000000 +0200
@@ -448,6 +448,9 @@ c_cpp_builtins (cpp_reader *pfile)
else if (flag_stack_protect == 1)
cpp_define (pfile, "__SSP__=1");
+ if (flag_openmp)
+ cpp_define (pfile, "_OPENMP=200505");
+
/* A straightforward target hook doesn't work, because of problems
linking that hook's body when part of non-C front ends. */
# define preprocessing_asm_p() (cpp_get_options (pfile)->lang == CLK_ASM)
--- libgomp/libgomp_f.h.in.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/libgomp_f.h.in 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,62 @@
+/* Copyright (C) 2005 Free Software Foundation, Inc.
+ Contributed by Jakub Jelinek <jakub@redhat.com>.
+
+ This file is part of the GNU OpenMP Library (libgomp).
+
+ Libgomp is free software; you can redistribute it and/or modify it
+ under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation; either version 2.1 of the License, or
+ (at your option) any later version.
+
+ Libgomp 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 Lesser General Public License for
+ more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with libgomp; see the file COPYING.LIB. If not, write to the
+ Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ MA 02111-1307, USA. */
+
+/* As a special exception, if you link this library with other files, some
+ of which are compiled with GCC, to produce an executable, this library
+ does not by itself cause the resulting executable to be covered by the
+ GNU General Public License. This exception does not however invalidate
+ any other reasons why the executable file might be covered by the GNU
+ General Public License. */
+
+/* This file contains prototypes of functions in the external ABI.
+ This file is included by files in the testsuite. */
+
+#ifndef LIBGOMP_F_H
+#define LIBGOMP_F_H 1
+
+#include "libgomp.h"
+#if HAVE_STDINT_H
+#include <stdint.h>
+#endif
+#if HAVE_INTTYPES_H
+#include <inttypes.h>
+#endif
+
+#if (OMP_LOCK_SIZE == OMP_LOCK_KIND) \
+ && (OMP_LOCK_ALIGN <= OMP_LOCK_SIZE)
+# define OMP_LOCK_DIRECT
+typedef omp_lock_t *omp_lock_arg_t;
+# define omp_lock_arg(arg) (arg)
+#else
+typedef union { omp_lock_t *lock; uint64_t u; } *omp_lock_arg_t;
+# define omp_lock_arg(arg) ((arg)->lock)
+# endif
+
+#if (OMP_NEST_LOCK_SIZE == OMP_NEST_LOCK_KIND) \
+ && (OMP_NEST_LOCK_ALIGN <= OMP_NEST_LOCK_SIZE)
+# define OMP_NEST_LOCK_DIRECT
+typedef omp_nest_lock_t *omp_nest_lock_arg_t;
+# define omp_nest_lock_arg(arg) (arg)
+#else
+typedef union { omp_nest_lock_t *lock; uint64_t u; } *omp_nest_lock_arg_t;
+# define omp_nest_lock_arg(arg) ((arg)->lock)
+# endif
+
+#endif /* LIBGOMP_F_H */
--- libgomp/omp_lib.h.in.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/omp_lib.h.in 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,53 @@
+! Copyright (C) 2005 Free Software Foundation, Inc.
+! Contributed by Jakub Jelinek <jakub@redhat.com>.
+
+! This file is part of the GNU OpenMP Library (libgomp).
+
+! Libgomp is free software; you can redistribute it and/or modify it
+! under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or
+! (at your option) any later version.
+
+! Libgomp 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 Lesser General Public License for
+! more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with libgomp; see the file COPYING.LIB. If not, write to the
+! Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA. */
+
+! As a special exception, if you link this library with other files, some
+! of which are compiled with GCC, to produce an executable, this library
+! does not by itself cause the resulting executable to be covered by the
+! GNU General Public License. This exception does not however invalidate
+! any other reasons why the executable file might be covered by the GNU
+! General Public License.
+
+ integer omp_lock_kind, omp_nest_lock_kind, openmp_version
+ parameter (omp_lock_kind = OMP_LOCK_KIND)
+ parameter (omp_nest_lock_kind = OMP_NEST_LOCK_KIND)
+ parameter (openmp_version = 200505)
+
+ external omp_init_lock, omp_init_nest_lock
+ external omp_destroy_lock, omp_destroy_nest_lock
+ external omp_set_lock, omp_set_nest_lock
+ external omp_unset_lock, omp_unset_nest_lock
+ external omp_set_dynamic, omp_set_nested
+ external omp_set_num_threads
+
+ external omp_get_dynamic, omp_get_nested
+ logical*4 omp_get_dynamic, omp_get_nested
+ external omp_test_lock, omp_in_parallel
+ logical*4 omp_test_lock, omp_in_parallel
+
+ external omp_get_max_threads, omp_get_num_procs
+ integer*4 omp_get_max_threads, omp_get_num_procs
+ external omp_get_num_threads, omp_get_thread_num
+ integer*4 omp_get_num_threads, omp_get_thread_num
+ external omp_test_nest_lock
+ integer*4 omp_test_nest_lock
+
+ external omp_get_wtick, omp_get_wtime
+ double precision omp_get_wtick, omp_get_wtime
--- libgomp/configure.ac.jj 2005-06-14 00:13:10.000000000 +0200
+++ libgomp/configure.ac 2005-09-19 12:03:18.000000000 +0200
@@ -117,6 +117,13 @@ AM_PROG_LIBTOOL
AC_SUBST(enable_shared)
AC_SUBST(enable_static)
+# We need gfortran to compile parts of the library
+# We can't use AC_PROG_FC because it expects a fully working gfortran.
+#AC_PROG_FC(gfortran)
+FC="$GFORTRAN"
+AC_PROG_FC(gfortran)
+FCFLAGS="$FCFLAGS -Wall"
+
# For libtool versioning info, format is CURRENT:REVISION:AGE
libtool_VERSION=1:0:0
AC_SUBST(libtool_VERSION)
@@ -173,5 +180,7 @@ else
multilib_arg=
fi
+AM_CONDITIONAL([USE_FORTRAN], [test "$ac_cv_fc_compiler_gnu" = yes])
+
AC_CONFIG_FILES(Makefile testsuite/Makefile)
AC_OUTPUT
--- libgomp/mkomp_h.pl.jj 2005-06-14 00:13:10.000000000 +0200
+++ libgomp/mkomp_h.pl 2005-09-17 23:02:05.000000000 +0200
@@ -94,6 +94,14 @@ $sizeof_omp_lock_t = resolve ("sizeof",
$alignof_omp_lock_t = resolve ("__alignof", "omp_lock_t");
$sizeof_omp_nest_lock_t = resolve ("sizeof", "omp_nest_lock_t");
$alignof_omp_nest_lock_t = resolve ("__alignof", "omp_nest_lock_t");
+$omp_lock_kind = $sizeof_omp_lock_t;
+$omp_nest_lock_kind = $sizeof_omp_nest_lock_t;
+if ($sizeof_omp_lock_t >= 8 || $alignof_omp_lock_t > $sizeof_omp_lock_t) {
+ $omp_lock_kind = 8;
+}
+if ($sizeof_omp_nest_lock_t >= 8 || $alignof_omp_nest_lock_t > $sizeof_omp_nest_lock_t) {
+ $omp_nest_lock_kind = 8;
+}
# Edit the input template into the output.
open IN, "<", $INFILE;
@@ -103,6 +111,8 @@ while (<IN>) {
s/OMP_LOCK_ALIGN/$alignof_omp_lock_t/o;
s/OMP_NEST_LOCK_SIZE/$sizeof_omp_nest_lock_t/o;
s/OMP_NEST_LOCK_ALIGN/$alignof_omp_nest_lock_t/o;
+ s/OMP_LOCK_KIND/$omp_lock_kind/o;
+ s/OMP_NEST_LOCK_KIND/$omp_nest_lock_kind/o;
print OUT;
}
--- libgomp/Makefile.am.jj 2005-06-14 00:13:07.000000000 +0200
+++ libgomp/Makefile.am 2005-09-19 12:04:20.000000000 +0200
@@ -29,8 +29,26 @@ libgomp_la_LDFLAGS = $(libgomp_version_i
libgomp_la_SOURCES = alloc.c barrier.c critical.c env.c error.c iter.c \
loop.c ordered.c parallel.c sections.c single.c team.c work.c \
- lock.c mutex.c proc.c sem.c time.c
+ lock.c mutex.c proc.c sem.c time.c fortran.c
-nodist_include_HEADERS = omp.h
+nodist_include_HEADERS = omp.h omp_lib.h omp_lib.f90 libgomp_f.h
+if USE_FORTRAN
+nodist_include_HEADERS += omp_lib.mod omp_lib_kinds.mod
+endif
omp.h: omp.h.in mkomp_h.pl
$(PERL) -w $(srcdir)/mkomp_h.pl "$(COMPILE)" $(srcdir)/omp.h.in omp.h
+omp_lib.h: omp_lib.h.in mkomp_h.pl
+ $(PERL) -w $(srcdir)/mkomp_h.pl "$(COMPILE)" $(srcdir)/omp_lib.h.in \
+ omp_lib.h
+omp_lib.f90: omp_lib.f90.in mkomp_h.pl
+ $(PERL) -w $(srcdir)/mkomp_h.pl "$(COMPILE)" $(srcdir)/omp_lib.f90.in \
+ omp_lib.f90
+libgomp_f.h: libgomp_f.h.in mkomp_h.pl
+ $(PERL) -w $(srcdir)/mkomp_h.pl "$(COMPILE)" $(srcdir)/libgomp_f.h.in \
+ libgomp_f.h
+omp_lib_kinds.mod: omp_lib.mod
+ :
+omp_lib.mod: omp_lib.f90
+ $(FC) $(FCFLAGS) -fsyntax-only omp_lib.f90
+fortran.lo: libgomp_f.h
+fortran.o: libgomp_f.h
--- libgomp/omp_lib.f90.in.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/omp_lib.f90.in 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,199 @@
+! Copyright (C) 2005 Free Software Foundation, Inc.
+! Contributed by Jakub Jelinek <jakub@redhat.com>.
+
+! This file is part of the GNU OpenMP Library (libgomp).
+
+! Libgomp is free software; you can redistribute it and/or modify it
+! under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or
+! (at your option) any later version.
+
+! Libgomp 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 Lesser General Public License for
+! more details.
+
+! You should have received a copy of the GNU Lesser General Public License
+! along with libgomp; see the file COPYING.LIB. If not, write to the
+! Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+! MA 02111-1307, USA. */
+
+! As a special exception, if you link this library with other files, some
+! of which are compiled with GCC, to produce an executable, this library
+! does not by itself cause the resulting executable to be covered by the
+! GNU General Public License. This exception does not however invalidate
+! any other reasons why the executable file might be covered by the GNU
+! General Public License.
+
+ module omp_lib_kinds
+ 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
+ end module
+
+ module omp_lib
+ use omp_lib_kinds
+ integer, parameter :: openmp_version = 200505
+
+ interface
+ subroutine omp_init_lock (lock)
+ use omp_lib_kinds
+ integer (omp_lock_kind), intent (out) :: lock
+ end subroutine omp_init_lock
+ end interface
+
+ interface
+ subroutine omp_init_nest_lock (lock)
+ use omp_lib_kinds
+ integer (omp_nest_lock_kind), intent (out) :: lock
+ end subroutine omp_init_nest_lock
+ end interface
+
+ interface
+ subroutine omp_destroy_lock (lock)
+ use omp_lib_kinds
+ integer (omp_lock_kind), intent (inout) :: lock
+ end subroutine omp_destroy_lock
+ end interface
+
+ interface
+ subroutine omp_destroy_nest_lock (lock)
+ use omp_lib_kinds
+ integer (omp_nest_lock_kind), intent (inout) :: lock
+ end subroutine omp_destroy_nest_lock
+ end interface
+
+ interface
+ subroutine omp_set_lock (lock)
+ use omp_lib_kinds
+ integer (omp_lock_kind), intent (inout) :: lock
+ end subroutine omp_set_lock
+ end interface
+
+ interface
+ subroutine omp_set_nest_lock (lock)
+ use omp_lib_kinds
+ integer (omp_nest_lock_kind), intent (inout) :: lock
+ end subroutine omp_set_nest_lock
+ end interface
+
+ interface
+ subroutine omp_unset_lock (lock)
+ use omp_lib_kinds
+ integer (omp_lock_kind), intent (inout) :: lock
+ end subroutine omp_unset_lock
+ end interface
+
+ interface
+ subroutine omp_unset_nest_lock (lock)
+ use omp_lib_kinds
+ integer (omp_nest_lock_kind), intent (inout) :: lock
+ end subroutine omp_unset_nest_lock
+ end interface
+
+ interface omp_set_dynamic
+ subroutine omp_set_dynamic (set)
+ logical (4), intent (in) :: set
+ end subroutine omp_set_dynamic
+ subroutine omp_set_dynamic_8 (set)
+ logical (8), intent (in) :: set
+ end subroutine omp_set_dynamic_8
+ end interface
+
+ interface omp_set_nested
+ subroutine omp_set_nested (set)
+ logical (4), intent (in) :: set
+ end subroutine omp_set_nested
+ subroutine omp_set_nested_8 (set)
+ logical (8), intent (in) :: set
+ end subroutine omp_set_nested_8
+ end interface
+
+ interface omp_set_num_threads
+ subroutine omp_set_num_threads (set)
+ integer (4), intent (in) :: set
+ end subroutine omp_set_num_threads
+ subroutine omp_set_num_threads_8 (set)
+ integer (8), intent (in) :: set
+ end subroutine omp_set_num_threads_8
+ end interface
+
+ interface
+ function omp_get_dynamic ()
+ use omp_lib_kinds
+ logical (omp_logical_kind) :: 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
+ end function omp_get_nested
+ end interface
+
+ interface
+ function omp_in_parallel ()
+ use omp_lib_kinds
+ logical (omp_logical_kind) :: 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
+ integer (omp_nest_lock_kind), intent (inout) :: lock
+ end function omp_test_lock
+ end interface
+
+ interface
+ function omp_get_max_threads ()
+ use omp_lib_kinds
+ integer (omp_integer_kind) :: 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
+ 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
+ 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
+ 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 (omp_nest_lock_kind), intent (inout) :: lock
+ end function omp_test_nest_lock
+ end interface
+
+ interface
+ function omp_get_wtick ()
+ double precision :: omp_get_wtick
+ end function omp_get_wtick
+ end interface
+
+ interface
+ function omp_get_wtime ()
+ double precision :: omp_get_wtime
+ end function omp_get_wtime
+ end interface
+
+ end module omp_lib
--- libgomp/fortran.c.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/fortran.c 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,195 @@
+/* Copyright (C) 2005 Free Software Foundation, Inc.
+ Contributed by Jakub Jelinek <jakub@redhat.com>.
+
+ This file is part of the GNU OpenMP Library (libgomp).
+
+ Libgomp is free software; you can redistribute it and/or modify it
+ under the terms of the GNU Lesser General Public License as published by
+ the Free Software Foundation; either version 2.1 of the License, or
+ (at your option) any later version.
+
+ Libgomp 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 Lesser General Public License for
+ more details.
+
+ You should have received a copy of the GNU Lesser General Public License
+ along with libgomp; see the file COPYING.LIB. If not, write to the
+ Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ MA 02111-1307, USA. */
+
+/* As a special exception, if you link this library with other files, some
+ of which are compiled with GCC, to produce an executable, this library
+ does not by itself cause the resulting executable to be covered by the
+ GNU General Public License. This exception does not however invalidate
+ any other reasons why the executable file might be covered by the GNU
+ General Public License. */
+
+/* This file contains Fortran wrapper routines. */
+
+#include "libgomp.h"
+#include "libgomp_f.h"
+
+void
+omp_init_lock_ (omp_lock_arg_t lock)
+{
+#ifndef OMP_LOCK_DIRECT
+ omp_lock_arg (lock) = malloc (sizeof (omp_lock_t));
+#endif
+ omp_init_lock (omp_lock_arg (lock));
+}
+
+void
+omp_init_nest_lock_ (omp_nest_lock_arg_t lock)
+{
+#ifndef OMP_NEST_LOCK_DIRECT
+ omp_nest_lock_arg (lock) = malloc (sizeof (omp_nest_lock_t));
+#endif
+ omp_init_nest_lock (omp_nest_lock_arg (lock));
+}
+
+void
+omp_destroy_lock_ (omp_lock_arg_t lock)
+{
+ omp_destroy_lock (omp_lock_arg (lock));
+#ifndef OMP_LOCK_DIRECT
+ free (omp_lock_arg (lock));
+ omp_lock_arg (lock) = NULL;
+#endif
+}
+
+void
+omp_destroy_nest_lock_ (omp_nest_lock_arg_t lock)
+{
+ omp_destroy_nest_lock (omp_nest_lock_arg (lock));
+#ifndef OMP_NEST_LOCK_DIRECT
+ free (omp_nest_lock_arg (lock));
+ omp_nest_lock_arg (lock) = NULL;
+#endif
+}
+
+void
+omp_set_lock_ (omp_lock_arg_t lock)
+{
+ omp_set_lock (omp_lock_arg (lock));
+}
+
+void
+omp_set_nest_lock_ (omp_nest_lock_arg_t lock)
+{
+ omp_set_nest_lock (omp_nest_lock_arg (lock));
+}
+
+void
+omp_unset_lock_ (omp_lock_arg_t lock)
+{
+ omp_unset_lock (omp_lock_arg (lock));
+}
+
+void
+omp_unset_nest_lock_ (omp_nest_lock_arg_t lock)
+{
+ omp_unset_nest_lock (omp_nest_lock_arg (lock));
+}
+
+void
+omp_set_dynamic_ (const int32_t *set)
+{
+ omp_set_dynamic (*set);
+}
+
+void
+omp_set_dynamic_8_ (const int64_t *set)
+{
+ omp_set_dynamic (*set);
+}
+
+void
+omp_set_nested_ (const int32_t *set)
+{
+ omp_set_nested (*set);
+}
+
+void
+omp_set_nested_8_ (const int64_t *set)
+{
+ omp_set_nested (*set);
+}
+
+void
+omp_set_num_threads_ (const int32_t *set)
+{
+ omp_set_num_threads (*set);
+}
+
+void
+omp_set_num_threads_8_ (const int64_t *set)
+{
+ omp_set_num_threads (*set);
+}
+
+int32_t
+omp_get_dynamic_ (void)
+{
+ return omp_get_dynamic ();
+}
+
+int32_t
+omp_get_nested_ (void)
+{
+ return omp_get_nested ();
+}
+
+int32_t
+omp_in_parallel_ (void)
+{
+ return omp_in_parallel ();
+}
+
+int32_t
+omp_test_lock_ (omp_lock_arg_t lock)
+{
+ return omp_test_lock (omp_lock_arg (lock));
+}
+
+int32_t
+omp_get_max_threads_ (void)
+{
+ return omp_get_max_threads ();
+}
+
+int32_t
+omp_get_num_procs_ (void)
+{
+ return omp_get_num_procs ();
+}
+
+int32_t
+omp_get_num_threads_ (void)
+{
+ return omp_get_num_threads ();
+}
+
+int32_t
+omp_get_thread_num_ (void)
+{
+ return omp_get_thread_num ();
+}
+
+int32_t
+omp_test_nest_lock_ (omp_nest_lock_arg_t lock)
+{
+ return omp_test_nest_lock_ (omp_nest_lock_arg (lock));
+}
+
+double
+omp_get_wtick_ (void)
+{
+ return omp_get_wtick ();
+}
+
+double
+omp_get_wtime_ (void)
+{
+ return omp_get_wtime ();
+}
--- libgomp/Makefile.in.jj 2005-09-13 16:17:49.000000000 +0200
+++ libgomp/Makefile.in 2005-09-19 12:05:30.000000000 +0200
@@ -39,6 +39,7 @@ POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
target_triplet = @target@
+@USE_FORTRAN_TRUE@am__append_1 = omp_lib.mod omp_lib_kinds.mod
DIST_COMMON = $(am__configure_deps) $(srcdir)/../config.guess \
$(srcdir)/../config.sub $(srcdir)/../depcomp \
$(srcdir)/../install-sh $(srcdir)/../ltmain.sh \
@@ -71,7 +72,7 @@ libgomp_la_LIBADD =
am_libgomp_la_OBJECTS = alloc.lo barrier.lo critical.lo env.lo \
error.lo iter.lo loop.lo ordered.lo parallel.lo sections.lo \
single.lo team.lo work.lo lock.lo mutex.lo proc.lo sem.lo \
- time.lo
+ time.lo fortran.lo
libgomp_la_OBJECTS = $(am_libgomp_la_OBJECTS)
DEFAULT_INCLUDES = -I. -I$(srcdir) -I.
depcomp = $(SHELL) $(top_srcdir)/../depcomp
@@ -137,10 +138,13 @@ ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
+FC = @FC@
+FCFLAGS = @FCFLAGS@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+LDFLAGS = @LDFLAGS@
LIBGOMP_BUILD_VERSIONED_SHLIB_FALSE = @LIBGOMP_BUILD_VERSIONED_SHLIB_FALSE@
LIBGOMP_BUILD_VERSIONED_SHLIB_TRUE = @LIBGOMP_BUILD_VERSIONED_SHLIB_TRUE@
LIBOBJS = @LIBOBJS@
@@ -164,11 +168,14 @@ SECTION_LDFLAGS = @SECTION_LDFLAGS@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
+USE_FORTRAN_FALSE = @USE_FORTRAN_FALSE@
+USE_FORTRAN_TRUE = @USE_FORTRAN_TRUE@
VERSION = @VERSION@
XCFLAGS = @XCFLAGS@
XLDFLAGS = @XLDFLAGS@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
+ac_ct_FC = @ac_ct_FC@
ac_ct_RANLIB = @ac_ct_RANLIB@
ac_ct_STRIP = @ac_ct_STRIP@
am__fastdepCC_FALSE = @am__fastdepCC_FALSE@
@@ -233,9 +240,10 @@ libgomp_version_info = -version-info $(l
libgomp_la_LDFLAGS = $(libgomp_version_info) $(libgomp_version_script) -lpthread
libgomp_la_SOURCES = alloc.c barrier.c critical.c env.c error.c iter.c \
loop.c ordered.c parallel.c sections.c single.c team.c work.c \
- lock.c mutex.c proc.c sem.c time.c
+ lock.c mutex.c proc.c sem.c time.c fortran.c
-nodist_include_HEADERS = omp.h
+nodist_include_HEADERS = omp.h omp_lib.h omp_lib.f90 libgomp_f.h \
+ $(am__append_1)
all: config.h
$(MAKE) $(AM_MAKEFLAGS) all-recursive
@@ -332,6 +340,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/critical.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/env.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/error.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fortran.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iter.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lock.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/loop.Plo@am__quote@
@@ -798,6 +807,21 @@ uninstall-info: uninstall-info-recursive
omp.h: omp.h.in mkomp_h.pl
$(PERL) -w $(srcdir)/mkomp_h.pl "$(COMPILE)" $(srcdir)/omp.h.in omp.h
+omp_lib.h: omp_lib.h.in mkomp_h.pl
+ $(PERL) -w $(srcdir)/mkomp_h.pl "$(COMPILE)" $(srcdir)/omp_lib.h.in \
+ omp_lib.h
+omp_lib.f90: omp_lib.f90.in mkomp_h.pl
+ $(PERL) -w $(srcdir)/mkomp_h.pl "$(COMPILE)" $(srcdir)/omp_lib.f90.in \
+ omp_lib.f90
+libgomp_f.h: libgomp_f.h.in mkomp_h.pl
+ $(PERL) -w $(srcdir)/mkomp_h.pl "$(COMPILE)" $(srcdir)/libgomp_f.h.in \
+ libgomp_f.h
+omp_lib_kinds.mod: omp_lib.mod
+ :
+omp_lib.mod: omp_lib.f90
+ $(FC) $(FCFLAGS) -fsyntax-only omp_lib.f90
+fortran.lo: libgomp_f.h
+fortran.o: libgomp_f.h
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
--- libgomp/libgomp.map.jj 2005-06-14 00:13:10.000000000 +0200
+++ libgomp/libgomp.map 2005-09-17 23:02:05.000000000 +0200
@@ -20,6 +20,29 @@ OMP_1.0 {
omp_unset_nest_lock;
omp_test_lock;
omp_test_nest_lock;
+ omp_destroy_lock_;
+ omp_destroy_nest_lock_;
+ omp_get_dynamic_;
+ omp_get_max_threads_;
+ omp_get_nested_;
+ omp_get_num_procs_;
+ omp_get_num_threads_;
+ omp_get_thread_num_;
+ omp_in_parallel_;
+ omp_init_lock_;
+ omp_init_nest_lock_;
+ omp_set_dynamic_;
+ omp_set_dynamic_8_;
+ omp_set_lock_;
+ omp_set_nest_lock_;
+ omp_set_nested_;
+ omp_set_nested_8_;
+ omp_set_num_threads_;
+ omp_set_num_threads_8_;
+ omp_test_lock_;
+ omp_test_nest_lock_;
+ omp_unset_lock_;
+ omp_unset_nest_lock_;
local:
*;
};
@@ -28,6 +51,8 @@ OMP_2.0 {
global:
omp_get_wtick;
omp_get_wtime;
+ omp_get_wtick_;
+ omp_get_wtime_;
} OMP_1.0;
GOMP_1.0 {
--- libgomp/testsuite/libgomp.fortran/omp_cond1.f.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_cond1.f 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,22 @@
+C Test conditional compilation in fixed form if -fopenmp
+! { dg-options "-fopenmp" }
+ 10 foo = 2
+ &56
+ if (foo.ne.256) call abort
+ bar = 26
+!$2 0 ba
+c$ +r = 42
+ !$ bar = 62
+!$ bar = bar + 1
+ if (bar.ne.43) call abort
+ baz = bar
+*$ 0baz = 5
+C$ +12! Comment
+c$ !4
+!$ +!Another comment
+*$ &2
+!$ X baz = 0 ! Not valid OpenMP conditional compilation lines
+! $ baz = 1
+c$ 10&baz = 2
+ if (baz.ne.51242) call abort
+ end
--- libgomp/testsuite/libgomp.fortran/omp_workshare2.f.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_workshare2.f 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,56 @@
+C******************************************************************************
+C FILE: omp_workshare2.f
+C DESCRIPTION:
+C OpenMP Example - Sections Work-sharing - Fortran Version
+C In this example, the OpenMP SECTION directive is used to assign
+C different array operations to threads that execute a SECTION. Each
+C thread receives its own copy of the result array to work with.
+C AUTHOR: Blaise Barney 5/99
+C LAST REVISED: 01/09/04
+C******************************************************************************
+
+ PROGRAM WORKSHARE2
+
+ INTEGER N, I, NTHREADS, TID, OMP_GET_NUM_THREADS,
+ + OMP_GET_THREAD_NUM
+ PARAMETER (N=50)
+ REAL A(N), B(N), C(N)
+
+! Some initializations
+ DO I = 1, N
+ A(I) = I * 1.0
+ B(I) = A(I)
+ ENDDO
+
+!$OMP PARALLEL SHARED(A,B,NTHREADS), PRIVATE(C,I,TID)
+ TID = OMP_GET_THREAD_NUM()
+ IF (TID .EQ. 0) THEN
+ NTHREADS = OMP_GET_NUM_THREADS()
+ PRINT *, 'Number of threads =', NTHREADS
+ END IF
+ PRINT *, 'Thread',TID,' starting...'
+
+!$OMP SECTIONS
+
+!$OMP SECTION
+ PRINT *, 'Thread',TID,' doing section 1'
+ DO I = 1, N
+ C(I) = A(I) + B(I)
+ WRITE(*,100) TID,I,C(I)
+ 100 FORMAT(' Thread',I2,': C(',I2,')=',F8.2)
+ ENDDO
+
+!$OMP SECTION
+ PRINT *, 'Thread',TID,' doing section 2'
+ DO I = 1+N/2, N
+ C(I) = A(I) * B(I)
+ WRITE(*,100) TID,I,C(I)
+ ENDDO
+
+!$OMP END SECTIONS NOWAIT
+
+ PRINT *, 'Thread',TID,' done.'
+
+!$OMP END PARALLEL
+
+ END
--- libgomp/testsuite/libgomp.fortran/fortran.exp.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/fortran.exp 2005-09-19 12:14:20.000000000 +0200
@@ -0,0 +1,34 @@
+load_lib libgomp-dg.exp
+
+# If a testcase doesn't have special options, use these.
+if ![info exists DEFAULT_FFLAGS] then {
+ set DEFAULT_FFLAGS "-O2 -fopenmp"
+}
+
+# Initialize dg.
+dg-init
+
+global ALWAYS_CFLAGS
+
+lappend ALWAYS_CFLAGS "-lgfortranbegin -lgfortran"
+
+global TOOL_OPTIONS
+
+if [info exists TOOL_OPTIONS] {
+ set multilibs [get_multilibs $TOOL_OPTIONS]
+} else {
+ set multilibs [get_multilibs]
+}
+set blddir [lookfor_file $multilibs libgomp]
+
+if [file exists "${blddir}/../libgfortran/.libs/libgfortranbegin.a"] {
+
+ # Gather a list of all tests.
+ set tests [lsort [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95}]]
+
+ # Main loop.
+ gfortran-dg-runtest $tests $DEFAULT_FFLAGS
+}
+
+# All done.
+dg-finish
--- libgomp/testsuite/libgomp.fortran/omp_workshare1.f.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_workshare1.f 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,48 @@
+C******************************************************************************
+C FILE: omp_workshare1.f
+C DESCRIPTION:
+C OpenMP Example - Loop Work-sharing - Fortran Version
+C In this example, the iterations of a loop are scheduled dynamically
+C across the team of threads. A thread will perform CHUNK iterations
+C at a time before being scheduled for the next CHUNK of work.
+C AUTHOR: Blaise Barney 5/99
+C LAST REVISED: 01/09/04
+C******************************************************************************
+
+ PROGRAM WORKSHARE1
+
+ INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS,
+ + OMP_GET_THREAD_NUM, N, CHUNKSIZE, CHUNK, I
+ PARAMETER (N=100)
+ PARAMETER (CHUNKSIZE=10)
+ REAL A(N), B(N), C(N)
+
+! Some initializations
+ DO I = 1, N
+ A(I) = I * 1.0
+ B(I) = A(I)
+ ENDDO
+ CHUNK = CHUNKSIZE
+
+!$OMP PARALLEL SHARED(A,B,C,NTHREADS,CHUNK) PRIVATE(I,TID)
+
+ TID = OMP_GET_THREAD_NUM()
+ IF (TID .EQ. 0) THEN
+ NTHREADS = OMP_GET_NUM_THREADS()
+ PRINT *, 'Number of threads =', NTHREADS
+ END IF
+ PRINT *, 'Thread',TID,' starting...'
+
+!$OMP DO SCHEDULE(DYNAMIC,CHUNK)
+ DO I = 1, N
+ C(I) = A(I) + B(I)
+ WRITE(*,100) TID,I,C(I)
+ 100 FORMAT(' Thread',I2,': C(',I3,')=',F8.2)
+ ENDDO
+!$OMP END DO NOWAIT
+
+ PRINT *, 'Thread',TID,' done.'
+
+!$OMP END PARALLEL
+
+ END
--- libgomp/testsuite/libgomp.fortran/omp_hello.f.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_hello.f 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,36 @@
+C******************************************************************************
+C FILE: omp_hello.f
+C DESCRIPTION:
+C OpenMP Example - Hello World - Fortran Version
+C In this simple example, the master thread forks a parallel region.
+C All threads in the team obtain their unique thread number and print it.
+C The master thread only prints the total number of threads. Two OpenMP
+C library routines are used to obtain the number of threads and each
+C thread's number.
+C AUTHOR: Blaise Barney 5/99
+C LAST REVISED:
+C******************************************************************************
+
+ PROGRAM HELLO
+
+ INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS,
+ + OMP_GET_THREAD_NUM
+
+C Fork a team of threads giving them their own copies of variables
+!$OMP PARALLEL PRIVATE(NTHREADS, TID)
+
+
+C Obtain thread number
+ TID = OMP_GET_THREAD_NUM()
+ PRINT *, 'Hello World from thread = ', TID
+
+C Only master thread does this
+ IF (TID .EQ. 0) THEN
+ NTHREADS = OMP_GET_NUM_THREADS()
+ PRINT *, 'Number of threads = ', NTHREADS
+ END IF
+
+C All threads join master thread and disband
+!$OMP END PARALLEL
+
+ END
--- libgomp/testsuite/libgomp.fortran/omp_cond4.F90.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_cond4.F90 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,24 @@
+! Test conditional compilation in free form if -fno-openmp
+! { dg-options "-fno-openmp" }
+ 10 foo = 2&
+ &56
+ if (foo.ne.256) call abort
+ bar = 26
+ !$ 20 ba&
+!$ &r = 4&
+ !$2
+ !$bar = 62
+ !$ bar = bar + 2
+#ifdef _OPENMP
+bar = bar - 1
+#endif
+ if (bar.ne.26) call abort
+ baz = bar
+!$ 30 baz = 5& ! Comment
+!$12 &
+ !$ + 2
+!$X baz = 0 ! Not valid OpenMP conditional compilation lines
+! $ baz = 1
+baz = baz + 1 !$ baz = 2
+ if (baz.ne.27) call abort
+ end
--- libgomp/testsuite/libgomp.fortran/omp_reduction.f.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_reduction.f 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,33 @@
+C******************************************************************************
+C FILE: omp_reduction.f
+C DESCRIPTION:
+C OpenMP Example - Combined Parallel Loop Reduction - Fortran Version
+C This example demonstrates a sum reduction within a combined parallel loop
+C construct. Notice that default data element scoping is assumed - there
+C are no clauses specifying shared or private variables. OpenMP will
+C automatically make loop index variables private within team threads, and
+C global variables shared.
+C AUTHOR: Blaise Barney 5/99
+C LAST REVISED:
+C******************************************************************************
+
+ PROGRAM REDUCTION
+
+ INTEGER I, N
+ REAL A(100), B(100), SUM
+
+! Some initializations
+ N = 100
+ DO I = 1, N
+ A(I) = I *1.0
+ B(I) = A(I)
+ ENDDO
+ SUM = 0.0
+
+!$OMP PARALLEL DO REDUCTION(+:SUM)
+ DO I = 1, N
+ SUM = SUM + (A(I) * B(I))
+ ENDDO
+
+ PRINT *, ' Sum = ', SUM
+ END
--- libgomp/testsuite/libgomp.fortran/omp_parse4.f90.jj 2005-09-19 17:48:02.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_parse4.f90 2005-09-19 18:44:24.000000000 +0200
@@ -0,0 +1,72 @@
+! { dg-do run }
+!$ use omp_lib
+ call test_workshare
+
+contains
+ subroutine test_workshare
+ integer :: i, j, k, l, m
+ double precision, dimension (64) :: d, e
+ integer, dimension (10) :: f, g
+ integer, dimension (16, 16) :: a, b, c
+ integer, dimension (16) :: n
+ d(:) = 1
+ e = 7
+ f = 10
+ l = 256
+ m = 512
+ g(1:3) = -1
+ g(4:6) = 0
+ g(7:8) = 5
+ g(9:10) = 10
+ forall (i = 1:16, j = 1:16) a (i, j) = i * 16 + j
+!$omp parallel num_threads (4) private (j, k)
+!$omp barrier
+!$omp workshare
+ i = 6
+ e(:) = d(:)
+ where (g .lt. 0)
+ f = 100
+ elsewhere (g .eq. 0)
+ f = 200 + f
+ elsewhere
+ where (g .gt. 6) f = f + sum (g)
+ f = 300 + f
+ end where
+ where (f .gt. 210) g = 0
+ forall (j = 1:16) n (j) = j
+!$omp end workshare nowait
+!$omp workshare
+ forall (j = 1:16, k = 1:16) b (k, j) = a (j, k)
+ forall (k = 1:16) c (k, 1:16) = a (1:16, k)
+ forall (j = 2:16, n (17 - j) / 4 * 4 .ne. n (17 - j))
+ n (j) = n (j - 1) * n (j)
+ end forall
+!$omp endworkshare
+!$omp workshare
+!$omp atomic
+ i = i + 8 + 6
+!$omp critical
+!$omp critical (critical_foox)
+ l = 128
+!$omp end critical (critical_foox)
+!$omp endcritical
+!$omp parallel num_threads (2)
+!$ if (omp_get_thread_num () .eq. 0) m = omp_get_num_threads ()
+!$omp atomic
+ l = 1 + l
+!$omp end parallel
+!$omp end workshare
+!$omp end parallel
+
+ if (any (f .ne. (/100, 100, 100, 210, 210, 210, 310, 310, 337, 337/))) &
+& call abort
+ if (any (g .ne. (/-1, -1, -1, 0, 0, 0, 0, 0, 0, 0/))) call abort
+ if (i .ne. 20) call abort
+!$ if (l .ne. 128 + m) call abort
+ if (any (d .ne. 1 .or. e .ne. 1)) call abort
+ if (any (b .ne. transpose (a))) call abort
+ if (any (c .ne. b)) call abort
+ if (any (n .ne. (/1, 2, 6, 12, 5, 30, 42, 56, 9, 90, &
+& 110, 132, 13, 182, 210, 240/))) call abort
+ end subroutine test_workshare
+end
--- libgomp/testsuite/libgomp.fortran/omp_cond3.F90.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_cond3.F90 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,24 @@
+! Test conditional compilation in free form if -fopenmp
+! { dg-options "-fopenmp" }
+ 10 foo = 2&
+ &56
+ if (foo.ne.256) call abort
+ bar = 26
+ !$ 20 ba&
+!$ &r = 4&
+ !$2
+ !$bar = 62
+ !$ bar = bar + 2
+#ifdef _OPENMP
+bar = bar - 1
+#endif
+ if (bar.ne.43) call abort
+ baz = bar
+!$ 30 baz = 5& ! Comment
+!$12 &
+ !$ + 2
+!$X baz = 0 ! Not valid OpenMP conditional compilation lines
+! $ baz = 1
+baz = baz + 1 !$ baz = 2
+ if (baz.ne.515) call abort
+ end
--- libgomp/testsuite/libgomp.fortran/omp_cond2.f.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_cond2.f 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,22 @@
+c Test conditional compilation in fixed form if -fno-openmp
+! { dg-options "-fno-openmp" }
+ 10 foo = 2
+ &56
+ if (foo.ne.256) call abort
+ bar = 26
+!$2 0 ba
+c$ +r = 42
+ !$ bar = 62
+!$ bar = bar + 1
+ if (bar.ne.26) call abort
+ baz = bar
+*$ 0baz = 5
+C$ +12! Comment
+c$ !4
+!$ +!Another comment
+*$ &2
+!$ X baz = 0 ! Not valid OpenMP conditional compilation lines
+! $ baz = 1
+c$ 10&baz = 2
+ if (baz.ne.26) call abort
+ end
--- libgomp/testsuite/libgomp.fortran/omp_parse1.f90.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_parse1.f90 2005-09-19 16:48:01.000000000 +0200
@@ -0,0 +1,177 @@
+! { dg-do run }
+use omp_lib
+ call test_parallel
+ call test_do
+ call test_sections
+ call test_single
+
+contains
+ subroutine test_parallel
+ integer :: a, b, c, e, f, g, i, j
+ integer, dimension (20) :: d
+ logical :: h
+ a = 6
+ b = 8
+ c = 11
+ d(:) = -1
+ e = 13
+ f = 24
+ g = 27
+ h = .false.
+ i = 1
+ j = 16
+!$omp para&
+!$omp&llel &
+!$omp if (a .eq. 6) private (b, c) shared (d) private (e) &
+ !$omp firstprivate(f) num_threads (a - 1) first&
+!$ompprivate(g)default (shared) reduction (.or. : h) &
+!$omp reduction(*:i)
+ if (i .ne. 1) h = .true.
+ i = 2
+ if (f .ne. 24) h = .true.
+ if (g .ne. 27) h = .true.
+ e = 7
+ b = omp_get_thread_num ()
+ if (b .eq. 0) j = 24
+ f = b
+ g = f
+ c = omp_get_num_threads ()
+ if (c .gt. a - 1 .or. c .le. 0) h = .true.
+ if (b .ge. c) h = .true.
+ d(b + 1) = c
+ if (f .ne. g .or. f .ne. b) h = .true.
+!$omp endparallel
+ if (h) call abort
+ if (a .ne. 6) call abort
+ if (j .ne. 24) call abort
+ if (d(1) .eq. -1) call abort
+ e = 1
+ do g = 1, d(1)
+ if (d(g) .ne. d(1)) call abort
+ e = e * 2
+ end do
+ if (e .ne. i) call abort
+ end subroutine test_parallel
+
+ subroutine test_do
+ integer :: i, j, k, l, n
+ integer, dimension (64) :: d
+ logical :: m
+
+ j = 16
+ d(:) = -1
+ m = .true.
+ n = 24
+!$omp parallel num_threads (4) shared (k, d) private (l) &
+!$omp&reduction (.and. : m)
+ if (omp_get_thread_num () .eq. 0) then
+ k = omp_get_num_threads ()
+ end if
+!$omp do schedule (static) firstprivate (n)
+ do 200 i = 1, j
+ if (i .eq. 1 .and. n .ne. 24) call abort
+ n = i
+200 d(n) = omp_get_thread_num ()
+!$omp enddo nowait
+
+!$omp do lastprivate (i) schedule (static, 5)
+ do 201 i = j + 1, 2 * j
+201 d(i) = omp_get_thread_num () + 1024
+ ! Implied omp end do here
+
+ if (i .ne. 33) m = .false.
+
+!$omp do private (j) schedule (dynamic)
+ do i = 33, 48
+ d(i) = omp_get_thread_num () + 2048
+ end do
+!$omp end do nowait
+
+!$omp do schedule (runtime)
+ do i = 49, 4 * j
+ d(i) = omp_get_thread_num () + 4096
+ end do
+ ! Implied omp end do here
+!$omp end parallel
+ if (.not. m) call abort
+
+ j = 0
+ do i = 1, 64
+ if (d(i) .lt. j .or. d(i) .ge. j + k) call abort
+ if (i .eq. 16) j = 1024
+ if (i .eq. 32) j = 2048
+ if (i .eq. 48) j = 4096
+ end do
+ end subroutine test_do
+
+ subroutine test_sections
+ integer :: i, j, k, l, m, n
+ i = 9
+ j = 10
+ k = 11
+ l = 0
+ m = 0
+ n = 30
+ call omp_set_dynamic (.false.)
+ call omp_set_num_threads (4)
+!$omp parallel num_threads (4)
+!$omp sections private (i) firstprivate (j, k) lastprivate (j) &
+!$omp& reduction (+ : l, m)
+!$omp section
+ i = 24
+ if (j .ne. 10 .or. k .ne. 11 .or. m .ne. 0) l = 1
+ m = m + 4
+!$omp section
+ i = 25
+ if (j .ne. 10 .or. k .ne. 11) l = 1
+ m = m + 6
+!$omp section
+ i = 26
+ if (j .ne. 10 .or. k .ne. 11) l = 1
+ m = m + 8
+!$omp section
+ i = 27
+ if (j .ne. 10 .or. k .ne. 11) l = 1
+ m = m + 10
+ j = 271
+!$omp end sections nowait
+!$omp sections lastprivate (n)
+!$omp section
+ n = 6
+!$omp section
+ n = 7
+!$omp endsections
+!$omp end parallel
+ if (j .ne. 271 .or. l .ne. 0) call abort
+ if (m .ne. 4 + 6 + 8 + 10) call abort
+ if (n .ne. 7) call abort
+ end subroutine test_sections
+
+ subroutine test_single
+ integer :: i, j, k, l
+ logical :: m
+ i = 200
+ j = 300
+ k = 400
+ l = 500
+ m = .false.
+!$omp parallel num_threads (4), private (i, j), reduction (.or. : m)
+ i = omp_get_thread_num ()
+ j = omp_get_thread_num ()
+!$omp single private (k)
+ k = 64
+!$omp end single nowait
+!$omp single private (k) firstprivate (l)
+ if (i .ne. omp_get_thread_num () .or. i .ne. j) then
+ j = -1
+ else
+ j = -2
+ end if
+ if (l .ne. 500) j = -1
+ l = 265
+!$omp end single copyprivate (j)
+ if (i .ne. omp_get_thread_num () .or. j .ne. -2) m = .true.
+!$omp endparallel
+ if (m) call abort
+ end subroutine test_single
+end
--- libgomp/testsuite/libgomp.fortran/omp_orphan.f.jj 2005-09-17 23:02:05.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_orphan.f 2005-09-17 23:02:05.000000000 +0200
@@ -0,0 +1,44 @@
+C******************************************************************************
+C FILE: omp_orphan.f
+C DESCRIPTION:
+C OpenMP Example - Parallel region with an orphaned directive - Fortran
+C Version
+C This example demonstrates a dot product being performed by an orphaned
+C loop reduction construct. Scoping of the reduction variable is critical.
+C AUTHOR: Blaise Barney 5/99
+C LAST REVISED:
+C******************************************************************************
+
+ PROGRAM ORPHAN
+ COMMON /DOTDATA/ A, B, SUM
+ INTEGER I, VECLEN
+ PARAMETER (VECLEN = 100)
+ REAL*8 A(VECLEN), B(VECLEN), SUM
+
+ DO I=1, VECLEN
+ A(I) = 1.0 * I
+ B(I) = A(I)
+ ENDDO
+ SUM = 0.0
+!$OMP PARALLEL
+ CALL DOTPROD
+!$OMP END PARALLEL
+ WRITE(*,*) "Sum = ", SUM
+ END
+
+
+
+ SUBROUTINE DOTPROD
+ COMMON /DOTDATA/ A, B, SUM
+ INTEGER I, TID, OMP_GET_THREAD_NUM, VECLEN
+ PARAMETER (VECLEN = 100)
+ REAL*8 A(VECLEN), B(VECLEN), SUM
+
+ TID = OMP_GET_THREAD_NUM()
+!$OMP DO REDUCTION(+:SUM)
+ DO I=1, VECLEN
+ SUM = SUM + (A(I)*B(I))
+ PRINT *, ' TID= ',TID,'I= ',I
+ ENDDO
+ RETURN
+ END
--- libgomp/testsuite/libgomp.fortran/omp_parse2.f90.jj 2005-09-19 13:17:31.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_parse2.f90 2005-09-19 15:49:06.000000000 +0200
@@ -0,0 +1,102 @@
+! { dg-do run }
+use omp_lib
+ call test_master
+ call test_critical
+ call test_barrier
+ call test_atomic
+
+contains
+ subroutine test_master
+ logical :: i, j
+ i = .false.
+ j = .false.
+!$omp parallel num_threads (4)
+!$omp master
+ i = .true.
+ j = omp_get_thread_num () .eq. 0
+!$omp endmaster
+!$omp end parallel
+ if (.not. (i .or. j)) call abort
+ end subroutine test_master
+
+ subroutine test_critical_1 (i, j)
+ integer :: i, j
+!$omp critical(critical_foo)
+ i = i + 1
+!$omp end critical (critical_foo)
+!$omp critical
+ j = j + 1
+!$omp end critical
+ end subroutine test_critical_1
+
+ subroutine test_critical
+ integer :: i, j, n
+ n = -1
+ i = 0
+ j = 0
+!$omp parallel num_threads (4)
+ if (omp_get_thread_num () .eq. 0) n = omp_get_num_threads ()
+ call test_critical_1 (i, j)
+ call test_critical_1 (i, j)
+!$omp critical
+ j = j + 1
+!$omp end critical
+!$omp critical (critical_foo)
+ i = i + 1
+!$omp endcritical (critical_foo)
+!$omp end parallel
+ if (n .lt. 1 .or. i .ne. n * 3 .or. j .ne. n * 3) call abort
+ end subroutine test_critical
+
+ subroutine test_barrier
+ integer :: i
+ logical :: j
+ i = 23
+ j = .false.
+!$omp parallel num_threads (4)
+ if (omp_get_thread_num () .eq. 0) i = 5
+!$omp flush (i)
+!$omp barrier
+ if (i .ne. 5) then
+!$omp atomic
+ j = j .or. .true.
+ end if
+!$omp end parallel
+ if (i .ne. 5 .or. j) call abort
+ end subroutine test_barrier
+
+ subroutine test_atomic
+ integer :: a, b, c, d, e, f, g
+ a = 0
+ b = 1
+ c = 0
+ d = 1024
+ e = 1024
+ f = -1
+ g = -1
+!$omp parallel num_threads (8)
+!$omp atomic
+ a = a + 2 + 4
+!$omp atomic
+ b = 3 * b
+!$omp atomic
+ c = 8 - c
+!$omp atomic
+ d = d / 2
+!$omp atomic
+ e = min (e, omp_get_thread_num ())
+!$omp atomic
+ f = max (omp_get_thread_num (), f)
+ if (omp_get_thread_num () .eq. 0) g = omp_get_num_threads ()
+!$omp end parallel
+ if (g .le. 0 .or. g .gt. 8) call abort
+ if (a .ne. 6 * g .or. b .ne. 3 ** g) call abort
+ if (iand (g, 1) .eq. 1) then
+ if (c .ne. 8) call abort
+ else if (c .ne. 0) then
+ call abort
+ end if
+ if (d .ne. 1024 / (2 ** g)) call abort
+ if (e .ne. 0 .or. f .ne. g - 1) call abort
+ end subroutine test_atomic
+end
--- libgomp/testsuite/libgomp.fortran/omp_parse3.f90.jj 2005-09-19 15:48:19.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/omp_parse3.f90 2005-09-19 17:26:34.000000000 +0200
@@ -0,0 +1,92 @@
+! { dg-do run }
+use omp_lib
+ common /tlsblock/ x, y
+ common /tlsblock2/ z
+ integer :: x, y, z
+!$omp threadprivate (/tlsblock/, z)
+
+ call test_flush
+ call test_ordered
+ call test_threadprivate
+
+contains
+ subroutine test_flush
+ integer :: i, j
+ i = 0
+ j = 0
+!$omp parallel num_threads (4)
+ if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()
+ if (omp_get_thread_num () .eq. 0) j = j + 1
+!$omp flush (i, j)
+!$omp barrier
+ if (omp_get_thread_num () .eq. 1) j = j + 2
+!$omp flush
+!$omp barrier
+ if (omp_get_thread_num () .eq. 2) j = j + 3
+!$omp flush (i)
+!$omp flush (j)
+!$omp barrier
+ if (omp_get_thread_num () .eq. 3) j = j + 4
+!$omp end parallel
+ end subroutine test_flush
+
+ subroutine test_ordered
+ integer :: i, j
+ integer, dimension (100) :: d
+ d(:) = -1
+!$omp parallel do ordered schedule (dynamic) num_threads (4)
+ do i = 1, 100, 5
+!$omp ordered
+ d(i) = i
+!$omp end ordered
+ end do
+ j = 1
+ do 100 i = 1, 100
+ if (i .eq. j) then
+ if (d(i) .ne. i) call abort
+ j = i + 5
+ else
+ if (d(i) .ne. -1) call abort
+ end if
+100 d(i) = -1
+ end subroutine test_ordered
+
+ subroutine test_threadprivate
+ integer :: i, j
+ logical :: m, n
+ call omp_set_num_threads (4)
+ call omp_set_dynamic (.false.)
+ i = -1
+ x = 6
+ y = 7
+ z = 8
+ n = .false.
+ m = .false.
+!$omp parallel copyin (/tlsblock/, z) reduction (.or.:m) &
+!$omp& num_threads (4)
+ if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()
+ if (x .ne. 6 .or. y .ne. 7 .or. z .ne. 8) call abort
+ x = omp_get_thread_num ()
+ y = omp_get_thread_num () + 1024
+ z = omp_get_thread_num () + 4096
+!$omp end parallel
+ if (x .ne. 0 .or. y .ne. 1024 .or. z .ne. 4096) call abort
+!$omp parallel num_threads (4), private (j) reduction (.or.:n)
+ if (omp_get_num_threads () .eq. i) then
+ j = omp_get_thread_num ()
+ if (x .ne. j .or. y .ne. j + 1024 .or. z .ne. j + 4096) &
+& call abort
+ end if
+!$omp end parallel
+ m = m .or. n
+ n = .false.
+!$omp parallel num_threads (4), copyin (z) reduction (.or. : n)
+ if (z .ne. 4096) n = .true.
+ if (omp_get_num_threads () .eq. i) then
+ j = omp_get_thread_num ()
+ if (x .ne. j .or. y .ne. j + 1024) call abort
+ end if
+!$omp end parallel
+ if (m .or. n) call abort
+ end subroutine test_threadprivate
+end
--- libgomp/testsuite/lib/libgomp-dg.exp.jj 2005-06-14 00:13:12.000000000 +0200
+++ libgomp/testsuite/lib/libgomp-dg.exp 2005-09-19 12:15:26.000000000 +0200
@@ -13,12 +13,15 @@ load_gcc_lib file-format.exp
load_gcc_lib target-supports.exp
load_gcc_lib target-supports-dg.exp
load_gcc_lib scanasm.exp
+load_gcc_lib scandump.exp
load_gcc_lib scantree.exp
+load_gcc_lib scanipa.exp
load_gcc_lib prune.exp
load_gcc_lib target-libpath.exp
load_gcc_lib wrapper.exp
load_gcc_lib gcc-defs.exp
load_gcc_lib gcc-dg.exp
+load_gcc_lib gfortran-dg.exp
set dg-do-what-default run
@@ -79,6 +82,9 @@ proc libgomp_init { args } {
# Compute what needs to be put into LD_LIBRARY_PATH
set ld_library_path ".:${blddir}/.libs"
+ if [file exists "${blddir}/../libgfortran/.libs/libgfortranbegin.a"] {
+ append ld_library_path ":${blddir}/../libgfortran/.libs"
+ }
append ld_library_path [gcc-set-multilib-library-path $GCC_UNDER_TEST]
set_ld_library_path_env_vars
@@ -86,6 +92,9 @@ proc libgomp_init { args } {
lappend ALWAYS_CFLAGS "additional_flags=-I${srcdir}/.."
lappend ALWAYS_CFLAGS "additional_flags=-I${blddir}"
lappend ALWAYS_CFLAGS "ldflags=-L${blddir}/.libs -lgomp"
+ if [file exists "${blddir}/../libgfortran/.libs/libgfortranbegin.a"] {
+ lappend ALWAYS_CFLAGS "ldflags=-L${blddir}/../libgfortran/.libs -lgfortranbegin -lgfortran"
+ }
# We use atomic operations in the testcases to validate results.
if [istarget i?86-*-*] {
--- libgomp/configure.jj 2005-09-13 16:17:47.000000000 +0200
+++ libgomp/configure 2005-09-19 12:05:30.000000000 +0200
@@ -308,7 +308,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO install_sh STRIP ac_ct_STRIP INSTALL_STRIP_PROGRAM mkdir_p AWK SET_MAKE am__leading_dot AMTAR am__tar am__untar multi_basedir toolexecdir toolexeclibdir CC ac_ct_CC EXEEXT OBJEXT DEPDIR am__include am__quote AMDEP_TRUE AMDEP_FALSE AMDEPBACKSLASH CCDEPMODE am__fastdepCC_TRUE am__fastdepCC_FALSE CFLAGS AR ac_ct_AR RANLIB ac_ct_RANLIB PERL LN_S LIBTOOL enable_shared enable_static libtool_VERSION CPP CPPFLAGS EGREP SECTION_LDFLAGS OPT_LDFLAGS LIBGOMP_BUILD_VERSIONED_SHLIB_TRUE LIBGOMP_BUILD_VERSIONED_SHLIB_FALSE config_path XCFLAGS XLDFLAGS LIBOBJS LTLIBOBJS'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO install_sh STRIP ac_ct_STRIP INSTALL_STRIP_PROGRAM mkdir_p AWK SET_MAKE am__leading_dot AMTAR am__tar am__untar multi_basedir toolexecdir toolexeclibdir CC ac_ct_CC EXEEXT OBJEXT DEPDIR am__include am__quote AMDEP_TRUE AMDEP_FALSE AMDEPBACKSLASH CCDEPMODE am__fastdepCC_TRUE am__fastdepCC_FALSE CFLAGS AR ac_ct_AR RANLIB ac_ct_RANLIB PERL LN_S LIBTOOL enable_shared enable_static FC FCFLAGS LDFLAGS ac_ct_FC libtool_VERSION CPP CPPFLAGS EGREP SECTION_LDFLAGS OPT_LDFLAGS LIBGOMP_BUILD_VERSIONED_SHLIB_TRUE LIBGOMP_BUILD_VERSIONED_SHLIB_FALSE config_path XCFLAGS XLDFLAGS USE_FORTRAN_TRUE USE_FORTRAN_FALSE LIBOBJS LTLIBOBJS'
ac_subst_files=''
# Initialize some variables set by options.
@@ -749,6 +749,18 @@ ac_env_target_alias_set=${target_alias+s
ac_env_target_alias_value=$target_alias
ac_cv_env_target_alias_set=${target_alias+set}
ac_cv_env_target_alias_value=$target_alias
+ac_env_FC_set=${FC+set}
+ac_env_FC_value=$FC
+ac_cv_env_FC_set=${FC+set}
+ac_cv_env_FC_value=$FC
+ac_env_FCFLAGS_set=${FCFLAGS+set}
+ac_env_FCFLAGS_value=$FCFLAGS
+ac_cv_env_FCFLAGS_set=${FCFLAGS+set}
+ac_cv_env_FCFLAGS_value=$FCFLAGS
+ac_env_LDFLAGS_set=${LDFLAGS+set}
+ac_env_LDFLAGS_value=$LDFLAGS
+ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
+ac_cv_env_LDFLAGS_value=$LDFLAGS
ac_env_CPP_set=${CPP+set}
ac_env_CPP_value=$CPP
ac_cv_env_CPP_set=${CPP+set}
@@ -869,6 +881,8 @@ Some influential environment variables:
nonstandard directory <lib dir>
CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have
headers in a nonstandard directory <include dir>
+ FC Fortran compiler command
+ FCFLAGS Fortran compiler flags
CPP C preprocessor
Use these variables to override the choices made by `configure' or to help
@@ -4207,7 +4221,7 @@ test x"$pic_mode" = xno && libtool_flags
case $host in
*-*-irix6*)
# Find out which ABI we are using.
- echo '#line 4210 "configure"' > conftest.$ac_ext
+ echo '#line 4224 "configure"' > conftest.$ac_ext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
(eval $ac_compile) 2>&5
ac_status=$?
@@ -4496,6 +4510,247 @@ exec 5>>./config.log
+# We need gfortran to compile parts of the library
+# We can't use AC_PROG_FC because it expects a fully working gfortran.
+#AC_PROG_FC(gfortran)
+FC="$GFORTRAN"
+ac_ext=${FC_SRCEXT-f}
+ac_compile='$FC -c $FCFLAGS $FCFLAGS_SRCEXT conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $FCFLAGS_SRCEXT conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+ for ac_prog in gfortran
+ do
+ # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_FC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$FC"; then
+ ac_cv_prog_FC="$FC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_FC="$ac_tool_prefix$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+FC=$ac_cv_prog_FC
+if test -n "$FC"; then
+ echo "$as_me:$LINENO: result: $FC" >&5
+echo "${ECHO_T}$FC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$FC" && break
+ done
+fi
+if test -z "$FC"; then
+ ac_ct_FC=$FC
+ for ac_prog in gfortran
+do
+ # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_FC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_FC"; then
+ ac_cv_prog_ac_ct_FC="$ac_ct_FC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_FC="$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_FC=$ac_cv_prog_ac_ct_FC
+if test -n "$ac_ct_FC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_FC" >&5
+echo "${ECHO_T}$ac_ct_FC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$ac_ct_FC" && break
+done
+
+ FC=$ac_ct_FC
+fi
+
+
+# Provide some information about the compiler.
+echo "$as_me:4609:" \
+ "checking for Fortran compiler version" >&5
+ac_compiler=`set X $ac_compile; echo $2`
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
+ (eval $ac_compiler --version </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
+ (eval $ac_compiler -v </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
+ (eval $ac_compiler -V </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+rm -f a.out
+
+# If we don't use `.F' as extension, the preprocessor is not run on the
+# input file. (Note that this only needs to work for GNU compilers.)
+ac_save_ext=$ac_ext
+ac_ext=F
+echo "$as_me:$LINENO: checking whether we are using the GNU Fortran compiler" >&5
+echo $ECHO_N "checking whether we are using the GNU Fortran compiler... $ECHO_C" >&6
+if test "${ac_cv_fc_compiler_gnu+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+ program main
+#ifndef __GNUC__
+ choke me
+#endif
+
+ end
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_fc_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_compiler_gnu=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_compiler_gnu=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_fc_compiler_gnu=$ac_compiler_gnu
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_fc_compiler_gnu" >&5
+echo "${ECHO_T}$ac_cv_fc_compiler_gnu" >&6
+ac_ext=$ac_save_ext
+ac_test_FFLAGS=${FCFLAGS+set}
+ac_save_FFLAGS=$FCFLAGS
+FCFLAGS=
+echo "$as_me:$LINENO: checking whether $FC accepts -g" >&5
+echo $ECHO_N "checking whether $FC accepts -g... $ECHO_C" >&6
+if test "${ac_cv_prog_fc_g+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ FCFLAGS=-g
+cat >conftest.$ac_ext <<_ACEOF
+ program main
+
+ end
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_fc_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_fc_g=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_prog_fc_g=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_prog_fc_g" >&5
+echo "${ECHO_T}$ac_cv_prog_fc_g" >&6
+if test "$ac_test_FFLAGS" = set; then
+ FCFLAGS=$ac_save_FFLAGS
+elif test $ac_cv_prog_fc_g = yes; then
+ if test "x$ac_cv_fc_compiler_gnu" = xyes; then
+ FCFLAGS="-g -O2"
+ else
+ FCFLAGS="-g"
+ fi
+else
+ if test "x$ac_cv_fc_compiler_gnu" = xyes; then
+ FCFLAGS="-O2"
+ else
+ FCFLAGS=
+ fi
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+FCFLAGS="$FCFLAGS -Wall"
+
# For libtool versioning info, format is CURRENT:REVISION:AGE
libtool_VERSION=1:0:0
@@ -6272,6 +6527,17 @@ else
multilib_arg=
fi
+
+
+if test "$ac_cv_fc_compiler_gnu" = yes; then
+ USE_FORTRAN_TRUE=
+ USE_FORTRAN_FALSE='#'
+else
+ USE_FORTRAN_TRUE='#'
+ USE_FORTRAN_FALSE=
+fi
+
+
ac_config_files="$ac_config_files Makefile testsuite/Makefile"
cat >confcache <<\_ACEOF
@@ -6386,6 +6652,13 @@ echo "$as_me: error: conditional \"LIBGO
Usually this means the macro was only invoked conditionally." >&2;}
{ (exit 1); exit 1; }; }
fi
+if test -z "${USE_FORTRAN_TRUE}" && test -z "${USE_FORTRAN_FALSE}"; then
+ { { echo "$as_me:$LINENO: error: conditional \"USE_FORTRAN\" was never defined.
+Usually this means the macro was only invoked conditionally." >&5
+echo "$as_me: error: conditional \"USE_FORTRAN\" was never defined.
+Usually this means the macro was only invoked conditionally." >&2;}
+ { (exit 1); exit 1; }; }
+fi
: ${CONFIG_STATUS=./config.status}
ac_clean_files_save=$ac_clean_files
@@ -6991,6 +7264,10 @@ s,@LN_S@,$LN_S,;t t
s,@LIBTOOL@,$LIBTOOL,;t t
s,@enable_shared@,$enable_shared,;t t
s,@enable_static@,$enable_static,;t t
+s,@FC@,$FC,;t t
+s,@FCFLAGS@,$FCFLAGS,;t t
+s,@LDFLAGS@,$LDFLAGS,;t t
+s,@ac_ct_FC@,$ac_ct_FC,;t t
s,@libtool_VERSION@,$libtool_VERSION,;t t
s,@CPP@,$CPP,;t t
s,@CPPFLAGS@,$CPPFLAGS,;t t
@@ -7002,6 +7279,8 @@ s,@LIBGOMP_BUILD_VERSIONED_SHLIB_FALSE@,
s,@config_path@,$config_path,;t t
s,@XCFLAGS@,$XCFLAGS,;t t
s,@XLDFLAGS@,$XLDFLAGS,;t t
+s,@USE_FORTRAN_TRUE@,$USE_FORTRAN_TRUE,;t t
+s,@USE_FORTRAN_FALSE@,$USE_FORTRAN_FALSE,;t t
s,@LIBOBJS@,$LIBOBJS,;t t
s,@LTLIBOBJS@,$LTLIBOBJS,;t t
CEOF
Jakub