[gfortran,patch] Improve handling of character SELECT

[gfortran,patch] Improve handling of character SELECT

[FX Coudert]

[-- Attachment #1: Type: text/plain, Size: 879 bytes --]

The patch attached is a partial rewrite of the translation of SELECT  
for character types. Currently, we generate a blocks of code for each  
case, along with a label and a list of the cases; a library function  
is called and it returns the address of the label that we will jump  
to. This use of jumps (GOTO_EXPR) is apparently hard on the middle-  
end (probably causing missed-optimizations, and at least preventing  
it to correctly understand what variables are initialized: see PR  
32035). Andrew Pinski suggested that we can use a SWITCH_EXPR instead  
(thanks Andrew for the analysis!). This is what my patch does, by  
assiging an integer value to each case, making the library function  
return an integer value and using a switch to select the appropriate  
code block to execute.

Bootstrapped and regtested on x86_64-linux, OK for mainline?


:ADDPATCH fortran:

[-- Attachment #2: select_char.ChangeLog --]
[-- Type: application/octet-stream, Size: 602 bytes --]

2007-07-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/32035
	* trans-stmt.c (gfc_trans_character_select): Replace the
	mechanism with labels by a SWITCH_EXPR.
	* trans-decl.c (gfc_build_builtin_function_decls): Change
	return type for select_string.


2007-07-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/32035
	* runtime/select.c (select_string): Adjust prototype and function
	so that the return value is an integer, not a pointer.


2007-07-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/32035
	* gfortran.dg/select_char_1.f90: New test.


[-- Attachment #3: select_char.diff --]
[-- Type: application/octet-stream, Size: 8322 bytes --]

Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(revision 126524)
+++ gcc/fortran/trans-stmt.c	(working copy)
@@ -1319,13 +1319,13 @@ gfc_trans_logical_select (gfc_code * cod
 static tree
 gfc_trans_character_select (gfc_code *code)
 {
-  tree init, node, end_label, tmp, type, *labels;
-  tree case_label;
+  tree init, node, end_label, tmp, type, case_num, label;
+  tree gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
   stmtblock_t block, body;
   gfc_case *cp, *d;
   gfc_code *c;
   gfc_se se;
-  int i, n;
+  int n;
 
   static tree select_struct;
   static tree ss_string1, ss_string1_len;
@@ -1351,7 +1351,7 @@ gfc_trans_character_select (gfc_code *co
       ADD_FIELD (string2, pchar_type_node);
       ADD_FIELD (string2_len, gfc_int4_type_node);
 
-      ADD_FIELD (target, pvoid_type_node);
+      ADD_FIELD (target, gfc_c_int_type_node);
 #undef ADD_FIELD
 
       gfc_finish_type (select_struct);
@@ -1365,20 +1365,6 @@ gfc_trans_character_select (gfc_code *co
   for (d = cp; d; d = d->right)
     d->n = n++;
 
-  if (n != 0)
-    labels = gfc_getmem (n * sizeof (tree));
-  else
-    labels = NULL;
-
-  for(i = 0; i < n; i++)
-    {
-      labels[i] = gfc_build_label_decl (NULL_TREE);
-      TREE_USED (labels[i]) = 1;
-      /* TODO: The gimplifier should do this for us, but it has
-         inadequacies when dealing with static initializers.  */
-      FORCED_LABEL (labels[i]) = 1;
-    }
-
   end_label = gfc_build_label_decl (NULL_TREE);
 
   /* Generate the body */
@@ -1389,7 +1375,10 @@ gfc_trans_character_select (gfc_code *co
     {
       for (d = c->ext.case_list; d; d = d->next)
         {
-          tmp = build1_v (LABEL_EXPR, labels[d->n]);
+	  label = gfc_build_label_decl (NULL_TREE);
+	  tmp = build3 (CASE_LABEL_EXPR, void_type_node,
+			build_int_cst (NULL_TREE, d->n),
+			build_int_cst (NULL_TREE, d->n), label);
           gfc_add_expr_to_block (&body, tmp);
         }
 
@@ -1402,9 +1391,8 @@ gfc_trans_character_select (gfc_code *co
 
   /* Generate the structure describing the branches */
   init = NULL_TREE;
-  i = 0;
 
-  for(d = cp; d; d = d->right, i++)
+  for(d = cp; d; d = d->right)
     {
       node = NULL_TREE;
 
@@ -1437,8 +1425,8 @@ gfc_trans_character_select (gfc_code *co
           node = tree_cons (ss_string2_len, se.string_length, node);
         }
 
-      tmp = gfc_build_addr_expr (pvoid_type_node, labels[i]);
-      node = tree_cons (ss_target, tmp, node);
+      node = tree_cons (ss_target, build_int_cst (gfc_c_int_type_node, d->n),
+			node);
 
       tmp = build_constructor_from_list (select_struct, nreverse (node));
       init = tree_cons (NULL_TREE, tmp, init);
@@ -1462,33 +1450,27 @@ gfc_trans_character_select (gfc_code *co
 
   /* Build the library call */
   init = gfc_build_addr_expr (pvoid_type_node, init);
-  tmp = gfc_build_addr_expr (pvoid_type_node, end_label);
 
   gfc_init_se (&se, NULL);
   gfc_conv_expr_reference (&se, code->expr);
 
   gfc_add_block_to_block (&block, &se.pre);
 
-  tmp = build_call_expr (gfor_fndecl_select_string, 5,
-			 init, build_int_cst (NULL_TREE, n),
-			 tmp, se.expr, se.string_length);
-			 
-  case_label = gfc_create_var (TREE_TYPE (tmp), "case_label");
-  gfc_add_modify_expr (&block, case_label, tmp);
+  tmp = build_call_expr (gfor_fndecl_select_string, 4, init,
+			 build_int_cst (NULL_TREE, n), se.expr,
+			 se.string_length);
+  case_num = gfc_create_var (gfc_c_int_type_node, "case_num");
+  gfc_add_modify_expr (&block, case_num, tmp);
 
   gfc_add_block_to_block (&block, &se.post);
 
-  tmp = build1 (GOTO_EXPR, void_type_node, case_label);
-  gfc_add_expr_to_block (&block, tmp);
-
   tmp = gfc_finish_block (&body);
+  tmp = build3_v (SWITCH_EXPR, case_num, tmp, NULL_TREE);
   gfc_add_expr_to_block (&block, tmp);
+
   tmp = build1_v (LABEL_EXPR, end_label);
   gfc_add_expr_to_block (&block, tmp);
 
-  if (n != 0)
-    gfc_free (labels);
-
   return gfc_finish_block (&block);
 }
 
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 126524)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -2334,7 +2334,7 @@ gfc_build_builtin_function_decls (void)
 
   gfor_fndecl_select_string =
     gfc_build_library_function_decl (get_identifier (PREFIX("select_string")),
-                                     pvoid_type_node, 0);
+                                     gfc_c_int_type_node, 0);
 
   gfor_fndecl_runtime_error =
     gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error")),
Index: libgfortran/runtime/select.c
===================================================================
--- libgfortran/runtime/select.c	(revision 126524)
+++ libgfortran/runtime/select.c	(working copy)
@@ -35,28 +35,28 @@ typedef struct
   int low_len;
   char *high;
   int high_len;
-  void *address;
+  int address;
 }
 select_struct;
 
-extern void * select_string (select_struct *table, int table_len,
-			     void *default_jump, const char *selector,
-			     int selector_len);
+extern int select_string (select_struct *table, int table_len,
+			  const char *selector, int selector_len);
 export_proto(select_string);
 
 
 /* select_string()-- Given a selector string and a table of
  * select_struct structures, return the address to jump to. */
 
-void *
-select_string (select_struct *table, int table_len, void *default_jump,
-	       const char *selector, int selector_len)
+int
+select_string (select_struct *table, int table_len, const char *selector,
+	       int selector_len)
 {
   select_struct *t;
   int i, low, high, mid;
+  int default_jump;
 
   if (table_len == 0)
-    return default_jump;
+    return -1;
 
   /* Record the default address if present */
 
Index: gcc/testsuite/gfortran.dg/select_char_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/select_char_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/select_char_1.f90	(revision 0)
@@ -0,0 +1,76 @@
+integer function char_select (s)
+  character(len=*), intent(in) :: s
+
+  select case(s)
+    case ("foo")
+      char_select = 1
+    case ("bar", "gee")
+      char_select = 2
+    case ("111", "999")
+      char_select = 3
+    case ("1024", "1900")
+      char_select = 4
+    case ("12", "17890")
+      char_select = 5
+    case default
+      char_select = -1
+  end select
+end function char_select
+
+integer function char_select2 (s)
+  character(len=*), intent(in) :: s
+
+  char_select2 = -1
+  select case(s)
+    case ("foo")
+      char_select2 = 1
+    case ("bar", "gee")
+      char_select2 = 2
+    case ("111", "999")
+      char_select2 = 3
+    case ("1024", "1900")
+      char_select2 = 4
+    case ("12", "17890")
+      char_select2 = 5
+  end select
+end function char_select2
+
+
+program test
+  interface
+    integer function char_select (s)
+      character(len=*), intent(in) :: s
+    end function char_select
+    integer function char_select2 (s)
+      character(len=*), intent(in) :: s
+    end function char_select2
+  end interface
+
+  if (char_select("foo") /= 1) call abort
+  if (char_select("foo ") /= 1) call abort
+  if (char_select("foo2 ") /= -1) call abort
+  if (char_select("bar") /= 2) call abort
+  if (char_select("gee") /= 2) call abort
+  if (char_select("000") /= -1) call abort
+  if (char_select("101") /= -1) call abort
+  if (char_select("109") /= -1) call abort
+  if (char_select("111") /= 3) call abort
+  if (char_select("254") /= -1) call abort
+  if (char_select("999") /= 3) call abort
+  if (char_select("9989") /= -1) call abort
+  if (char_select("1882") /= -1) call abort
+
+  if (char_select2("foo") /= 1) call abort
+  if (char_select2("foo ") /= 1) call abort
+  if (char_select2("foo2 ") /= -1) call abort
+  if (char_select2("bar") /= 2) call abort
+  if (char_select2("gee") /= 2) call abort
+  if (char_select2("000") /= -1) call abort
+  if (char_select2("101") /= -1) call abort
+  if (char_select2("109") /= -1) call abort
+  if (char_select2("111") /= 3) call abort
+  if (char_select2("254") /= -1) call abort
+  if (char_select2("999") /= 3) call abort
+  if (char_select2("9989") /= -1) call abort
+  if (char_select2("1882") /= -1) call abort
+end program test

Re: [gfortran,patch] Improve handling of character SELECT

[Andrew Pinski]

On 7/11/07, FX Coudert <fxcoudert@gmail.com> wrote:
> The patch attached is a partial rewrite of the translation of SELECT
> for character types. Currently, we generate a blocks of code for each
> case, along with a label and a list of the cases; a library function
> is called and it returns the address of the label that we will jump
> to. This use of jumps (GOTO_EXPR) is apparently hard on the middle-
> end (probably causing missed-optimizations, and at least preventing
> it to correctly understand what variables are initialized: see PR
> 32035). Andrew Pinski suggested that we can use a SWITCH_EXPR instead
> (thanks Andrew for the analysis!). This is what my patch does, by
> assiging an integer value to each case, making the library function
> return an integer value and using a switch to select the appropriate
> code block to execute.

This also works around the tree optimizer problem listed as PR 32720.

Thanks,
Andrew Pinski

Re: [gfortran,patch] Improve handling of character SELECT

[Janne Blomqvist]

:REVIEWMAIL:

On 7/12/07, FX Coudert <fxcoudert@gmail.com> wrote:
> The patch attached is a partial rewrite of the translation of SELECT
> for character types. Currently, we generate a blocks of code for each
> case, along with a label and a list of the cases; a library function
> is called and it returns the address of the label that we will jump
> to. This use of jumps (GOTO_EXPR) is apparently hard on the middle-
> end (probably causing missed-optimizations, and at least preventing
> it to correctly understand what variables are initialized: see PR
> 32035). Andrew Pinski suggested that we can use a SWITCH_EXPR instead
> (thanks Andrew for the analysis!). This is what my patch does, by
> assiging an integer value to each case, making the library function
> return an integer value and using a switch to select the appropriate
> code block to execute.
>
> Bootstrapped and regtested on x86_64-linux, OK for mainline?

Ok.

Please also put a note to PR 32720 that although your patch fixes the
regression, the underlying middle-end bug is still there.

-- 
Janne Blomqvist

Re: [gfortran,patch] Improve handling of character SELECT

[FX Coudert]

Committed as rev. 126978: http://gcc.gnu.org/viewcvs? 
view=rev&revision=126978

Thanks for the review,
FX