Fortran: Update omp atomic for OpenMP 5
authorTobias Burnus <tobias@codesourcery.com>
Fri, 30 Oct 2020 14:57:46 +0000 (15:57 +0100)
committerTobias Burnus <tobias@codesourcery.com>
Fri, 30 Oct 2020 14:57:46 +0000 (15:57 +0100)
gcc/fortran/ChangeLog:

* dump-parse-tree.c (show_omp_clauses): Handle atomic clauses.
(show_omp_node): Call it for atomic.
* gfortran.h (enum gfc_omp_atomic_op): Add GFC_OMP_ATOMIC_UNSET,
remove GFC_OMP_ATOMIC_SEQ_CST and GFC_OMP_ATOMIC_ACQ_REL.
(enum gfc_omp_memorder): Replace OMP_MEMORDER_LAST by
OMP_MEMORDER_UNSET, add OMP_MEMORDER_SEQ_CST/OMP_MEMORDER_RELAXED.
(gfc_omp_clauses): Add capture and atomic_op.
(gfc_code): remove omp_atomic.
* openmp.c (enum omp_mask1): Add atomic, capture, memorder clauses.
(gfc_match_omp_clauses): Match them.
(OMP_ATOMIC_CLAUSES): Add.
(gfc_match_omp_flush): Update for 'last' to 'unset' change.
(gfc_match_omp_oacc_atomic): Removed and placed content ..
(gfc_match_omp_atomic): ... here. Update for OpenMP 5 clauses.
(gfc_match_oacc_atomic): Match directly here.
(resolve_omp_atomic, gfc_resolve_omp_directive): Update.
* parse.c (parse_omp_oacc_atomic): Update for struct gfc_code changes.
* resolve.c (gfc_resolve_blocks): Update assert.
* st.c (gfc_free_statement): Also call for EXEC_O{ACC,MP}_ATOMIC.
* trans-openmp.c (gfc_trans_omp_atomic): Update.
(gfc_trans_omp_flush): Update for 'last' to 'unset' change.

gcc/testsuite/ChangeLog:

* gfortran.dg/gomp/atomic-2.f90: New test.
* gfortran.dg/gomp/atomic.f90: New test.

gcc/fortran/dump-parse-tree.c
gcc/fortran/gfortran.h
gcc/fortran/openmp.c
gcc/fortran/parse.c
gcc/fortran/resolve.c
gcc/fortran/st.c
gcc/fortran/trans-openmp.c
gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/gomp/atomic.f90 [new file with mode: 0644]

index 6e265f4520d4da75c526b29967c85f5c87f63c00..43b97ba26ff916a578b7529eb8a5395a54f83626 100644 (file)
@@ -1715,6 +1715,36 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
     }
   if (omp_clauses->depend_source)
     fputs (" DEPEND(source)", dumpfile);
+  if (omp_clauses->capture)
+    fputs (" CAPTURE", dumpfile);
+  if (omp_clauses->atomic_op != GFC_OMP_ATOMIC_UNSET)
+    {
+      const char *atomic_op;
+      switch (omp_clauses->atomic_op)
+       {
+       case GFC_OMP_ATOMIC_READ: atomic_op = "READ"; break;
+       case GFC_OMP_ATOMIC_WRITE: atomic_op = "WRITE"; break;
+       case GFC_OMP_ATOMIC_UPDATE: atomic_op = "UPDATE"; break;
+       default: gcc_unreachable ();
+       }
+      fputc (' ', dumpfile);
+      fputs (atomic_op, dumpfile);
+    }
+  if (omp_clauses->memorder != OMP_MEMORDER_UNSET)
+    {
+      const char *memorder;
+      switch (omp_clauses->memorder)
+       {
+       case OMP_MEMORDER_ACQ_REL: memorder = "ACQ_REL"; break;
+       case OMP_MEMORDER_ACQUIRE: memorder = "AQUIRE"; break;
+       case OMP_MEMORDER_RELAXED: memorder = "RELAXED"; break;
+       case OMP_MEMORDER_RELEASE: memorder = "RELEASE"; break;
+       case OMP_MEMORDER_SEQ_CST: memorder = "SEQ_CST"; break;
+       default: gcc_unreachable ();
+       }
+      fputc (' ', dumpfile);
+      fputs (memorder, dumpfile);
+    }
 }
 
 /* Show a single OpenMP or OpenACC directive node and everything underneath it
@@ -1880,6 +1910,10 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_TASKWAIT:
     case EXEC_OMP_TASKYIELD:
       return;
+    case EXEC_OACC_ATOMIC:
+    case EXEC_OMP_ATOMIC:
+      omp_clauses = c->block ? c->block->ext.omp_clauses : NULL;
+      break;
     default:
       break;
     }
index 73b6ffd870c05ef76206caa76674079377cfaec1..9500032f0e3cfda16c115fc79bc124588912949a 100644 (file)
@@ -1343,6 +1343,16 @@ enum gfc_omp_if_kind
   OMP_IF_LAST
 };
 
+enum gfc_omp_atomic_op
+{
+  GFC_OMP_ATOMIC_UNSET = 0,
+  GFC_OMP_ATOMIC_UPDATE = 1,
+  GFC_OMP_ATOMIC_READ = 2,
+  GFC_OMP_ATOMIC_WRITE = 3,
+  GFC_OMP_ATOMIC_MASK = 3,
+  GFC_OMP_ATOMIC_SWAP = 16
+};
+
 enum gfc_omp_requires_kind
 {
   /* Keep in sync with gfc_namespace, esp. with omp_req_mem_order.  */
