gcc/fortran/

2014-08-14  Tobias Burnus  <burnus@net-b.de>

        * gfortran.texi (caf_register_t): Add CAF_REGTYPE_CRITICAL.
        (_gfortran_caf_register): Update for locking/critical.
        (_gfortran_caf_lock, _gfortran_caf_unlock): Add.
        * resolve.c (resolve_critical): New.
        (gfc_resolve_code): Call it.
        * trans-decl.c (gfor_fndecl_caf_critical,
        gfor_fndecl_caf_end_critical): Remove.
        (gfor_fndecl_caf_lock, gfor_fndecl_caf_unlock): Add.
        (gfc_build_builtin_function_decls): Remove critical,
        assign locking declarations.
        (generate_coarray_sym_init): Handle locking and
        critical variables.
        * trans-stmt.c (gfc_trans_critical): Add calls to
        lock/unlock libcaf functions.
        * trans.h (gfc_coarray_type): Update locking, add
        critical enum values.
        (gfor_fndecl_caf_critical, gfor_fndecl_caf_end_critical): Remove.
        (gfor_fndecl_caf_lock, gfor_fndecl_caf_unlock): Add.

libgfortran/
2014-08-14  Tobias Burnus  <burnus@net-b.de>

        * caf/libcaf.h (caf_register_t): Update for critical.
        (_gfortran_caf_critical, _gfortran_caf_end_critical): Remove.
        (_gfortran_caf_lock, _gfortran_caf_unlock): Add.
        * caf/single.c (_gfortran_caf_register): Handle locking
        variables.
        (_gfortran_caf_sendget): Re-name args for consistency.
        (_gfortran_caf_lock, _gfortran_caf_unlock): Add.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213979 138bc75d-0d04-0410-961f-82ee72b054a4

2 files changed, 94 insertions, 16 deletions

diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 0ae7135885f..85d6811facf 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -55,8 +55,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 typedef enum caf_register_t {
   CAF_REGTYPE_COARRAY_STATIC,
   CAF_REGTYPE_COARRAY_ALLOC,
-  CAF_REGTYPE_LOCK,
-  CAF_REGTYPE_LOCK_COMP
+  CAF_REGTYPE_LOCK_STATIC,
+  CAF_REGTYPE_LOCK_ALLOC,
+  CAF_REGTYPE_CRITICAL
 }
 caf_register_t;
 
@@ -101,15 +102,6 @@ void _gfortran_caf_deregister (caf_token_t *, int *, char *, int);
 void _gfortran_caf_sync_all (int *, char *, int);
 void _gfortran_caf_sync_images (int, int[], int *, char *, int);
 
-/* FIXME: The CRITICAL functions should be removed;
-   the functionality is better represented using Coarray's lock feature.  */
-void _gfortran_caf_critical (void);
-void _gfortran_caf_critical (void)  { }
-
-void _gfortran_caf_end_critical (void);
-void _gfortran_caf_end_critical (void)  { }
-
-
 void _gfortran_caf_error_stop_str (const char *, int32_t)
      __attribute__ ((noreturn));
 void _gfortran_caf_error_stop (int32_t) __attribute__ ((noreturn));
