trans.c (gfc_allocate_using_lib,gfc_deallocate_with_status): Introducing __asm__...
authorTobias Burnus <burnus@net-b.de>
Wed, 9 Dec 2015 22:15:47 +0000 (23:15 +0100)
committerTobias Burnus <burnus@gcc.gnu.org>
Wed, 9 Dec 2015 22:15:47 +0000 (23:15 +0100)
2015-12-09  Tobias Burnus  <burnus@net-b.de>
            Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>

        * trans.c (gfc_allocate_using_lib,gfc_deallocate_with_status):
        Introducing __asm__ __volatile__ ("":::"memory")
        after image control statements.
        * trans-stmt.c  (gfc_trans_sync, gfc_trans_event_post_wait,
        gfc_trans_lock_unlock, gfc_trans_critical): Ditto.
        * trans-intrinsic.c (gfc_conv_intrinsic_caf_get,
        conv_caf_send): Introducing __asm__ __volatile__ ("":::"memory")
        after send, before get and around sendget.

2015-12-09  Tobias Burnus  <burnus@net-b.de>
            Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>

        * gfortran.dg/coarray_40.f90: New.

Co-Authored-By: Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
From-SVN: r231476

gcc/fortran/ChangeLog
gcc/fortran/trans-intrinsic.c
gcc/fortran/trans-stmt.c
gcc/fortran/trans.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/coarray_40.f90 [new file with mode: 0644]

index 53c0bda672dd9e82ed4c5110a5c0c61f210acf27..f417aa8c2d01629e10960d68ec7df6a46bfaafc0 100644 (file)
@@ -1,3 +1,15 @@
+2015-12-09  Tobias Burnus  <burnus@net-b.de>
+           Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
+
+       * trans.c (gfc_allocate_using_lib,gfc_deallocate_with_status):
+       Introducing __asm__ __volatile__ ("":::"memory")
+       after image control statements.
+       * trans-stmt.c  (gfc_trans_sync, gfc_trans_event_post_wait,
+       gfc_trans_lock_unlock, gfc_trans_critical): Ditto.
+       * trans-intrinsic.c (gfc_conv_intrinsic_caf_get,
+       conv_caf_send): Introducing __asm__ __volatile__ ("":::"memory")
+       after send, before get and around sendget.
+
 2015-12-09  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/68815
index 21efe4412bdcb02535c0cb7398507b40787e7cf1..31bad3563185a7198bfeb5b6bf7495561c37a0a2 100644 (file)
@@ -1211,6 +1211,14 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   if (lhs == NULL_TREE)
     may_require_tmp = boolean_false_node;
 
+  /* It guarantees memory consistency within the same segment */
+  tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+  tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+                   gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
+                   tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
+  ASM_VOLATILE_P (tmp) = 1;
+  gfc_add_expr_to_block (&se->pre, tmp);
+
   tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 9,
                             token, offset, image_index, argse.expr, vec,
                             dst_var, kind, lhs_kind, may_require_tmp);
@@ -1375,6 +1383,14 @@ conv_caf_send (gfc_code *code) {
     {
       tree rhs_token, rhs_offset, rhs_image_index;
 
+      /* It guarantees memory consistency within the same segment */
+      tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+       tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+                         gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
+                         tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
+      ASM_VOLATILE_P (tmp) = 1;
+      gfc_add_expr_to_block (&block, tmp);
+
       caf_decl = gfc_get_tree_for_caf_expr (rhs_expr);
       if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE)
        caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
@@ -1390,6 +1406,15 @@ conv_caf_send (gfc_code *code) {
   gfc_add_expr_to_block (&block, tmp);
   gfc_add_block_to_block (&block, &lhs_se.post);
   gfc_add_block_to_block (&block, &rhs_se.post);
+
+  /* It guarantees memory consistency within the same segment */
+  tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+  tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+                   gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
+                   tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
+  ASM_VOLATILE_P (tmp) = 1;
+  gfc_add_expr_to_block (&block, tmp);
+
   return gfc_finish_block (&block);
 }
 
index 3df483a29180ae350819dfdf23079c5c717992ab..72416d48bf4450e4804e243eb9c2a37daf09594a 100644 (file)
@@ -818,6 +818,15 @@ gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
                                   errmsg, errmsg_len);
       gfc_add_expr_to_block (&se.pre, tmp);
 
+      /* It guarantees memory consistency within the same segment */
+      tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+      tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+                       gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
+                       tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
+      ASM_VOLATILE_P (tmp) = 1;
+
+      gfc_add_expr_to_block (&se.pre, tmp);
+
       if (stat2 != NULL_TREE)
        gfc_add_modify (&se.pre, stat2,
                        fold_convert (TREE_TYPE (stat2), stat));
