libgfortran.h (libcaf_atomic_codes): Add.

2014-07-12  Tobias Burnus  <burnus@net-b.de>

gcc/fortran/
        * libgfortran.h (libcaf_atomic_codes): Add.
        * trans-decl.c (gfor_fndecl_caf_atomic_def,
        gfor_fndecl_caf_atomic_ref, gfor_fndecl_caf_atomic_cas,
        gfor_fndecl_caf_atomic_op): New variables.
        (gfc_build_builtin_function_decls): Initialize them.
        * trans.h (gfor_fndecl_caf_atomic_def,
        gfor_fndecl_caf_atomic_ref, gfor_fndecl_caf_atomic_cas,
        gfor_fndecl_caf_atomic_op): New variables.
        * trans-intrinsic.c (conv_intrinsic_atomic_op,
        conv_intrinsic_atomic_ref, conv_intrinsic_atomic_cas):
        Add library calls with -fcoarray=lib.

libgfortran/
        * caf/libcaf.h (_gfortran_caf_atomic_define,
        _gfortran_caf_atomic_ref, _gfortran_caf_atomic_op,
        _gfortran_caf_atomic_cas): New prototypes.
        * caf/single.c (_gfortran_caf_atomic_define,
        _gfortran_caf_atomic_ref, _gfortran_caf_atomic_op,
        _gfortran_caf_atomic_cas): New functions.

From-SVN: r212484

gcc/fortran/ChangeLog

 2014-07-12  Tobias Burnus  <burnus@net-b.de>
 
+	* libgfortran.h (libcaf_atomic_codes): Add.
+	* trans-decl.c (gfor_fndecl_caf_atomic_def,
+	gfor_fndecl_caf_atomic_ref, gfor_fndecl_caf_atomic_cas,
+	gfor_fndecl_caf_atomic_op): New variables.
+	(gfc_build_builtin_function_decls): Initialize them.
+	* trans.h (gfor_fndecl_caf_atomic_def,
+	gfor_fndecl_caf_atomic_ref, gfor_fndecl_caf_atomic_cas,
+	gfor_fndecl_caf_atomic_op): New variables.
+	* trans-intrinsic.c (conv_intrinsic_atomic_op,
+	conv_intrinsic_atomic_ref, conv_intrinsic_atomic_cas):
+	Add library calls with -fcoarray=lib.
+
+2014-07-12  Tobias Burnus  <burnus@net-b.de>
+
 	* check.c (gfc_check_atomic): Update for STAT=.
 	(gfc_check_atomic_def, gfc_check_atomic_ref): Update call.
 	(gfc_check_atomic_op, gfc_check_atomic_cas,

gcc/fortran/libgfortran.h

@@ -120,6 +120,14 @@ typedef enum
 }
 libgfortran_stat_codes;
 
+typedef enum
+{
+  GFC_CAF_ATOMIC_ADD = 1,
+  GFC_CAF_ATOMIC_AND,
+  GFC_CAF_ATOMIC_OR,
+  GFC_CAF_ATOMIC_XOR
+} libcaf_atomic_codes;
+
 /* Default unit number for preconnected standard input and output.  */
 #define GFC_STDIN_UNIT_NUMBER 5
 #define GFC_STDOUT_UNIT_NUMBER 6

gcc/fortran/trans-decl.c

@@ -141,6 +141,10 @@ tree gfor_fndecl_caf_sync_all;
 tree gfor_fndecl_caf_sync_images;
 tree gfor_fndecl_caf_error_stop;
 tree gfor_fndecl_caf_error_stop_str;
+tree gfor_fndecl_caf_atomic_def;
+tree gfor_fndecl_caf_atomic_ref;
+tree gfor_fndecl_caf_atomic_cas;
+tree gfor_fndecl_caf_atomic_op;
 tree gfor_fndecl_co_max;
 tree gfor_fndecl_co_min;
 tree gfor_fndecl_co_sum;
@@ -3391,6 +3395,28 @@ gfc_build_builtin_function_decls (void)
       /* CAF's ERROR STOP doesn't return.  */
       TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop_str) = 1;
 
+      gfor_fndecl_caf_atomic_def = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_atomic_define")), "R..RW",
+	void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
+        pvoid_type_node, pint_type, integer_type_node, integer_type_node);
+
+      gfor_fndecl_caf_atomic_ref = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_atomic_ref")), "R..WW",
+	void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
+        pvoid_type_node, pint_type, integer_type_node, integer_type_node);
+
+      gfor_fndecl_caf_atomic_cas = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_atomic_cas")), "R..WRRW",
+	void_type_node, 9, pvoid_type_node, size_type_node, integer_type_node,
+        pvoid_type_node, pvoid_type_node, pvoid_type_node, pint_type,
+	integer_type_node, integer_type_node);
+
+      gfor_fndecl_caf_atomic_op = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_atomic_op")), ".R..RWW",
+	void_type_node, 9, integer_type_node, pvoid_type_node, size_type_node,
+	integer_type_node, pvoid_type_node, pvoid_type_node, pint_type,
+	integer_type_node, integer_type_node);
+
       gfor_fndecl_co_max = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_co_max")), "W.WW",
 	void_type_node, 6, pvoid_type_node, integer_type_node,

gcc/fortran/trans.h

@@ -720,6 +720,10 @@ extern GTY(()) tree gfor_fndecl_caf_sync_all;
 extern GTY(()) tree gfor_fndecl_caf_sync_images;
 extern GTY(()) tree gfor_fndecl_caf_error_stop;
 extern GTY(()) tree gfor_fndecl_caf_error_stop_str;
