This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

First Patch


Hello,

I'd like to submit my first patch for my Google Summer of Code project.

This is a simple patch, mostly intended to help me learn how GFortran works. The patch changes the function calls:


int status = _gfortran_caf_sync_all (char *errmsg, int errmsg_len)
int status = _gfortran_caf_sync_images (int count, int images[], char *errmsg, int errmsg_len)



So that the "status" is in the arguments:


void _gfortran_caf_sync_all (int *status, char *errmsg, int errmsg_len)

void _gfortran_caf_sync_images (int *status, int count, int images[], char *errmsg, int errmsg_len)



Needless to say, I have tested that the patch compiles fine (using the SVN pull from yesterday) and all tests continue to work.

Cheers,
Daniel.
--
I'm not overweight, I'm undertall.
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(revision 174722)
+++ gcc/fortran/trans-stmt.c	(working copy)
@@ -683,7 +683,9 @@
       gfc_conv_expr_val (&argse, code->expr2);
       stat = argse.expr;
     }
-
+   else
+     stat = null_pointer_node;
+   
   if (code->expr3 && gfc_option.coarray == GFC_FCOARRAY_LIB
       && type != EXEC_SYNC_MEMORY)
     {
@@ -743,14 +745,36 @@
     }
   else if (type == EXEC_SYNC_ALL)
     {
-      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
-				 2, errmsg, errmsglen);
-      if (code->expr2)
-	gfc_add_modify (&se.pre, stat, fold_convert (TREE_TYPE (stat), tmp));
+       /*
+          SYNC ALL           =>   stat == null_pointer_node
+          SYNC ALL(stat=s)   =>   stat has an integer type
+          
+          If "stat" is null or has the correct integer type, we use
+          pass it to caf_sync_all directly.
+          
+          Otherwise, make a temp variable with the correct integer type,
+          pass that to caf_sync_all, and then assign the result to "stat"
+          casting it to the correct type.
+        */
+       if (stat == null_pointer_node || TREE_TYPE(stat) == integer_type_node)
+         {
+            tmp = build_call_expr_loc( input_location, gfor_fndecl_caf_sync_all,
+                                       3, stat, errmsg, errmsglen);
+            gfc_add_expr_to_block (&se.pre, tmp);
+         }
       else
-	gfc_add_expr_to_block (&se.pre, tmp);
+         {
+            tree tmp_stat = gfc_create_var(integer_type_node, "stat");
+            
+            tmp = build_call_expr_loc( input_location, gfor_fndecl_caf_sync_all,
+                                       3, tmp_stat, errmsg, errmsglen);
+            gfc_add_expr_to_block (&se.pre, tmp);
+            
+            gfc_add_modify (&se.pre, stat, fold_convert(TREE_TYPE(stat), tmp_stat));
+         }
     }
-  else
+   
+   else
     {
       tree len;
 
@@ -790,13 +814,37 @@
           len = fold_convert (integer_type_node, len);
 	}
 
-      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images, 4,
-				 fold_convert (integer_type_node, len), images,
-				 errmsg, errmsglen);
-      if (code->expr2)
-	gfc_add_modify (&se.pre, stat, fold_convert (TREE_TYPE (stat), tmp));
+
+       /*
+          SYNC IMAGES           =>   stat == null_pointer_node
+          SYNC IMAGES(stat=s)   =>   stat has an integer type
+          
+          If "stat" is null or has the correct integer type, we use
+          pass it to caf_sync_all directly.
+          
+          Otherwise, make a temp variable with the correct integer type,
+          pass that to caf_sync_all, and then assign the result to "stat"
+          casting it to the correct type.
+        */
+       if (stat == null_pointer_node || TREE_TYPE(stat) == integer_type_node)
+         {
+            tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images, 
+                                       5, stat, fold_convert (integer_type_node, len),
+                                       images, errmsg, errmsglen);
+            gfc_add_expr_to_block (&se.pre, tmp);
+         }
       else
-	gfc_add_expr_to_block (&se.pre, tmp);
+         {
+            tree tmp_stat = gfc_create_var(integer_type_node, "stat");
+            
+            tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images, 
+                                       5, tmp_stat, fold_convert (integer_type_node, len),
+                                       images, errmsg, errmsglen);
+            gfc_add_expr_to_block (&se.pre, tmp);
+            
+            gfc_add_modify (&se.pre, stat, fold_convert(TREE_TYPE(stat), tmp_stat));
+         }
+       
     }
 
   return gfc_finish_block (&se.pre);
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 174722)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -3059,12 +3059,12 @@
 	get_identifier (PREFIX("caf_end_critical")), void_type_node, 0);
 
       gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_sync_all")), ".W", integer_type_node,