@@ -1363,10 +1373,12 @@ enum gfc_omp_requires_kind
 
 enum gfc_omp_memorder
 {
+  OMP_MEMORDER_UNSET,
+  OMP_MEMORDER_SEQ_CST,
   OMP_MEMORDER_ACQ_REL,
   OMP_MEMORDER_RELEASE,
   OMP_MEMORDER_ACQUIRE,
-  OMP_MEMORDER_LAST
+  OMP_MEMORDER_RELAXED
 };
 
 typedef struct gfc_omp_clauses
@@ -1383,7 +1395,8 @@ typedef struct gfc_omp_clauses
   bool nowait, ordered, untied, mergeable;
   bool inbranch, notinbranch, defaultmap, nogroup;
   bool sched_simd, sched_monotonic, sched_nonmonotonic;
-  bool simd, threads, depend_source, order_concurrent;
+  bool simd, threads, depend_source, order_concurrent, capture;
+  enum gfc_omp_atomic_op atomic_op;
   enum gfc_omp_memorder memorder;
   enum gfc_omp_cancel_kind cancel;
   enum gfc_omp_proc_bind_kind proc_bind;
@@ -2682,18 +2695,6 @@ enum gfc_exec_op
   EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD
 };
 
-enum gfc_omp_atomic_op
-{
-  GFC_OMP_ATOMIC_UPDATE = 0,
-  GFC_OMP_ATOMIC_READ = 1,
-  GFC_OMP_ATOMIC_WRITE = 2,
-  GFC_OMP_ATOMIC_CAPTURE = 3,
-  GFC_OMP_ATOMIC_MASK = 3,
-  GFC_OMP_ATOMIC_SEQ_CST = 4,
-  GFC_OMP_ATOMIC_ACQ_REL = 8,
-  GFC_OMP_ATOMIC_SWAP = 16
-};
-
 typedef struct gfc_code
 {
   gfc_exec_op op;
@@ -2748,7 +2749,6 @@ typedef struct gfc_code
     const char *omp_name;
     gfc_omp_namelist *omp_namelist;
     bool omp_bool;
-    gfc_omp_atomic_op omp_atomic;
   }
   ext;         /* Points to additional structures required by statement */
 
index b143ba7454ad88df1c7db7943ab062fca34f1c69..608ff5a0b559e1dbcf72c661b79d10854299cfb0 100644 (file)
@@ -802,6 +802,9 @@ enum omp_mask1
   OMP_CLAUSE_USE_DEVICE_PTR,
   OMP_CLAUSE_USE_DEVICE_ADDR,  /* OpenMP 5.0.  */
   OMP_CLAUSE_DEVICE_TYPE,  /* OpenMP 5.0.  */
+  OMP_CLAUSE_ATOMIC,  /* OpenMP 5.0.  */
+  OMP_CLAUSE_CAPTURE,  /* OpenMP 5.0.  */
+  OMP_CLAUSE_MEMORDER,  /* OpenMP 5.0.  */
   OMP_CLAUSE_NOWAIT,
   /* This must come last.  */
   OMP_MASK1_LAST
@@ -1017,6 +1020,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
                  n->expr = alignment;
              continue;
            }
+         if ((mask & OMP_CLAUSE_MEMORDER)
+             && c->memorder == OMP_MEMORDER_UNSET
+             && gfc_match ("acq_rel") == MATCH_YES)
+           {
+             c->memorder = OMP_MEMORDER_ACQ_REL;
+             needs_space = true;
+             continue;
+           }
+         if ((mask & OMP_CLAUSE_MEMORDER)
+             && c->memorder == OMP_MEMORDER_UNSET
+             && gfc_match ("acquire") == MATCH_YES)
+           {
+             c->memorder = OMP_MEMORDER_ACQUIRE;
+             needs_space = true;
+             continue;
+           }
          if ((mask & OMP_CLAUSE_ASYNC)
              && !c->async
              && gfc_match ("async") == MATCH_YES)
