[gfortran] Optimization of assigned goto with label list.

[Feng Wang <wf_cs at yahoo dot com>]

Hi, all
  This patch optimized the assigned goto statement. Use switch construct to
check if the taget label is in the label list. Add another showdow variable to
hold the value of the label when it is assigned to an integer variable. Pass
the test on ia64-linux.
  Could anyone help me check and apply it if it is ok? Thanks.

  Feng Wang

testsuite/ChangeLog.tree-ssa
2004-02-04  Feng Wang  <fengwang@nudt.edu.cn>

	* gfortran.fortran-torture/execute/assign.f90: Test assign statement.

fortran/ChangeLog:
2004-02-04  Feng Wang  <fengwang@nudt.edu.cn>

	* trans.h (lang_decl): Add shadow variable value for assign statement.
	(GFC_DECL_ASSIGN_VALUE): New macro to access it.
	* trans-decl.c (gfc_get_symbol_decl): Build declaration for it.
	* trans-stmt.c (gfc_trans_label_assign): Use it to hold the target
	label's value.
	(gfc_trans_goto): Use it as switch expr. Change multi-if statements to
	switch construct.



_________________________________________________________
Do You Yahoo!? 
完全免费的雅虎电邮，马上注册获赠额外60兆网络存储空间
http://cn.rd.yahoo.com/mail_cn/tag/?http://cn.mail.yahoo.com

      ! Program to test ASSIGN statement
      Program assign_test
      implicit none
      integer r,ass
      r = 1
      if (r .ne. ass (r)) call abort
      r = 2 
      if (r .ne. ass (r)) call abort
      r = 3
      if (r .ne. ass (r)) call abort
      end

      integer function ass (i)
      implicit none
      integer i, label
      if (i .eq. 1) assign 1 to label
      if (i .eq. 2) assign 2 to label
      if (i .eq. 3) assign 3 to label
      go to label, (1, 2, 3)
   1  ass = 1
      go to 4
   2  ass = 2
      go to 4
   3  ass = 3
   4  continue
      end

