[gomp] Fortran OpenMP parser (take 2)
Jakub Jelinek
jakub@redhat.com
Mon Sep 19 21:00:00 GMT 2005
On Mon, Sep 19, 2005 at 08:41:45PM +0100, Paul Brook wrote:
> > I'm perfectly fine with a single file; if both the parsing and the
> > translation part are going to significantly grow, it might make sense to
> > follow the logic used in the rest of the FE, e.g. stmt.c vs. trans-stmt.c,
> > but I can't tell if this will be worth the effort.
>
> I think it's worth splitting the pure frontend bits (match/resolve) bits from
> the gcc tree generation bits (trans-*).
Here is an updated patch that introduces openmp.c (for match/resolve)
and trans-openmp.c (for tree generation).
Tested with make check-gfortran and make check in libgomp.
Ok for gomp-20050608-branch?
2005-09-19 Jakub Jelinek <jakub@redhat.com>
gcc/fortran/
* Make-lang.in (F95_PARSER_OBJS): Add fortran/openmp.o.
(F95_OBJS): Add fortran/trans-openmp.o.
(fortran/trans-openmp.o): Depend on $(GFORTRAN_TRANS_DEPS).
* lang.opt: Add -fopenmp option.
* options.c (gfc_init_options): Initialize it.
(gfc_handle_option): Handle it.
* gfortran.h (ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL,
ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER,
ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO,
ST_OMP_END_PARALLEL_SECTIONS, ST_OMP_END_PARALLEL_WORKSHARE,
ST_OMP_END_SECTIONS, ST_OMP_END_SINGLE, ST_OMP_END_WORKSHARE,
ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED,
ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION,
ST_OMP_SINGLE, ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE): New
statement codes.
(OMP_LIST_PRIVATE, OMP_LIST_FIRSTPRIVATE, OMP_LIST_LASTPRIVATE,
OMP_LIST_COPYPRIVATE, OMP_LIST_SHARED, OMP_LIST_COPYIN,
OMP_LIST_PLUS, OMP_LIST_REDUCTION_FIRST, OMP_LIST_MULT,
OMP_LIST_SUB, OMP_LIST_AND, OMP_LIST_OR, OMP_LIST_EQV,
OMP_LIST_NEQV, OMP_LIST_MAX, OMP_LIST_MIN, OMP_LIST_IAND,
OMP_LIST_IOR, OMP_LIST_IEOR, OMP_LIST_REDUCTION_LAST, OMP_LIST_NUM):
New OpenMP variable list types.
(gfc_omp_clauses): New typedef.
(gfc_get_omp_clauses): Define.
(EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
EXEC_OMP_END_SINGLE): New OpenMP gfc_exec_op codes.
(struct gfc_code): Add omp_clauses, omp_name, omp_namelist
and omp_bool fields to ext union.
(flag_openmp): Declare.
(gfc_free_omp_clauses, gfc_resolve_omp_directive): New prototypes.
* scanner.c (openmp_flag, openmp_locus): New variables.
(skip_free_comments, skip_fixed_comments, gfc_next_char_literal):
Handle OpenMP directive lines and conditional compilation magic
comments.
* parse.h (COMP_OMP_STRUCTURED_BLOCK): New compile state.
* parse.c (decode_omp_directive, parse_omp_do, parse_omp_atomic,
parse_omp_structured_block): New functions.
(next_free, next_fixed): Parse OpenMP directives.
(case_executable, case_exec_markers, case_decl): Add ST_OMP_*
codes.
(gfc_ascii_statement): Handle ST_OMP_* codes.
(parse_executable): Rearrange the loop slightly, so that
parse_omp_do can return next_statement.
* match.h (gfc_match_omp_eos, gfc_match_omp_atomic,
gfc_match_omp_barrier, gfc_match_omp_critical, gfc_match_omp_do,
gfc_match_omp_flush, gfc_match_omp_master, gfc_match_omp_ordered,
gfc_match_omp_parallel, gfc_match_omp_parallel_do,
gfc_match_omp_parallel_sections, gfc_match_omp_parallel_workshare,
gfc_match_omp_sections, gfc_match_omp_single,
gfc_match_omp_threadprivate, gfc_match_omp_workshare,
gfc_match_omp_end_nowait, gfc_match_omp_end_single): New prototypes.
* resolve.c (resolve_blocks): Ignore EXEC_OMP_* block directives.
(resolve_code): Call gfc_resolve_omp_directive on EXEC_OMP_*
directives.
* trans.c (gfc_trans_code): Call gfc_trans_omp_directive for
EXEC_OMP_* directives.
* st.c (gfc_free_statement): Handle EXEC_OMP_* statement freeing.
* trans-stmt.h (gfc_trans_omp_directive): New prototype.
* openmp.c: New file.
* trans-openmp.c: New file.
gcc/
* 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/trans-openmp.c.jj 2005-09-19 22:25:20.000000000 +0200
+++ gcc/fortran/trans-openmp.c 2005-09-19 22:26:37.000000000 +0200
@@ -0,0 +1,128 @@
+/* OpenMP directive translation -- generate GCC trees from gfc_code.
+ Copyright (C) 2005 Free Software Foundation, Inc.
+ Contributed by Jakub Jelinek <jakub@redhat.com>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING. If not, write to the Free
+Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA. */
+
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "tree-gimple.h"
+#include "ggc.h"
+#include "toplev.h"
+#include "real.h"
+#include "gfortran.h"
+#include "trans.h"
+#include "trans-stmt.h"
+#include "trans-types.h"
+#include "trans-array.h"
+#include "trans-const.h"
+#include "arith.h"
+
+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/resolve.c.jj 2005-09-13 15:16:42.000000000 +0200
+++ gcc/fortran/resolve.c 2005-09-19 22:21:59.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,23 @@ 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:
+ 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:
+ gfc_resolve_omp_directive (code, ns);
+ 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 22:07:02.000000000 +0200
@@ -90,6 +90,28 @@ match gfc_match_forall (gfc_statement *)
gfc_common_head *gfc_get_common (const char *, int);
+/* openmp.c */
+
+/* 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);
+
/* decl.c */
match gfc_match_data (void);
--- 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/gfortran.h.jj 2005-09-17 20:45:46.000000000 +0200
+++ gcc/fortran/gfortran.h 2005-09-19 22:36:48.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;
@@ -1741,6 +1814,10 @@ void gfc_free_equiv (gfc_equiv *);
void gfc_free_data (gfc_data *);
void gfc_free_case_list (gfc_case *);
+/* openmp.c */
+void gfc_free_omp_clauses (gfc_omp_clauses *);
+void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
+
/* expr.c */
void gfc_free_actual_arglist (gfc_actual_arglist *);
gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
--- 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/Make-lang.in.jj 2005-09-17 20:45:46.000000000 +0200
+++ gcc/fortran/Make-lang.in 2005-09-19 22:25:06.000000000 +0200
@@ -67,15 +67,16 @@ F95_PARSER_OBJS = fortran/arith.o fortra
fortran/error.o fortran/expr.o fortran/interface.o \
fortran/intrinsic.o fortran/io.o fortran/iresolve.o \
fortran/match.o fortran/matchexp.o fortran/misc.o fortran/module.o \
- fortran/options.o fortran/parse.o fortran/primary.o fortran/resolve.o \
- fortran/scanner.o fortran/simplify.o fortran/st.o fortran/symbol.o
+ fortran/openmp.o fortran/options.o fortran/parse.o fortran/primary.o \
+ fortran/resolve.o fortran/scanner.o fortran/simplify.o fortran/st.o \
+ fortran/symbol.o
F95_OBJS = $(F95_PARSER_OBJS) \
fortran/convert.o fortran/dependency.o fortran/f95-lang.o \
fortran/trans.o fortran/trans-array.o fortran/trans-common.o \
fortran/trans-const.o fortran/trans-decl.o fortran/trans-expr.o \
- fortran/trans-intrinsic.o fortran/trans-io.o fortran/trans-stmt.o \
- fortran/trans-types.o
+ fortran/trans-intrinsic.o fortran/trans-io.o fortran/trans-openmp.o \
+ fortran/trans-stmt.o fortran/trans-types.o
# GFORTRAN uses GMP for its internal arithmetics.
F95_LIBS = $(GMPLIBS) $(LIBS)
@@ -291,6 +292,7 @@ fortran/trans-types.o: $(GFORTRAN_TRANS_
fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS)
+fortran/trans-openmp.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-io.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-io.h
fortran/trans-array.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-intrinsic.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \
--- gcc/fortran/parse.c.jj 2005-09-13 15:16:42.000000000 +0200
+++ gcc/fortran/parse.c 2005-09-19 22:27:59.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;
- default:
+ case ST_OMP_ATOMIC:
+ parse_omp_atomic ();
break;
+
+ default:
+ 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/fortran/openmp.c.jj 2005-09-19 22:02:29.000000000 +0200
+++ gcc/fortran/openmp.c 2005-09-19 22:36:25.000000000 +0200
@@ -0,0 +1,617 @@
+/* OpenMP directive matching and resolving.
+ Copyright (C) 2005 Free Software Foundation, Inc.
+ Contributed by Jakub Jelinek
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING. If not, write to the Free
+Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA. */
+
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "match.h"
+#include "parse.h"
+
+/* 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);
+}
+
+/* Match a variable/common block list and construct a namelist from it. */
+
+static match
+gfc_match_omp_variable_list (const char *str, gfc_namelist **list)
+{
+ 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)
+
+/* Match OpenMP directive clauses. MASK is a bitmask of
+ clauses that are allowed for a particular directive. */
+
+static match
+gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
+{
+ gfc_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;
+}
+
+/* OpenMP directive resolving routines. */
+
+static void
+resolve_omp_clauses (gfc_code *code)
+{
+ gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
+
+ if (omp_clauses == NULL)
+ return;
+
+ if (omp_clauses->if_expr)
+ {
+ gfc_expr *expr = 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 (omp_clauses->num_threads)
+ {
+ gfc_expr *expr = 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 (omp_clauses->chunk_size)
+ {
+ gfc_expr *expr = 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);
+ }
+}
+
+/* Resolve OpenMP directive clauses and check various requirements
+ of each directive. */
+
+void
+gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
+{
+ switch (code->op)
+ {
+ 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:
+ if (code->ext.omp_clauses)
+ resolve_omp_clauses (code);
+ break;
+ default:
+ break;
+ }
+}
--- 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 22:39:43.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
More information about the Gcc-patches
mailing list