@@ -995,6 +1004,14 @@ gfc_trans_event_post_wait (gfc_code *code, gfc_exec_op op)
                               errmsg, errmsg_len);
   gfc_add_expr_to_block (&se.pre, tmp);
 
+  /* It guarantees memory consistency within the same segment */
+  tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+  tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+                   gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
+                   tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
+  ASM_VOLATILE_P (tmp) = 1;
+  gfc_add_expr_to_block (&se.pre, tmp);
+
   if (stat2 != NULL_TREE)
     gfc_add_modify (&se.pre, stat2, fold_convert (TREE_TYPE (stat2), stat));
 
@@ -1080,6 +1097,18 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
                               fold_convert (integer_type_node, images));
     }
 
+  /* Per F2008, 8.5.1, a SYNC MEMORY is implied by calling the
+     image control statements SYNC IMAGES and SYNC ALL.  */
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+      tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+                       gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
+                       tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
+      ASM_VOLATILE_P (tmp) = 1;
+      gfc_add_expr_to_block (&se.pre, tmp);
+    }
+
   if (flag_coarray != GFC_FCOARRAY_LIB)
     {
       /* Set STAT to zero.  */
@@ -1399,6 +1428,17 @@ gfc_trans_critical (gfc_code *code)
                                 null_pointer_node, null_pointer_node,
                                 null_pointer_node, integer_zero_node);
       gfc_add_expr_to_block (&block, tmp);
+
+      /* It guarantees memory consistency within the same segment */
+      tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+       tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+                         gfc_build_string_const (1, ""),
+                         NULL_TREE, NULL_TREE,
+                         tree_cons (NULL_TREE, tmp, NULL_TREE),
+                         NULL_TREE);
+      ASM_VOLATILE_P (tmp) = 1;
+  
+      gfc_add_expr_to_block (&block, tmp);
     }
 
   tmp = gfc_trans_code (code->block->next);
@@ -1411,8 +1451,18 @@ gfc_trans_critical (gfc_code *code)
                                 null_pointer_node, null_pointer_node,
                                 integer_zero_node);
       gfc_add_expr_to_block (&block, tmp);
-    }
 
+      /* It guarantees memory consistency within the same segment */
+      tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+       tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+                         gfc_build_string_const (1, ""),
+                         NULL_TREE, NULL_TREE,
+                         tree_cons (NULL_TREE, tmp, NULL_TREE),
+                         NULL_TREE);
+      ASM_VOLATILE_P (tmp) = 1;
+
+      gfc_add_expr_to_block (&block, tmp);
+    }
 
   return gfc_finish_block (&block);
 }
index 001db41ca8344cd6c6e26e53feeb7d73714e38b8..19937436fcf8f09e05bce67fc029e5b3d02bc433 100644 (file)
@@ -746,6 +746,14 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size,
                         TREE_TYPE (pointer), pointer,
                         fold_convert ( TREE_TYPE (pointer), tmp));
   gfc_add_expr_to_block (block, tmp);
+
+  /* It guarantees memory consistency within the same segment */
+  tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+  tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+                   gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
+                   tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
+  ASM_VOLATILE_P (tmp) = 1;
+  gfc_add_expr_to_block (block, tmp);
 }
 
 
@@ -1356,6 +1364,14 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
             token, pstat, errmsg, errlen);
       gfc_add_expr_to_block (&non_null, tmp);
 
+      /* It guarantees memory consistency within the same segment */
+      tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
+      tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+                       gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
+                       tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
+      ASM_VOLATILE_P (tmp) = 1;
+      gfc_add_expr_to_block (&non_null, tmp);
+
       if (status != NULL_TREE)
        {
          tree stat = build_fold_indirect_ref_loc (input_location, status);
index 17f7b07e48acda4fbd32e0a8da41c4ee26dff4ae..f09a875ec24a308b5782a2f45c3e14eeac0b9329 100644 (file)
@@ -1,3 +1,8 @@
+2015-12-09  Tobias Burnus  <burnus@net-b.de>
+           Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
+
+       * gfortran.dg/coarray_40.f90: New.
+
 2015-12-08  Jan Hubicka  <hubicka@ucw.cz>
 
        PR lto/68811
diff --git a/gcc/testsuite/gfortran.dg/coarray_40.f90 b/gcc/testsuite/gfortran.dg/coarray_40.f90
new file mode 100644 (file)
index 0000000..84af50e
--- /dev/null
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+!
+! Run-time test for memory consistency
+!
+! Contributed by Deepak Eachempati
+
+program cp_bug
+    implicit none
+    integer :: v1, v2, u[*]
+    integer :: me
+
+    me = this_image()
+
+    u = 0
+    v1 = 10
+
+    v1 = u[me]
+
+    ! v2 should get value in u (0)
+    v2 = v1
+
+    if(v2 /= u) call abort()
+
+end program