-	2, build_pointer_type (pchar_type_node), integer_type_node);
+	get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node,
+	3, integer_type_node, build_pointer_type (pchar_type_node), integer_type_node);
 
       gfor_fndecl_caf_sync_images = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_sync_images")), ".RRW", integer_type_node,
-	4, integer_type_node, pint_type, build_pointer_type (pchar_type_node),
+	get_identifier (PREFIX("caf_sync_images")), ".WRRW", void_type_node,
+	5, integer_type_node, integer_type_node, pint_type, build_pointer_type (pchar_type_node),
 	integer_type_node);
 
       gfor_fndecl_caf_error_stop = gfc_build_library_function_decl (
Index: libgfortran/caf/single.c
===================================================================
--- libgfortran/caf/single.c	(revision 174722)
+++ libgfortran/caf/single.c	(working copy)
@@ -69,15 +69,17 @@
 }
 
 
-int
-_gfortran_caf_sync_all (char *errmsg __attribute__ ((unused)),
+void
+_gfortran_caf_sync_all (int *status __attribute__ ((unused)),
+            char *errmsg __attribute__ ((unused)),
 			int errmsg_len __attribute__ ((unused)))
 {
-  return 0;
+  status = 0;
 }
 
-int
-_gfortran_caf_sync_images (int count __attribute__ ((unused)),
+void
+_gfortran_caf_sync_images (int *status __attribute__ ((unused)),
+               int count __attribute__ ((unused)),
 			   int images[] __attribute__ ((unused)),
 			   char *errmsg __attribute__ ((unused)),
 			   int errmsg_len __attribute__ ((unused)))
@@ -94,7 +96,7 @@
       }
 #endif
 
-  return 0;
+  status = 0;
 }
 
 
Index: libgfortran/caf/libcaf.h
===================================================================
--- libgfortran/caf/libcaf.h	(revision 174722)
+++ libgfortran/caf/libcaf.h	(working copy)
@@ -54,8 +54,8 @@
 int _gfortran_caf_deregister (void **);
 
 
-int _gfortran_caf_sync_all (char *, int);
-int _gfortran_caf_sync_images (int, 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.  */
Index: libgfortran/caf/mpi.c
===================================================================
--- libgfortran/caf/mpi.c	(revision 174722)
+++ libgfortran/caf/mpi.c	(working copy)
@@ -94,13 +94,12 @@
 
 /* SYNC ALL - the return value matches Fortran's STAT argument.  */
 
-int
-_gfortran_caf_sync_all (char *errmsg, int errmsg_len)
+void
+_gfortran_caf_sync_all (int *status, char *errmsg, int errmsg_len)
 {
-  int ierr;
-  ierr = MPI_Barrier (MPI_COMM_WORLD);
+  status = MPI_Barrier (MPI_COMM_WORLD);
 
-  if (ierr && errmsg_len > 0)
+  if (status && errmsg_len > 0)
     {
       const char msg[] = "SYNC ALL failed";
       int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
@@ -111,7 +110,6 @@
     }
 
   /* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used?  */
-  return ierr;
 }
 
 
@@ -119,12 +117,10 @@
    SYNC IMAGES([]) has count == 0. Note further that SYNC IMAGES(*)
    is not equivalent to SYNC ALL.  The return value matches Fortran's
    STAT argument.  */
-int
-_gfortran_caf_sync_images (int count, int images[], char *errmsg,
+void
+_gfortran_caf_sync_images (int *status, int count, int images[], char *errmsg,
 			   int errmsg_len)
 {
-  int ierr;
-
   if (count == 0 || (count == 1 && images[0] == caf_this_image))
     return 0;
 
@@ -151,9 +147,9 @@
     }
 
   /* Handle SYNC IMAGES(*).  */
-  ierr = MPI_Barrier (MPI_COMM_WORLD);
+  status = MPI_Barrier (MPI_COMM_WORLD);
 
-  if (ierr && errmsg_len > 0)
+  if (status && errmsg_len > 0)
     {
       const char msg[] = "SYNC IMAGES failed";
       int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
@@ -164,7 +160,6 @@
     }
 
   /* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used?  */
-  return ierr;
 }
 
 

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]