[gfortran] PR 15327: Fix merge intrinsic for strings

[Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>]

MERGE didn't work for strings because we neither dealt with the string length
arguments in the argument list correctly, nor did we create copies of the
strings. I fixed this by modifying gfc_conv_intrinsic_merge such that it now
calls a new library function, gfc_conv_intrinsic_merge, in the case of string
valued arguments.

I chose to pass the result string as an argument to string_merge, but still
have the function return it. If you prefer another convention, which might
make the tree dumps more readable, please tell me.

Another issue, which I suspect is in the scalarizer is that we get code like
{
   string str;

   gfc_copy_str (target, string_merge(str, args));
}
instead of the more favorable
   string_merge (target, args);
for a simple assignment
   target = merge(args)
I assumed that this is an issue in the scalarizer, but if there's a way of
getting the more efficient code, please tell me.

Another option would be to generate the function's code inline in
gfc_conv_intrinsic_merge, it is simple enough. But I assumes that the biggest
performance penalty comes from the superfluous copy, so I didn't implement
this variant.

Built and tested, I have a few simple testcases, from which I will distill a
testcase.

- Tobi

gcc/fortran:
	* trans-decl.c (gfor_fndecl_string_merge): New variable.
	(gfc_build_intrinsic_function_decls): Setup values for new variable.
	* trans-intrinsic.c (gfc_conv_intrinsic_merge): Use library function
	in case of CHARACTER argument.
	* trans.h (gfor_fndecl_string_merge): Add prototype.
libgfortran:
	* intrinsics/string_intrinsics.c (string_merge): New function.

Index: gcc/fortran/trans-decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-decl.c,v
retrieving revision 1.37
diff -u -p -r1.37 trans-decl.c
--- gcc/fortran/trans-decl.c    25 Aug 2004 15:50:35 -0000      1.37
+++ gcc/fortran/trans-decl.c    29 Aug 2004 21:03:04 -0000
@@ -109,6 +109,7 @@ tree gfor_fndecl_compare_string;
 tree gfor_fndecl_concat_string;
 tree gfor_fndecl_string_len_trim;
 tree gfor_fndecl_string_index;
+tree gfor_fndecl_string_merge;
 tree gfor_fndecl_string_scan;
 tree gfor_fndecl_string_verify;
 tree gfor_fndecl_string_trim;
@@ -1595,6 +1596,14 @@ gfc_build_intrinsic_function_decls (void
                                     gfc_strlen_type_node, pchar_type_node,
                                      gfc_logical4_type_node);