@@ -1055,6 +1074,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
            continue;
          break;
        case 'c':
+         if ((mask & OMP_CLAUSE_CAPTURE)
+             && !c->capture
+             && gfc_match ("capture") == MATCH_YES)
+           {
+             c->capture = true;
+             needs_space = true;
+             continue;
+           }
          if ((mask & OMP_CLAUSE_COLLAPSE)
              && !c->collapse)
            {
@@ -1681,6 +1708,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
            }
          break;
        case 'r':
+         if ((mask & OMP_CLAUSE_ATOMIC)
+             && c->atomic_op == GFC_OMP_ATOMIC_UNSET
+             && gfc_match ("read") == MATCH_YES)
+           {
+             c->atomic_op = GFC_OMP_ATOMIC_READ;
+             needs_space = true;
+             continue;
+           }
          if ((mask & OMP_CLAUSE_REDUCTION)
              && gfc_match ("reduction ( ") == MATCH_YES)
            {
@@ -1801,6 +1836,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
              else
                gfc_current_locus = old_loc;
            }
+         if ((mask & OMP_CLAUSE_MEMORDER)
+             && c->memorder == OMP_MEMORDER_UNSET
+             && gfc_match ("relaxed") == MATCH_YES)
+           {
+             c->memorder = OMP_MEMORDER_RELAXED;
+             needs_space = true;
+             continue;
+           }
+         if ((mask & OMP_CLAUSE_MEMORDER)
+             && c->memorder == OMP_MEMORDER_UNSET
+             && gfc_match ("release") == MATCH_YES)
+           {
+             c->memorder = OMP_MEMORDER_RELEASE;
+             needs_space = true;
+             continue;
+           }
          break;
        case 's':
          if ((mask & OMP_CLAUSE_SAFELEN)
@@ -1885,6 +1936,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
              needs_space = true;
              continue;
            }