diff -c3p fortran-backup/trans-decl.c gcc/gcc/fortran/trans-decl.c
*** fortran-backup/trans-decl.c	Wed Feb  4 11:04:37 2004
--- gcc/gcc/fortran/trans-decl.c	Wed Feb  4 11:33:43 2004
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 716,721 ****
--- 716,723 ----
      {
        gfc_allocate_lang_decl (decl);
        GFC_DECL_ASSIGN (decl) = 1;
+       GFC_DECL_ASSIGN_VALUE (decl) =
+ 	gfc_create_var (integer_type_node, sym->name);
        GFC_DECL_STRING_LENGTH (decl) =
          gfc_create_var (gfc_strlen_type_node, sym->name);
        GFC_DECL_ASSIGN_ADDR (decl) = gfc_create_var (pvoid_type_node, sym->name);
diff -c3p fortran-backup/trans-stmt.c gcc/gcc/fortran/trans-stmt.c
*** fortran-backup/trans-stmt.c	Wed Feb  4 11:04:37 2004
--- gcc/gcc/fortran/trans-stmt.c	Wed Feb  4 11:30:37 2004
*************** gfc_trans_label_here (gfc_code * code)
*** 87,97 ****
  tree
  gfc_trans_label_assign (gfc_code * code)
  {
-   tree label_tree;
    gfc_se se;
!   tree len;
    tree addr;
    tree len_tree;
    char *label_str;
    int label_len;
  
--- 87,99 ----
  tree
  gfc_trans_label_assign (gfc_code * code)
  {
    gfc_se se;
!   tree label_tree;
    tree addr;
    tree len_tree;
+   tree len;
+   tree value_tree;
+   tree value;
    char *label_str;
    int label_len;
  
*************** gfc_trans_label_assign (gfc_code * code)
*** 101,106 ****
--- 103,109 ----
    gfc_conv_expr (&se, code->expr);
    len = GFC_DECL_STRING_LENGTH (se.expr);
    addr = GFC_DECL_ASSIGN_ADDR (se.expr);
+   value = GFC_DECL_ASSIGN_VALUE (se.expr);
  
    label_tree = gfc_get_label_decl (code->label);
  
*************** gfc_trans_label_assign (gfc_code * code)
*** 108,113 ****
--- 111,118 ----
      {
        label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree);
        len_tree = integer_minus_one_node;
+       value_tree = build_int_2 (code->label->value, 0);
+       gfc_add_modify_expr (&se.pre, value, value_tree);
      }
    else
      {
*************** gfc_trans_label_assign (gfc_code * code)
*** 129,141 ****
  tree
  gfc_trans_goto (gfc_code * code)
  {
-   tree assigned_goto;
-   tree target;
    tree tmp;
!   tree assign_error;
!   tree range_error;
    gfc_se se;
! 
  
    if (code->label != NULL)
      return build1_v (GOTO_EXPR, gfc_get_label_decl (code->label));
--- 134,143 ----
  tree
  gfc_trans_goto (gfc_code * code)
  {
    tree tmp;
!   tree msg;
    gfc_se se;
!   stmtblock_t body;
  
    if (code->label != NULL)
      return build1_v (GOTO_EXPR, gfc_get_label_decl (code->label));
*************** gfc_trans_goto (gfc_code * code)
*** 144,180 ****
    gfc_init_se (&se, NULL);
    gfc_start_block (&se.pre);
    gfc_conv_expr (&se, code->expr);
!   assign_error =
!     gfc_build_string_const (37, "Assigned label is not a target label");
    tmp = GFC_DECL_STRING_LENGTH (se.expr);
    tmp = build (NE_EXPR, boolean_type_node, tmp, integer_minus_one_node);
!   gfc_trans_runtime_check (tmp, assign_error, &se.pre);
  
!   assigned_goto = GFC_DECL_ASSIGN_ADDR (se.expr);
!   target = build1 (GOTO_EXPR, void_type_node, assigned_goto);
! 
!   code = code->block;
!   if (code == NULL)
      {
!       gfc_add_expr_to_block (&se.pre, target);
        return gfc_finish_block (&se.pre);
      }
  
!   /* Check the label list.  */
!   range_error =
!     gfc_build_string_const (34, "Assigned label is not in the list");
! 
    do
      {
!       tmp = gfc_get_label_decl (code->label);
!       tmp = gfc_build_addr_expr (pvoid_type_node, tmp);
!       tmp = build (EQ_EXPR, boolean_type_node, tmp, assigned_goto);
!       tmp = build_v (COND_EXPR, tmp, target, build_empty_stmt ());
!       gfc_add_expr_to_block (&se.pre, tmp);
        code = code->block;
      }
    while (code != NULL);
!   gfc_trans_runtime_check (boolean_true_node, range_error, &se.pre);
    return gfc_finish_block (&se.pre); 
  }
  
--- 146,203 ----
    gfc_init_se (&se, NULL);
    gfc_start_block (&se.pre);
    gfc_conv_expr (&se, code->expr);
! 
!   /* Check if the assigned label is a target label.  */
!   msg = gfc_build_string_const (37, "Assigned label is not a target label");
    tmp = GFC_DECL_STRING_LENGTH (se.expr);
    tmp = build (NE_EXPR, boolean_type_node, tmp, integer_minus_one_node);
!   gfc_trans_runtime_check (tmp, msg, &se.pre);
  
!   /* If no label list exists, go to the target directly.  */
!   if (code->block == NULL)
      {
!       tmp = GFC_DECL_ASSIGN_ADDR (se.expr);
!       tmp = build1 (GOTO_EXPR, void_type_node, tmp);
!       gfc_add_expr_to_block (&se.pre, tmp);
        return gfc_finish_block (&se.pre);
      }
  
!   /* Check if the target label is in the label list. Use switch expr.  */
!   gfc_init_block (&body);
    do
      {
!       if (code->block != NULL)
! 	{
! 	  /* Add case label.  */
! 	  tmp = build_int_2 (code->block->label->value, 0);
! 	  tmp = build (CASE_LABEL_EXPR, void_type_node, tmp, NULL_TREE,
! 		create_artificial_label ());
! 	  gfc_add_expr_to_block (&body, tmp);
! 
! 	  /* Add the statements for this case.  */
! 	  tmp = build1_v (GOTO_EXPR, gfc_get_label_decl (code->block->label));
! 	  gfc_add_expr_to_block (&body, tmp);
! 	}
!       else
! 	/* Add the default label and statement.  */
! 	{
! 	  tmp = build (CASE_LABEL_EXPR, void_type_node, NULL_TREE, NULL_TREE,
! 		create_artificial_label ());
! 	  gfc_add_expr_to_block (&body, tmp);
! 
! 	  msg = gfc_build_string_const (34,
! 		"Assigned label is not in the list");
! 	  gfc_trans_runtime_check (boolean_true_node, msg, &body);
! 	}  
! 
        code = code->block;
      }
    while (code != NULL);
!   /* Add the switch expr.  */
!   tmp = gfc_finish_block (&body);
!   tmp = build_v (SWITCH_EXPR, GFC_DECL_ASSIGN_VALUE (se.expr), tmp, NULL_TREE);
!   gfc_add_expr_to_block (&se.pre, tmp);
! 
    return gfc_finish_block (&se.pre); 
  }
  
diff -c3p fortran-backup/trans.h gcc/gcc/fortran/trans.h
*** fortran-backup/trans.h	Wed Feb  4 11:04:37 2004
--- gcc/gcc/fortran/trans.h	Wed Feb  4 11:30:37 2004
*************** struct lang_decl		GTY(())
*** 492,504 ****
    /* Assigned integer nodes.  Stringlength is the IO format string's length.
       Addr is the address of the string or the target label. Stringlength is
       initialized to -2 and assiged to -1 when addr is assigned to the
!      address of target label.  */
    tree addr;
  };
  
  
  #define GFC_DECL_ASSIGN_ADDR(node) DECL_LANG_SPECIFIC(node)->addr
  #define GFC_DECL_STRING_LENGTH(node) (DECL_LANG_SPECIFIC(node)->stringlength)
  #define GFC_DECL_SAVED_DESCRIPTOR(node) \
    (DECL_LANG_SPECIFIC(node)->saved_descriptor)
  #define GFC_DECL_STRING(node) DECL_LANG_FLAG_0(node)
--- 492,506 ----
    /* Assigned integer nodes.  Stringlength is the IO format string's length.
       Addr is the address of the string or the target label. Stringlength is
       initialized to -2 and assiged to -1 when addr is assigned to the
!      address of target label. Value is the label's value.  */
    tree addr;
+   tree value;
  };
  
  
  #define GFC_DECL_ASSIGN_ADDR(node) DECL_LANG_SPECIFIC(node)->addr
  #define GFC_DECL_STRING_LENGTH(node) (DECL_LANG_SPECIFIC(node)->stringlength)
+ #define GFC_DECL_ASSIGN_VALUE(node) DECL_LANG_SPECIFIC(node)->value
  #define GFC_DECL_SAVED_DESCRIPTOR(node) \
    (DECL_LANG_SPECIFIC(node)->saved_descriptor)
  #define GFC_DECL_STRING(node) DECL_LANG_FLAG_0(node)