+extern GTY(()) tree gfor_fndecl_caf_atomic_def;
+extern GTY(()) tree gfor_fndecl_caf_atomic_ref;
+extern GTY(()) tree gfor_fndecl_caf_atomic_cas;
+extern GTY(()) tree gfor_fndecl_caf_atomic_op;
 extern GTY(()) tree gfor_fndecl_co_max;
 extern GTY(()) tree gfor_fndecl_co_min;
 extern GTY(()) tree gfor_fndecl_co_sum;

libgfortran/ChangeLog

+2014-07-12  Tobias Burnus  <burnus@net-b.de>
+
+	* caf/libcaf.h (_gfortran_caf_atomic_define,
+	_gfortran_caf_atomic_ref, _gfortran_caf_atomic_op,
+	_gfortran_caf_atomic_cas): New prototypes.
+	* caf/single.c (_gfortran_caf_atomic_define,
+	_gfortran_caf_atomic_ref, _gfortran_caf_atomic_op,
+	_gfortran_caf_atomic_cas): New functions.
+
 2014-07-10  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	* config/fpu-*.h (get_fpu_rounding_mode, set_fpu_rounding_mode,

libgfortran/caf/libcaf.h

@@ -128,4 +128,13 @@ void _gfortran_caf_send (caf_token_t, size_t, int, gfc_descriptor_t *,
 void _gfortran_caf_sendget (caf_token_t, size_t, int, gfc_descriptor_t *,
 			    caf_vector_t *, caf_token_t, size_t, int,
 			    gfc_descriptor_t *, caf_vector_t *, int, int);
+
+void _gfortran_caf_atomic_define (caf_token_t, size_t, int, void *, int *,
+				  int, int);
+void _gfortran_caf_atomic_ref (caf_token_t, size_t, int, void *, int *,
+			       int, int);
+void _gfortran_caf_atomic_cas (caf_token_t, size_t, int, void *, void *,
+			       void *, int *, int, int);
+void _gfortran_caf_atomic_op (int, caf_token_t, size_t, int, void *, void *,
+			      int *, int, int);
 #endif  /* LIBCAF_H  */

libgfortran/caf/single.c

@@ -28,6 +28,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include <stdlib.h> /* For exit and malloc.  */
 #include <string.h> /* For memcpy and memset.  */
 #include <stdarg.h> /* For variadic arguments.  */
+#include <assert.h>
 
 /* Define GFC_CAF_CHECK to enable run-time checking.  */
 /* #define GFC_CAF_CHECK  1  */
@@ -774,3 +775,92 @@ _gfortran_caf_sendget (caf_token_t dst_token, size_t dst_offset,
 		      src, dst_len, src_len);
   GFC_DESCRIPTOR_DATA (src) = src_base;
 }
+
+
+void
+_gfortran_caf_atomic_define (caf_token_t token, size_t offset,
+			     int image_index __attribute__ ((unused)),
+			     void *value, int *stat,
+			     int type __attribute__ ((unused)), int kind)
+{
+  assert(kind == 4);
+
+  uint32_t *atom = (uint32_t *) ((char *) TOKEN (token) + offset);
+
+  __atomic_store (atom, (uint32_t *) value, __ATOMIC_RELAXED);
+
+  if (stat)
+    *stat = 0;
+}
+
+void
+_gfortran_caf_atomic_ref (caf_token_t token, size_t offset,
+			  int image_index __attribute__ ((unused)),
+			  void *value, int *stat,
+			  int type __attribute__ ((unused)), int kind)
+{
+  assert(kind == 4);
+
+  uint32_t *atom = (uint32_t *) ((char *) TOKEN (token) + offset);
+
+  __atomic_load (atom, (uint32_t *) value, __ATOMIC_RELAXED);
+
+  if (stat)
+    *stat = 0;
+}
+
+
+void
+_gfortran_caf_atomic_cas (caf_token_t token, size_t offset,
+			  int image_index __attribute__ ((unused)),
+			  void *old, void *compare, void *new_val, int *stat,
+			  int type __attribute__ ((unused)), int kind)
+{
+  assert(kind == 4);
+
+  uint32_t *atom = (uint32_t *) ((char *) TOKEN (token) + offset);
+
+  *(uint32_t *) old = *(uint32_t *) compare;
+  (void) __atomic_compare_exchange_n (atom, (uint32_t *) old,
+				      *(uint32_t *) new_val, false,
+				      __ATOMIC_RELAXED, __ATOMIC_RELAXED);
+  if (stat)
+    *stat = 0;
+}
+
+
+void
+_gfortran_caf_atomic_op (int op, caf_token_t token, size_t offset,
+			 int image_index __attribute__ ((unused)),
+			 void *value, void *old, int *stat,
+			 int type __attribute__ ((unused)), int kind)
+{
+  assert(kind == 4);
+
+  uint32_t res;
+  uint32_t *atom = (uint32_t *) ((char *) TOKEN (token) + offset);
+
+  switch (op)
+    {
+    case GFC_CAF_ATOMIC_ADD:
+      res = __atomic_fetch_add (atom, *(uint32_t *) value, __ATOMIC_RELAXED);
+      break;
+    case GFC_CAF_ATOMIC_AND:
+      res = __atomic_fetch_and (atom, *(uint32_t *) value, __ATOMIC_RELAXED);
+      break;
+    case GFC_CAF_ATOMIC_OR:
+      res = __atomic_fetch_or (atom, *(uint32_t *) value, __ATOMIC_RELAXED);
+      break;
+    case GFC_CAF_ATOMIC_XOR:
+      res = __atomic_fetch_xor (atom, *(uint32_t *) value, __ATOMIC_RELAXED);
+      break;
+    default:
+      __builtin_unreachable();
+    }
+
+  if (old)
+    *(uint32_t *) old = res;
+
+  if (stat)
+    *stat = 0;
+}