+  gfor_fndecl_string_merge =
+    gfc_build_library_function_decl (get_identifier (PREFIX("string_merge")),
+                                    pchar_type_node,
+                                    5, pchar_type_node,
+                                    gfc_strlen_type_node, pchar_type_node,
+                                    gfc_strlen_type_node,
+                                    gfc_logical4_type_node);
+
   gfor_fndecl_string_scan =
     gfc_build_library_function_decl (get_identifier (PREFIX("string_scan")),
                                      gfc_int4_type_node,
Index: gcc/fortran/trans-intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-intrinsic.c,v
retrieving revision 1.19
diff -u -p -r1.19 trans-intrinsic.c
--- gcc/fortran/trans-intrinsic.c       29 Aug 2004 15:58:13 -0000      1.19
+++ gcc/fortran/trans-intrinsic.c       29 Aug 2004 21:03:05 -0000
@@ -1974,39 +1974,60 @@ static void

... stripped ICHAR changes ...

-/* MERGE (tsource, fsource, mask) = mask ? tsource : fsource.  */
+/* MERGE (tsource, fsource, mask) = mask ? tsource : fsource. For
+   string arguments we build a function call.  */

 static void
 gfc_conv_intrinsic_merge (gfc_se * se, gfc_expr * expr)
 {
-  tree arg;
+  tree arg, args;
   tree tsource;
   tree fsource;
   tree mask;
   tree type;
+  tree tmp, len;

-  arg = gfc_conv_intrinsic_function_args (se, expr);
-  tsource = TREE_VALUE (arg);
-  arg = TREE_CHAIN (arg);
-  fsource = TREE_VALUE (arg);
-  arg = TREE_CHAIN (arg);
-  mask = TREE_VALUE (arg);
+  args = gfc_conv_intrinsic_function_args (se, expr);
+
+  if (expr->ts.type != BT_CHARACTER)
+    {
+      arg = args;
+      tsource = TREE_VALUE (arg);
+      arg = TREE_CHAIN (arg);
+      fsource = TREE_VALUE (arg);
+      arg = TREE_CHAIN (arg);
+      mask = TREE_VALUE (arg);

-  type = TREE_TYPE (tsource);
-  se->expr = fold (build3 (COND_EXPR, type, mask, tsource, fsource));
+      type = TREE_TYPE (tsource);
+      se->expr = fold (build3 (COND_EXPR, type, mask, tsource, fsource));
+    }
+  else
+    {
+      len = TREE_VALUE (args);
+
+      type = TREE_TYPE (TREE_VALUE (TREE_CHAIN (args)));
+      tmp = gfc_conv_string_tmp (se, type, len);
+      gfc_add_expr_to_block (&se->pre, tmp);
+      args = tree_cons (NULL_TREE, tmp, args);
+
+      se->expr = gfc_build_function_call (gfor_fndecl_string_merge, args);
+      se->string_length = len;
+    }
+
 }


Index: gcc/fortran/trans.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans.h,v
retrieving revision 1.14
diff -u -p -r1.14 trans.h
--- gcc/fortran/trans.h 25 Aug 2004 16:50:07 -0000      1.14
+++ gcc/fortran/trans.h 29 Aug 2004 21:03:07 -0000
@@ -475,6 +475,7 @@ extern GTY(()) tree gfor_fndecl_compare_
 extern GTY(()) tree gfor_fndecl_concat_string;
 extern GTY(()) tree gfor_fndecl_string_len_trim;
 extern GTY(()) tree gfor_fndecl_string_index;
+extern GTY(()) tree gfor_fndecl_string_merge;
 extern GTY(()) tree gfor_fndecl_string_scan;
 extern GTY(()) tree gfor_fndecl_string_verify;
 extern GTY(()) tree gfor_fndecl_string_trim;
Index: libgfortran/intrinsics/string_intrinsics.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/intrinsics/string_intrinsics.c,v
retrieving revision 1.4
diff -u -p -r1.4 string_intrinsics.c
--- libgfortran/intrinsics/string_intrinsics.c  25 Aug 2004 00:14:07 -0000     1.4
+++ libgfortran/intrinsics/string_intrinsics.c  29 Aug 2004 21:03:16 -0000
@@ -56,6 +56,10 @@ void adjustr (char *, GFC_INTEGER_4, con
 GFC_INTEGER_4 string_index (GFC_INTEGER_4, const char *, GFC_INTEGER_4,
                            const char *, GFC_LOGICAL_4);

+#define string_merge prefix(string_merge)
+char *string_merge (char *, GFC_INTEGER_4, const char *, GFC_INTEGER_4,
+                   const char *, GFC_LOGICAL_4);
+
 #define string_scan prefix(string_scan)
 GFC_INTEGER_4 string_scan (GFC_INTEGER_4, const char *, GFC_INTEGER_4,
                            const char *, GFC_LOGICAL_4);
@@ -250,6 +254,24 @@ string_index (GFC_INTEGER_4 slen, const
   return 0;
 }

+/* Returns copy of tsource (fsource) in result if mask is true (false).  */
+
+char *
+string_merge (char *result,
+             GFC_INTEGER_4 tlen, const char *tsource,
+             GFC_INTEGER_4 flen, const char *fsource,
+             GFC_LOGICAL_4 mask)
+{
+  /* result has already been allocated in the caller, its length
+     should equal tlen == flen.  */
+  if (mask)
+    memcpy (result, tsource, tlen);
+  else
+    memcpy (result, fsource, flen);
+
+  return result;
+}
+

 /* Remove leading blanks from a string, padding at end.  The src and dest
    should not overlap.  */