+         if ((mask & OMP_CLAUSE_MEMORDER)
+             && c->memorder == OMP_MEMORDER_UNSET
+             && gfc_match ("seq_cst") == MATCH_YES)
+           {
+             c->memorder = OMP_MEMORDER_SEQ_CST;
+             needs_space = true;
+             continue;
+           }
          if ((mask & OMP_CLAUSE_SHARED)
              && gfc_match_omp_variable_list ("shared (",
                                              &c->lists[OMP_LIST_SHARED],
@@ -1945,6 +2004,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
              c->untied = needs_space = true;
              continue;
            }
+         if ((mask & OMP_CLAUSE_ATOMIC)
+             && c->atomic_op == GFC_OMP_ATOMIC_UNSET
+             && gfc_match ("update") == MATCH_YES)
+           {
+             c->atomic_op = GFC_OMP_ATOMIC_UPDATE;
+             needs_space = true;
+             continue;
+           }
          if ((mask & OMP_CLAUSE_USE_DEVICE)
              && gfc_match_omp_variable_list ("use_device (",
                                              &c->lists[OMP_LIST_USE_DEVICE],
@@ -2026,6 +2093,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
                needs_space = true;
              continue;
            }
+         if ((mask & OMP_CLAUSE_ATOMIC)
+             && c->atomic_op == GFC_OMP_ATOMIC_UNSET
+             && gfc_match ("write") == MATCH_YES)
+           {
+             c->atomic_op = GFC_OMP_ATOMIC_WRITE;
+             needs_space = true;
+             continue;
+           }
          break;
        }
       break;
@@ -2658,6 +2733,9 @@ cleanup:
   (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
 #define OMP_DECLARE_TARGET_CLAUSES \
   (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE)
+#define OMP_ATOMIC_CLAUSES \
+  (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT \
+   | OMP_CLAUSE_MEMORDER)
 
 
 static match
@@ -2768,7 +2846,7 @@ gfc_match_omp_flush (void)
   gfc_omp_namelist *list = NULL;
   gfc_omp_clauses *c = NULL;
   gfc_gobble_whitespace ();
-  enum gfc_omp_memorder mo = OMP_MEMORDER_LAST;
+  enum gfc_omp_memorder mo = OMP_MEMORDER_UNSET;
   if (gfc_match_omp_eos () == MATCH_NO && gfc_peek_ascii_char () != '(')
     {
       if (gfc_match ("acq_rel") == MATCH_YES)
@@ -2786,7 +2864,7 @@ gfc_match_omp_flush (void)
       c->memorder = mo;
     }
   gfc_match_omp_variable_list (" (", &list, true);
-  if (list && mo != OMP_MEMORDER_LAST)
+  if (list && mo != OMP_MEMORDER_UNSET)
     {
       gfc_error ("List specified together with memory order clause in FLUSH "
                 "directive at %C");
@@ -4014,49 +4092,28 @@ gfc_match_omp_ordered_depend (void)
 }
 
 
-static match
-gfc_match_omp_oacc_atomic (bool omp_p)
+/* omp atomic [clause-list]
+   - atomic-clause:  read | write | update
+   - capture
+   - memory-order-clause: seq_cst | acq_rel | release | acquire | relaxed
+   - hint(hint-expr)
+*/
+
+match
+gfc_match_omp_atomic (void)
 {
-  gfc_omp_atomic_op op = GFC_OMP_ATOMIC_UPDATE;
-  int seq_cst = 0;
-  if (gfc_match ("% seq_cst") == MATCH_YES)
-    seq_cst = 1;
-  locus old_loc = gfc_current_locus;
-  if (seq_cst && gfc_match_char (',') == MATCH_YES)
-    seq_cst = 2;
-  if (seq_cst == 2
-      || gfc_match_space () == MATCH_YES)
-    {
-      gfc_gobble_whitespace ();
-      if (gfc_match ("update") == MATCH_YES)
-       op = GFC_OMP_ATOMIC_UPDATE;
-      else if (gfc_match ("read") == MATCH_YES)
-       op = GFC_OMP_ATOMIC_READ;
-      else if (gfc_match ("write") == MATCH_YES)
-       op = GFC_OMP_ATOMIC_WRITE;
-      else if (gfc_match ("capture") == MATCH_YES)
-       op = GFC_OMP_ATOMIC_CAPTURE;
-      else
-       {
-         if (seq_cst == 2)
-           gfc_current_locus = old_loc;
-         goto finish;
-       }
-      if (!seq_cst
-         && (gfc_match (", seq_cst") == MATCH_YES
-             || gfc_match ("% seq_cst") == MATCH_YES))
-       seq_cst = 1;
-    }
- finish:
-  if (gfc_match_omp_eos () != MATCH_YES)
-    {
-      gfc_error ("Unexpected junk after $OMP ATOMIC statement at %C");
-      return MATCH_ERROR;
-    }
-  new_st.op = (omp_p ? EXEC_OMP_ATOMIC : EXEC_OACC_ATOMIC);
-  if (seq_cst)
-    op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST);
-  else if (omp_p)
+  gfc_omp_clauses *c;
+  locus loc = gfc_current_locus;
+
+  if (gfc_match_omp_clauses (&c, OMP_ATOMIC_CLAUSES, true, true) != MATCH_YES)
+    return MATCH_ERROR;
+  if (c->atomic_op == GFC_OMP_ATOMIC_UNSET)
+    c->atomic_op = GFC_OMP_ATOMIC_UPDATE;
+
+  if (c->capture && c->atomic_op != GFC_OMP_ATOMIC_UPDATE)
+    gfc_error ("OMP ATOMIC at %L with CAPTURE clause must be UPDATE", &loc);
+
+  if (c->memorder == OMP_MEMORDER_UNSET)
     {
       gfc_namespace *prog_unit = gfc_current_ns;
       while (prog_unit->parent)
@@ -4065,32 +4122,95 @@ gfc_match_omp_oacc_atomic (bool omp_p)
        {
        case 0:
        case OMP_REQ_ATOMIC_MEM_ORDER_RELAXED:
+         c->memorder = OMP_MEMORDER_RELAXED;
          break;
        case OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST:
-         op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST);
+         c->memorder = OMP_MEMORDER_SEQ_CST;
          break;
        case OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL:
-         op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_ACQ_REL);
+         if (c->atomic_op == GFC_OMP_ATOMIC_READ)
+           c->memorder = OMP_MEMORDER_ACQUIRE;
+         else if (c->atomic_op == GFC_OMP_ATOMIC_READ)
+           c->memorder = OMP_MEMORDER_RELEASE;
+         else
+           c->memorder = OMP_MEMORDER_ACQ_REL;
          break;
        default:
          gcc_unreachable ();
        }
     }