@@ -137,4 +129,8 @@ 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);
+
+void _gfortran_caf_lock (caf_token_t, size_t, int, int *, int *, char *, int);
+void _gfortran_caf_unlock (caf_token_t, size_t, int, int *, char *, int);
+
 #endif  /* LIBCAF_H  */
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 1f5da7293e5..990953ae4db 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -100,7 +100,11 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
 {
   void *local;
 
-  local = malloc (size);
+  if (type == CAF_REGTYPE_LOCK_STATIC || type == CAF_REGTYPE_LOCK_ALLOC
+      || type == CAF_REGTYPE_CRITICAL)
+    local = calloc (size, sizeof (bool));
+  else
+    local = malloc (size);
   *token = malloc (sizeof (single_token_t));
 
   if (unlikely (local == NULL || token == NULL))
@@ -128,7 +132,8 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
   if (stat)
     *stat = 0;
 
-  if (type == CAF_REGTYPE_COARRAY_STATIC)
+  if (type == CAF_REGTYPE_COARRAY_STATIC || type == CAF_REGTYPE_LOCK_STATIC
+      || type == CAF_REGTYPE_CRITICAL)
     {
       caf_static_t *tmp = malloc (sizeof (caf_static_t));
       tmp->prev  = caf_static_list;
@@ -526,7 +531,7 @@ error:
 void
 _gfortran_caf_get (caf_token_t token, size_t offset,
 		   int image_index __attribute__ ((unused)),
-		   gfc_descriptor_t *src ,
+		   gfc_descriptor_t *src,
 		   caf_vector_t *src_vector __attribute__ ((unused)),
 		   gfc_descriptor_t *dest, int src_kind, int dst_kind)
 {
@@ -764,7 +769,7 @@ _gfortran_caf_sendget (caf_token_t dst_token, size_t dst_offset,
 		       int src_image_index __attribute__ ((unused)),
 		       gfc_descriptor_t *src,
 		       caf_vector_t *src_vector __attribute__ ((unused)),
-		       int dst_len, int src_len)
+		       int dst_kind, int src_kind)
 {
   /* FIXME: Handle vector subscript of 'src_vector'.  */
   /* For a single image, src->base_addr should be the same as src_token + offset
@@ -772,7 +777,7 @@ _gfortran_caf_sendget (caf_token_t dst_token, size_t dst_offset,
   void *src_base = GFC_DESCRIPTOR_DATA (src);
   GFC_DESCRIPTOR_DATA (src) = (void *) ((char *) TOKEN (src_token) + src_offset);
   _gfortran_caf_send (dst_token, dst_offset, dst_image_index, dest, dst_vector,
-		      src, dst_len, src_len);
+		      src, dst_kind, src_kind);
   GFC_DESCRIPTOR_DATA (src) = src_base;
 }
 
@@ -864,3 +869,80 @@ _gfortran_caf_atomic_op (int op, caf_token_t token, size_t offset,
   if (stat)
     *stat = 0;
 }
+
+
+void
+_gfortran_caf_lock (caf_token_t token, size_t index,
+		    int image_index __attribute__ ((unused)),
+		    int *aquired_lock, int *stat, char *errmsg, int errmsg_len)
+{
+  const char *msg = "Already locked";
+  bool *lock = &((bool *) TOKEN (token))[index];
+
+  if (!*lock)
+    {
+      *lock = true;
+      if (aquired_lock)
+	*aquired_lock = (int) true;
+      if (stat)
+	*stat = 0;
+      return;
+    }
+
+  if (aquired_lock)
+    {
+      *aquired_lock = (int) false;
+      if (stat)
+	*stat = 0;
+    return;
+    }
+
+
+  if (stat)
+    {
+      *stat = 1;
+      if (errmsg_len > 0)
+	{
+	  int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
+						      : (int) sizeof (msg);
+	  memcpy (errmsg, msg, len);
+	  if (errmsg_len > len)
+	    memset (&errmsg[len], ' ', errmsg_len-len);
+	}
+      return;
+    }
+  _gfortran_caf_error_stop_str (msg, (int32_t) strlen (msg));
+}
+
+
+void
+_gfortran_caf_unlock (caf_token_t token, size_t index,
+		      int image_index __attribute__ ((unused)),
+		      int *stat, char *errmsg, int errmsg_len)
+{
+  const char *msg = "Variable is not locked";
+  bool *lock = &((bool *) TOKEN (token))[index];
+
+  if (*lock)
+    {
+      *lock = false;
+      if (stat)
+	*stat = 0;
+      return;
+    }
+
+  if (stat)
+    {
+      *stat = 1;
+      if (errmsg_len > 0)
+	{
+	  int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
+						      : (int) sizeof (msg);
+	  memcpy (errmsg, msg, len);
+	  if (errmsg_len > len)
+	    memset (&errmsg[len], ' ', errmsg_len-len);
+	}
+      return;
+    }
+  _gfortran_caf_error_stop_str (msg, (int32_t) strlen (msg));
+}