Re: [gfortran] Make all labels DECL_ARTIFICIAL

[Feng Wang <wf_cs at yahoo dot com>]

 --- Steven Bosscher <stevenb@suse.de> 的正文：
> On Tuesday 21 December 2004 00:10, Paul Brook wrote:
> > On Monday 20 December 2004 21:23, Steven Bosscher wrote:
> > > There is absolutely nothing we gain from making Fortran's numeric
> > > labels user labels (gdb can't put break points on them), and they
> > > for some reason hurt performance.  So the attached patch just all
> > > marks them as compiler-generated.  Thoughts?
> >
> > It'd be nice if we could figure out what "some reason" was,
> 
> We believed at the time that it would be useful to be able to set
> a breakpoint on __label_#####.
> 
> > and/or why gdb 
> > won't set breakpoints on these labels.
> 
> > Last time I brought this up I was 
> > told that user labels should not effect the optimizers.
> 
> You were told wrong.  At -O1 they're always preserved, which prevents
> some merging of basic blocks.  At the tree level it appears we never
> remove user labels (there's a separate patch from from Andrew Pinski
> to fix that).
When fixing PR18827, I found this was wrong. Making USER labels artificial will
make it removed incorrectly under some circumstances. i.e. if we assign a label
to a globle variable and don't use the label and variable elsewhere in the
module, the optimization will remove the label but leave the assignment. This
will cause linking error.
This is the simple test:
  integer i
  common /foo/ i
  assign 1000 to i
  1000 continue
  end
with my patch for PR18827 as attached.

Best Regards,
Feng Wang

_________________________________________________________
Do You Yahoo!?
150万曲MP3疯狂搜，带您闯入音乐殿堂
http://music.yisou.com/
美女明星应有尽有，搜遍美图、艳图和酷图
http://image.yisou.com
1G就是1000兆，雅虎电邮自助扩容！
http://cn.rd.yahoo.com/mail_cn/tag/1g/*http://cn.mail.yahoo.com/event/mail_1g/

*** io.c	2005/01/31 01:59:14	1.1
--- io.c	2005/01/31 02:07:45
*************** resolve_tag (const io_tag * tag, gfc_exp
*** 981,986 ****
--- 981,994 ----
  		     &e->where);
  	  return FAILURE;
  	}
+       /* Check assigned label.  */
+       if (e->expr_type == EXPR_VARIABLE && e->ts.type == BT_INTEGER
+ 		&& e->symtree->n.sym->attr.assign != 1)
+ 	{
+ 	  gfc_error ("Variable '%s' has not been assigned a format label at %L",
+ 			e->symtree->n.sym->name, &e->where);
+ 	  return FAILURE;
+ 	}
      }
    else
      {
*************** match_dt_format (gfc_dt * dt)
*** 1526,1534 ****
  	  gfc_free_expr (e);
  	  goto conflict;
  	}
-       if (e->ts.type == BT_INTEGER && e->rank == 0)
-         e->symtree->n.sym->attr.assign = 1;
- 
        dt->format_expr = e;
        return MATCH_YES;
      }
--- 1534,1539 ----
*** match.c	2005/01/31 01:59:14	1.1
--- match.c	2005/01/31 02:07:45
*************** gfc_match_goto (void)
*** 1525,1531 ****
  	  == FAILURE)
  	return MATCH_ERROR;
  
-       expr->symtree->n.sym->attr.assign = 1;
        new_st.op = EXEC_GOTO;
        new_st.expr = expr;
  
--- 1525,1530 ----
*** resolve.c	2005/01/31 01:59:14	1.1
--- resolve.c	2005/01/31 02:07:45
*************** resolve_code (gfc_code * code, gfc_names
*** 3648,3657 ****
  	  break;
  
  	case EXEC_GOTO:
!           if (code->expr != NULL && code->expr->ts.type != BT_INTEGER)
!             gfc_error ("ASSIGNED GOTO statement at %L requires an INTEGER "
                         "variable", &code->expr->where);
!           else
              resolve_branch (code->label, code);
  	  break;
  
--- 3648,3664 ----
  	  break;
  
  	case EXEC_GOTO:
!           if (code->expr != NULL)
! 	    {
! 	      if (code->expr->ts.type != BT_INTEGER)
! 		gfc_error ("ASSIGNED GOTO statement at %L requires an INTEGER "
                         "variable", &code->expr->where);
! 	      else if (code->expr->symtree->n.sym->attr.assign != 1)
! 		gfc_error ("Variable '%s' has not been assigned a target label "
! 			"at %L", code->expr->symtree->n.sym->name,
! 			&code->expr->where);
! 	    }
! 	  else
              resolve_branch (code->label, code);
  	  break;
  
*** trans-common.c	2005/01/31 01:59:14	1.1
--- trans-common.c	2005/02/02 03:13:26
*************** build_field (segment_info *h, tree union
*** 242,247 ****
--- 242,268 ----
                              size_binop (PLUS_EXPR,
                                          DECL_FIELD_OFFSET (field),
                                          DECL_SIZE_UNIT (field)));
+   /* If this field is assigned to a label, we create another two variables.
+      One will hold the address of taget label or format label. The other will
+      hold the length of format label string.  */
+   if (h->sym->attr.assign)
+     {
+       tree len;
+       tree addr;
+ 
+       gfc_allocate_lang_decl (field);
+       GFC_DECL_ASSIGN (field) = 1;
+       len = gfc_create_var_np (gfc_charlen_type_node,h->sym->name);
+       addr = gfc_create_var_np (pvoid_type_node, h->sym->name);
+       TREE_STATIC (len) = 1;
+       TREE_STATIC (addr) = 1;
+       DECL_INITIAL (len) = build_int_cst (NULL_TREE, -2);
+       gfc_set_decl_location (len, &h->sym->declared_at);
+       gfc_set_decl_location (addr, &h->sym->declared_at);
+       GFC_DECL_STRING_LEN (field) = pushdecl_top_level (len);
+       GFC_DECL_ASSIGN_ADDR (field) = pushdecl_top_level (addr);
+     }
+ 
    h->field = field;
  }
  