-  new_st.ext.omp_atomic = op;
+  else
+    switch (c->atomic_op)
+      {
+      case GFC_OMP_ATOMIC_READ:
+       if (c->memorder == OMP_MEMORDER_ACQ_REL
+           || c->memorder == OMP_MEMORDER_RELEASE)
+         {
+           gfc_error ("!$OMP ATOMIC READ at %L incompatible with "
+                      "ACQ_REL or RELEASE clauses", &loc);
+           c->memorder = OMP_MEMORDER_SEQ_CST;
+         }
+       break;
+      case GFC_OMP_ATOMIC_WRITE:
+       if (c->memorder == OMP_MEMORDER_ACQ_REL
+           || c->memorder == OMP_MEMORDER_ACQUIRE)
+         {
+           gfc_error ("!$OMP ATOMIC WRITE at %L incompatible with "
+                      "ACQ_REL or ACQUIRE clauses", &loc);
+           c->memorder = OMP_MEMORDER_SEQ_CST;
+         }
+       break;
+      case GFC_OMP_ATOMIC_UPDATE:
+       if (c->memorder == OMP_MEMORDER_ACQ_REL
+           || c->memorder == OMP_MEMORDER_ACQUIRE)
+         {
+           gfc_error ("!$OMP ATOMIC UPDATE at %L incompatible with "
+                      "ACQ_REL or ACQUIRE clauses", &loc);
+           c->memorder = OMP_MEMORDER_SEQ_CST;
+         }
+       break;
+      default:
+       break;
+      }
+  gfc_error_check ();
+  new_st.ext.omp_clauses = c;
+  new_st.op = EXEC_OMP_ATOMIC;
   return MATCH_YES;
 }
 
+
+/* acc atomic [ read | write | update | capture]
+   acc atomic update capture.  */
+
 match
 gfc_match_oacc_atomic (void)
 {
-  return gfc_match_omp_oacc_atomic (false);
+  gfc_omp_clauses *c = gfc_get_omp_clauses ();
+  c->atomic_op = GFC_OMP_ATOMIC_UPDATE;
+  c->memorder = OMP_MEMORDER_RELAXED;
+  gfc_gobble_whitespace ();
+  if (gfc_match ("update capture") == MATCH_YES)
+    c->capture = true;
+  else if (gfc_match ("update") == MATCH_YES)
+    ;
+  else if (gfc_match ("read") == MATCH_YES)
+    c->atomic_op = GFC_OMP_ATOMIC_READ;
+  else if (gfc_match ("write") == MATCH_YES)
+    c->atomic_op = GFC_OMP_ATOMIC_WRITE;
+  else if (gfc_match ("capture") == MATCH_YES)
+    c->capture = true;
+  gfc_gobble_whitespace ();
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after !$ACC ATOMIC statement at %C");
+      gfc_free_omp_clauses (c);
+      return MATCH_ERROR;
+    }
+  new_st.ext.omp_clauses = c;
+  new_st.op = EXEC_OACC_ATOMIC;
+  return MATCH_YES;
 }
 
-match
-gfc_match_omp_atomic (void)
-{
-  return gfc_match_omp_oacc_atomic (true);
-}
 
 match
 gfc_match_omp_barrier (void)
@@ -5514,11 +5634,12 @@ is_conversion (gfc_expr *expr, bool widening)
 static void
 resolve_omp_atomic (gfc_code *code)
 {
-  gfc_code *atomic_code = code;
+  gfc_code *atomic_code = code->block;
   gfc_symbol *var;
   gfc_expr *expr2, *expr2_tmp;
   gfc_omp_atomic_op aop
-    = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK);
+    = (gfc_omp_atomic_op) (atomic_code->ext.omp_clauses->atomic_op
+                          & GFC_OMP_ATOMIC_MASK);
 
   code = code->block->next;
   /* resolve_blocks asserts this is initially EXEC_ASSIGN.
@@ -5531,7 +5652,7 @@ resolve_omp_atomic (gfc_code *code)
       gfc_error ("unexpected !$OMP ATOMIC expression at %L", &code->loc);
       return;
     }
-  if (aop != GFC_OMP_ATOMIC_CAPTURE)
+  if (!atomic_code->ext.omp_clauses->capture)
     {
       if (code->next != NULL)
        goto unexpected;
@@ -5591,7 +5712,11 @@ resolve_omp_atomic (gfc_code *code)
                   "must be scalar and cannot reference var at %L",
                   &expr2->where);
       return;
-    case GFC_OMP_ATOMIC_CAPTURE:
+    default:
+      break;
+    }
+  if (atomic_code->ext.omp_clauses->capture)
+    {
       expr2_tmp = expr2;
       if (expr2 == code->expr2)
        {
@@ -5640,9 +5765,6 @@ resolve_omp_atomic (gfc_code *code)
          if (expr2 == NULL)
            expr2 = code->expr2;
        }
-      break;
-    default:
-      break;
     }
 
   if (gfc_expr_attr (code->expr1).allocatable)
@@ -5652,12 +5774,12 @@ resolve_omp_atomic (gfc_code *code)
       return;
     }
 
-  if (aop == GFC_OMP_ATOMIC_CAPTURE
+  if (atomic_code->ext.omp_clauses->capture
       && code->next == NULL
       && code->expr2->rank == 0
       && !expr_references_sym (code->expr2, var, NULL))
-    atomic_code->ext.omp_atomic
-      = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic
+    atomic_code->ext.omp_clauses->atomic_op
+      = (gfc_omp_atomic_op) (atomic_code->ext.omp_clauses->atomic_op
                             | GFC_OMP_ATOMIC_SWAP);
   else if (expr2->expr_type == EXPR_OP)
     {
@@ -5867,7 +5989,7 @@ resolve_omp_atomic (gfc_code *code)
     gfc_error ("!$OMP ATOMIC assignment must have an operator or "
               "intrinsic on right hand side at %L", &expr2->where);
 
-  if (aop == GFC_OMP_ATOMIC_CAPTURE && code->next)
+  if (atomic_code->ext.omp_clauses->capture && code->next)
     {
       code = code->next;
       if (code->expr1->expr_type != EXPR_VARIABLE
@@ -6866,6 +6988,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
                   "FROM clause", &code->loc);
       break;
     case EXEC_OMP_ATOMIC:
+      resolve_omp_clauses (code, code->block->ext.omp_clauses, NULL);
       resolve_omp_atomic (code);
       break;
     case EXEC_OMP_CRITICAL:
index 66696215c98a79d76bde443478c4ea8ecba07b92..e57669c51e5bf4334203fad86259a65b2d13debb 100644 (file)
@@ -5062,9 +5062,9 @@ parse_omp_oacc_atomic (bool omp_p)
   np = new_level (cp);
   np->op = cp->op;
   np->block = NULL;
-  np->ext.omp_atomic = cp->ext.omp_atomic;
-  count = 1 + ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
-              == GFC_OMP_ATOMIC_CAPTURE);
+  np->ext.omp_clauses = cp->ext.omp_clauses;
+  cp->ext.omp_clauses = NULL;
+  count = 1 + np->ext.omp_clauses->capture;
 
   while (count)
     {
@@ -5090,8 +5090,7 @@ parse_omp_oacc_atomic (bool omp_p)
       gfc_warning_check ();
       st = next_statement ();
     }
-  else if ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
-          == GFC_OMP_ATOMIC_CAPTURE)
+  else if (np->ext.omp_clauses->capture)
     gfc_error ("Missing !$OMP END ATOMIC after !$OMP ATOMIC CAPTURE at %C");
   return st;
 }
index 93b918b30777e88e040a00e4d74c48d02c6b7a21..45c144517f251ad94fad8b82657ad7c86999f541 100644 (file)
@@ -10731,15 +10731,12 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
        case EXEC_OMP_ATOMIC:
        case EXEC_OACC_ATOMIC:
          {
-           gfc_omp_atomic_op aop
-             = (gfc_omp_atomic_op) (b->ext.omp_atomic & GFC_OMP_ATOMIC_MASK);
-
            /* Verify this before calling gfc_resolve_code, which might
               change it.  */
            gcc_assert (b->next && b->next->op == EXEC_ASSIGN);