*************** create_common (gfc_common_head *com, seg
*** 429,435 ****
    for (s = head; s; s = next_s)
      {
        s->sym->backend_decl = build3 (COMPONENT_REF, TREE_TYPE (s->field),
! 				     decl, s->field, NULL_TREE);
  
        next_s = s->next;
        gfc_free (s);
--- 450,456 ----
    for (s = head; s; s = next_s)
      {
        s->sym->backend_decl = build3 (COMPONENT_REF, TREE_TYPE (s->field),
! 				decl, s->field, NULL_TREE);
  
        next_s = s->next;
        gfc_free (s);
*** trans.h	2005/01/31 01:59:14	1.1
--- trans.h	2005/01/31 02:07:45
*************** void gfc_conv_expr_lhs (gfc_se * se, gfc
*** 289,294 ****
--- 289,296 ----
  void gfc_conv_expr_reference (gfc_se * se, gfc_expr *);
  /* Equivalent to convert(type, gfc_conv_expr_val(se, expr)).  */
  void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree);
+ /* Converts a variable assigned a label.  */
+ void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr);
  /* If the value is not constant, Create a temporary and copy the value.  */
  tree gfc_evaluate_now (tree, stmtblock_t *);
  
*** trans-io.c	2005/01/31 01:59:14	1.1
--- trans-io.c	2005/01/31 02:07:45
*************** set_string (stmtblock_t * block, stmtblo
*** 397,403 ****
    tree len;
  
    gfc_init_se (&se, NULL);
-   gfc_conv_expr (&se, e);
  
    io = build3 (COMPONENT_REF, TREE_TYPE (var), ioparm_var, var, NULL_TREE);
    len = build3 (COMPONENT_REF, TREE_TYPE (var_len), ioparm_var, var_len,
--- 397,402 ----
*************** set_string (stmtblock_t * block, stmtblo
*** 406,411 ****
--- 405,411 ----
    /* Integer variable assigned a format label.  */
    if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1)
      {
+       gfc_conv_label_variable (&se, e);
        msg =
          gfc_build_cstring_const ("Assigned label is not a format label");
        tmp = GFC_DECL_STRING_LEN (se.expr);
*************** set_string (stmtblock_t * block, stmtblo
*** 417,422 ****
--- 417,423 ----
      }
    else
      {
+       gfc_conv_expr (&se, e);
        gfc_conv_string_parameter (&se);
        gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), se.expr));
        gfc_add_modify_expr (&se.pre, len, se.string_length);
*** trans-stmt.c	2005/01/31 01:59:14	1.1
--- trans-stmt.c	2005/02/02 03:14:52
*************** gfc_trans_label_here (gfc_code * code)
*** 80,85 ****
--- 80,99 ----
    return build1_v (LABEL_EXPR, gfc_get_label_decl (code->here));
  }
  
+ 
+ /* Given a variable expression which has been ASSIGNed to, find the decl
+    containing the auxiliary variables.  For variables in common blocks this
+    is a field_decl.  */
+ void
+ gfc_conv_label_variable (gfc_se * se, gfc_expr * expr)
+ {
+   gcc_assert (expr->symtree->n.sym->attr.assign == 1);
+   gfc_conv_expr (se, expr);
+   /* Deals with variable in common block. Get the field declaration.  */
+   if (TREE_CODE (se->expr) == COMPONENT_REF)
+     se->expr = TREE_OPERAND (se->expr, 1);
+ }
+ 
  /* Translate a label assignment statement.  */
  tree
  gfc_trans_label_assign (gfc_code * code)
*************** gfc_trans_label_assign (gfc_code * code)
*** 95,101 ****
    /* Start a new block.  */
    gfc_init_se (&se, NULL);
    gfc_start_block (&se.pre);
!   gfc_conv_expr (&se, code->expr);
    len = GFC_DECL_STRING_LEN (se.expr);
    addr = GFC_DECL_ASSIGN_ADDR (se.expr);
  
--- 109,116 ----
    /* Start a new block.  */
    gfc_init_se (&se, NULL);
    gfc_start_block (&se.pre);
!   gfc_conv_label_variable (&se, code->expr);
! 
    len = GFC_DECL_STRING_LEN (se.expr);
    addr = GFC_DECL_ASSIGN_ADDR (se.expr);
  
*************** gfc_trans_goto (gfc_code * code)
*** 140,146 ****
    /* ASSIGNED GOTO.  */
    gfc_init_se (&se, NULL);
    gfc_start_block (&se.pre);
!   gfc_conv_expr (&se, code->expr);
    assign_error =
      gfc_build_cstring_const ("Assigned label is not a target label");
    tmp = GFC_DECL_STRING_LEN (se.expr);
--- 155,161 ----
    /* ASSIGNED GOTO.  */
    gfc_init_se (&se, NULL);
    gfc_start_block (&se.pre);
!   gfc_conv_label_variable (&se, code->expr);
    assign_error =
      gfc_build_cstring_const ("Assigned label is not a target label");
    tmp = GFC_DECL_STRING_LEN (se.expr);