-           gcc_assert (((aop != GFC_OMP_ATOMIC_CAPTURE)
+           gcc_assert ((!b->ext.omp_clauses->capture
                         && b->next->next == NULL)
-                       || ((aop == GFC_OMP_ATOMIC_CAPTURE)
+                       || (b->ext.omp_clauses->capture
                            && b->next->next != NULL
                            && b->next->next->op == EXEC_ASSIGN
                            && b->next->next->next == NULL));
index f6937b934812a7819957c75a09447b7f0e2f8779..a3b0f12b17109d14f1e0d5b92f1e83d1b31d1724 100644 (file)
@@ -198,6 +198,7 @@ gfc_free_statement (gfc_code *p)
        gfc_free_oacc_declare_clauses (p->ext.oacc_declare);
       break;
 
+    case EXEC_OACC_ATOMIC:
     case EXEC_OACC_PARALLEL_LOOP:
     case EXEC_OACC_PARALLEL:
     case EXEC_OACC_KERNELS_LOOP:
@@ -213,6 +214,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OACC_ENTER_DATA:
     case EXEC_OACC_EXIT_DATA:
     case EXEC_OACC_ROUTINE:
+    case EXEC_OMP_ATOMIC:
     case EXEC_OMP_CANCEL:
     case EXEC_OMP_CANCELLATION_POINT:
     case EXEC_OMP_CRITICAL:
@@ -266,8 +268,6 @@ gfc_free_statement (gfc_code *p)
       gfc_free_omp_namelist (p->ext.omp_namelist);
       break;
 
-    case EXEC_OACC_ATOMIC:
-    case EXEC_OMP_ATOMIC:
     case EXEC_OMP_BARRIER:
     case EXEC_OMP_MASTER:
     case EXEC_OMP_END_NOWAIT:
index bd7e13d748e9c88ac7e5a418bfdfcb61bd8897bc..d02949ecbe4a4fb99905e19783c726cd89450299 100644 (file)
@@ -3967,7 +3967,7 @@ static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
 static tree
 gfc_trans_omp_atomic (gfc_code *code)
 {
-  gfc_code *atomic_code = code;
+  gfc_code *atomic_code = code->block;
   gfc_se lse;
   gfc_se rse;
   gfc_se vse;
@@ -3979,12 +3979,16 @@ gfc_trans_omp_atomic (gfc_code *code)
   enum tree_code aop = OMP_ATOMIC;
   bool var_on_left = false;
   enum omp_memory_order mo;
-  if (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST)
-    mo = OMP_MEMORY_ORDER_SEQ_CST;
-  else if (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_ACQ_REL)
-    mo = OMP_MEMORY_ORDER_ACQ_REL;
-  else
-    mo = OMP_MEMORY_ORDER_RELAXED;
+  switch (atomic_code->ext.omp_clauses->memorder)
+    {
+    case OMP_MEMORDER_UNSET: mo = OMP_MEMORY_ORDER_UNSPECIFIED; break;
+    case OMP_MEMORDER_ACQ_REL: mo = OMP_MEMORY_ORDER_ACQ_REL; break;
+    case OMP_MEMORDER_ACQUIRE: mo = OMP_MEMORY_ORDER_ACQUIRE; break;
+    case OMP_MEMORDER_RELAXED: mo = OMP_MEMORY_ORDER_RELAXED; break;
+    case OMP_MEMORDER_RELEASE: mo = OMP_MEMORY_ORDER_RELEASE; break;
+    case OMP_MEMORDER_SEQ_CST: mo = OMP_MEMORY_ORDER_SEQ_CST; break;
+    default: gcc_unreachable ();
+    }
 
   code = code->block->next;
   gcc_assert (code->op == EXEC_ASSIGN);
@@ -3996,16 +4000,16 @@ gfc_trans_omp_atomic (gfc_code *code)
   gfc_start_block (&block);
 
   expr2 = code->expr2;
-  if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
+  if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK)
        != GFC_OMP_ATOMIC_WRITE)
       && expr2->expr_type == EXPR_FUNCTION
       && expr2->value.function.isym
       && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
     expr2 = expr2->value.function.actual->expr;
 
-  switch (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
+  if ((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK)
+      == GFC_OMP_ATOMIC_READ)
     {
-    case GFC_OMP_ATOMIC_READ:
       gfc_conv_expr (&vse, code->expr1);
       gfc_add_block_to_block (&block, &vse.pre);
 
@@ -4023,7 +4027,9 @@ gfc_trans_omp_atomic (gfc_code *code)
       gfc_add_block_to_block (&block, &rse.pre);
 
       return gfc_finish_block (&block);
-    case GFC_OMP_ATOMIC_CAPTURE:
+    }
+  if (atomic_code->ext.omp_clauses->capture)
+    {
       aop = OMP_ATOMIC_CAPTURE_NEW;
       if (expr2->expr_type == EXPR_VARIABLE)
        {
@@ -4042,9 +4048,6 @@ gfc_trans_omp_atomic (gfc_code *code)
              && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
            expr2 = expr2->value.function.actual->expr;
        }
-      break;
-    default:
-      break;
     }
 
   gfc_conv_expr (&lse, code->expr1);
@@ -4052,9 +4055,9 @@ gfc_trans_omp_atomic (gfc_code *code)
   type = TREE_TYPE (lse.expr);
   lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
 
-  if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
+  if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK)
        == GFC_OMP_ATOMIC_WRITE)
-      || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP))
+      || (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_SWAP))
     {
       gfc_conv_expr (&rse, expr2);
       gfc_add_block_to_block (&block, &rse.pre);
@@ -4190,9 +4193,9 @@ gfc_trans_omp_atomic (gfc_code *code)
 
   rhs = gfc_evaluate_now (rse.expr, &block);
 
-  if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK)
+  if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK)
        == GFC_OMP_ATOMIC_WRITE)
-      || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP))
+      || (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_SWAP))
     x = rhs;
   else
     {
@@ -4791,7 +4794,7 @@ gfc_trans_omp_flush (gfc_code *code)
 {
   tree call;
   if (!code->ext.omp_clauses
-      || code->ext.omp_clauses->memorder == OMP_MEMORDER_LAST)
+      || code->ext.omp_clauses->memorder == OMP_MEMORDER_UNSET)
     {
       call = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
       call = build_call_expr_loc (input_location, call, 0);
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
new file mode 100644 (file)
index 0000000..5094caa
--- /dev/null
@@ -0,0 +1,33 @@
+! { dg-do compile }
+
+subroutine bar
+  integer :: i, v
+  real :: f
+  !$omp atomic update acq_rel hint("abc") ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
+    ! { dg-error "HINT clause at .1. requires a scalar INTEGER expression" "" { target *-*-* } .-1 }
+    ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" "" { target *-*-* } .-2 }
+    i = i + 1
+  !$omp end atomic
+
+  !$omp atomic acq_rel capture ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
+  i = i + 1
+  v = i
+  !$omp end atomic
+
+  !$omp atomic capture,acq_rel , hint (1), update ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
+  i = i + 1
+  v = i
+  !$omp end atomic
+
+  !$omp atomic hint(0),acquire capture ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
+  i = i + 1
+  v = i
+  !$omp end atomic
+
+  !$omp atomic write capture ! { dg-error "OMP ATOMIC at .1. with CAPTURE clause must be UPDATE" }
+  i = 2
+  v = i
+  !$omp end atomic
+
+  !$omp atomic foobar ! { dg-error "Failed to match clause" }
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic.f90
new file mode 100644 (file)
index 0000000..8a1cf5b
--- /dev/null
@@ -0,0 +1,111 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+! { dg-final { scan-tree-dump-times "#pragma omp atomic relaxed" 4 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp atomic release" 4 "original" } }
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture relaxed" 4 "original" } }
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture release" 2 "original" } }
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic read acquire" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst" 7 "original" } }
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic read seq_cst" 3 "original" } }
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture seq_cst" 6 "original" } }
+
+
+subroutine foo ()
+  integer :: x, v
+  !$omp atomic
+  i = i + 2
+
+  !$omp atomic relaxed
+  i = i + 2
+
+  !$omp atomic seq_cst read
+  v = x
+  !$omp atomic seq_cst, read
+  v = x
+  !$omp atomic seq_cst write
+  x = v
+  !$omp atomic seq_cst ,write
+  x = v
+  !$omp atomic seq_cst update
+  x = x + v
+  !$omp atomic seq_cst , update
+  x = x + v
+  !$omp atomic seq_cst capture
+  x = x + 2
+  v = x
+  !$omp end atomic
+  !$omp atomic update seq_cst capture
+  x = x + 2
+  v = x
+  !$omp end atomic
+  !$omp atomic seq_cst, capture
+  x = x + 2
+  v = x
+  !$omp end atomic
+  !$omp atomic seq_cst, capture, update
+  x = x + 2
+  v = x
+  !$omp end atomic
+  !$omp atomic read , seq_cst
+  v = x
+  !$omp atomic write ,seq_cst
+  x = v
+  !$omp atomic update, seq_cst
+  x = x + v
+  !$omp atomic capture, seq_cst
+  x = x + 2
+  v = x
+  !$omp end atomic
+  !$omp atomic capture, seq_cst ,update
+  x = x + 2
+  v = x
+  !$omp end atomic
+end
+
+subroutine bar
+  integer :: i, v
+  real :: f
+  !$omp atomic release, hint (0), update
+  i = i + 1
+  !$omp end atomic
+  !$omp atomic hint(0)seq_cst
+  i = i + 1
+  !$omp atomic relaxed,update,hint (0)
+  i = i + 1
+  !$omp atomic release
+  i = i + 1
+  !$omp atomic relaxed
+  i = i + 1
+  !$omp atomic relaxed capture update
+  i = i + 1
+  v = i
+  !$omp end atomic
+  !$omp atomic relaxed capture
+  i = i + 1
+  v = i
+  !$omp end atomic
+  !$omp atomic capture,release , hint (1)
+  i = i + 1
+  v = i
+  !$omp end atomic
+  !$omp atomic update capture,release , hint (1)
+  i = i + 1
+  v = i
+  !$omp end atomic
+  !$omp atomic hint(0),relaxed capture
+  i = i + 1
+  v = i
+  !$omp end atomic
+  !$omp atomic hint(0),update relaxed capture
+  i = i + 1
+  v = i
+  !$omp end atomic
+  !$omp atomic read acquire
+  v = i
+  !$omp atomic release,write
+  i = v
+  !$omp atomic hint(1),update,release
+  f = f + 2.0
+end