Patchwork remove build_call_list from Fortran FE

login
register
mail settings
Submitter Nathan Froyd
Date July 1, 2010, 2:50 p.m.
Message ID <20100701145033.GA17877@codesourcery.com>
Download mbox | patch
Permalink /patch/57555/
State New
Headers show

Comments

Nathan Froyd - July 1, 2010, 2:50 p.m.
The patch below removes build_call_list from the Fortran FE by making
gfc_conv_procedure_call use build_call_vec.  It's not quite as clean as
one might like, mostly because appending vectors is not nearly so nice
as appending lists.  The patch does have the nice benefit of removing
quadratic behavior from gfc_conv_procedure_call, so gfortran should get
slightly faster.

This patch removes the last use of build_call_list in GCC.  If approved,
I will commit the build_call_list removal followup patch as obvious.

Tested on x86_64-unknown-linux-gnu.  OK to commit?

-Nathan

	* trans.h (gfc_conv_procedure_call): Take a VEC instead of a tree.
	* trans-intrinsic.c (gfc_conv_intrinsic_funcall): Adjust for new
	type of gfc_conv_procedure_call.
	(conv_generic_with_optional_char_arg): Likewise.
	* trans-stmt.c (gfc_trans_call): Likewise.
	* trans-expr.c (gfc_conv_function_expr): Likewise.
	(append_vec): New function.
	(gfc_conv_procedure_call): Use build_call_vec instead of
	build_call_list.
Richard Guenther - July 1, 2010, 3:04 p.m.
On Thu, Jul 1, 2010 at 4:50 PM, Nathan Froyd <froydnj@codesourcery.com> wrote:
> The patch below removes build_call_list from the Fortran FE by making
> gfc_conv_procedure_call use build_call_vec.  It's not quite as clean as
> one might like, mostly because appending vectors is not nearly so nice
> as appending lists.  The patch does have the nice benefit of removing
> quadratic behavior from gfc_conv_procedure_call, so gfortran should get
> slightly faster.
>
> This patch removes the last use of build_call_list in GCC.  If approved,
> I will commit the build_call_list removal followup patch as obvious.
>
> Tested on x86_64-unknown-linux-gnu.  OK to commit?

...
>
> +/* Copy the elements in SRC to DST, starting at INDEX in DST.  Return
> +   the next spot at which elements are to be added.  DST is assumed to
> +   have sufficient space available to hold SRC's elements.  */
> +
> +static int
> +append_vec (VEC(tree,gc) *dst, VEC(tree,gc) *src, int index)
> +{
> +  int len = VEC_length (tree, src);
> +  memcpy (VEC_address (tree, dst) + index, VEC_address (tree, src),
> +         len * sizeof (tree));
> +
> +  return index + len;
> +}

Finally a reason to add VEC_splice?

Richard.
Tobias Burnus - July 1, 2010, 4:03 p.m.
On 07/01/2010 04:50 PM, Nathan Froyd wrote:
> The patch below removes build_call_list from the Fortran FE by making
> gfc_conv_procedure_call use build_call_vec.
> Tested on x86_64-unknown-linux-gnu.  OK to commit?
>   

OK. Thanks for the patch.

(By the way, I like Richard's idea of adding VEC_splice to vec.{c,h},
replacing append_vec.)

Tobias
Nathan Froyd - July 2, 2010, 2:42 p.m.
On Thu, Jul 01, 2010 at 05:04:50PM +0200, Richard Guenther wrote:
> On Thu, Jul 1, 2010 at 4:50 PM, Nathan Froyd <froydnj@codesourcery.com> wrote:
> > +/* Copy the elements in SRC to DST, starting at INDEX in DST.  Return
> > +   the next spot at which elements are to be added.  DST is assumed to
> > +   have sufficient space available to hold SRC's elements.  */
> > +
> > +static int
> > +append_vec (VEC(tree,gc) *dst, VEC(tree,gc) *src, int index)
> > +{
> > +  int len = VEC_length (tree, src);
> > +  memcpy (VEC_address (tree, dst) + index, VEC_address (tree, src),
> > +         len * sizeof (tree));
> > +
> > +  return index + len;
> > +}
> 
> Finally a reason to add VEC_splice?

Yeah, probably.  I'll fix that and resubmit the patch for middle-endish
review.

-Nathan

Patch

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 692b3e2..f78c1fa 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2653,6 +2653,19 @@  conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
   return 0;
 }
 
+/* Copy the elements in SRC to DST, starting at INDEX in DST.  Return
+   the next spot at which elements are to be added.  DST is assumed to
+   have sufficient space available to hold SRC's elements.  */
+
+static int
+append_vec (VEC(tree,gc) *dst, VEC(tree,gc) *src, int index)
+{
+  int len = VEC_length (tree, src);
+  memcpy (VEC_address (tree, dst) + index, VEC_address (tree, src),
+	  len * sizeof (tree));
+
+  return index + len;
+}
 
 /* Generate code for a procedure call.  Note can return se->post != NULL.
    If se->direct_byref is set then se->expr contains the return parameter.
@@ -2662,11 +2675,11 @@  conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
 int
 gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			 gfc_actual_arglist * arg, gfc_expr * expr,
-			 tree append_args)
+			 VEC(tree,gc) *append_args)
 {
   gfc_interface_mapping mapping;
-  tree arglist;
-  tree retargs;
+  VEC(tree,gc) *arglist;
+  VEC(tree,gc) *retargs;
   tree tmp;
   tree fntype;
   gfc_se parmse;
@@ -2677,7 +2690,7 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
   tree type;
   tree var;
   tree len;
-  tree stringargs;
+  VEC(tree,gc) *stringargs;
   tree result = NULL;
   gfc_formal_arglist *formal;
   int has_alternate_specifier = 0;
@@ -2690,10 +2703,12 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
   stmtblock_t post;
   enum {MISSING = 0, ELEMENTAL, SCALAR, SCALAR_POINTER, ARRAY};
   gfc_component *comp = NULL;
+  int copy_index;
+  int arglen;
 
-  arglist = NULL_TREE;
-  retargs = NULL_TREE;
-  stringargs = NULL_TREE;
+  arglist = NULL;
+  retargs = NULL;
+  stringargs = NULL;
   var = NULL_TREE;
   len = NULL_TREE;
   gfc_clear_ts (&ts);
@@ -3136,9 +3151,9 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       /* Character strings are passed as two parameters, a length and a
          pointer - except for Bind(c) which only passes the pointer.  */
       if (parmse.string_length != NULL_TREE && !sym->attr.is_bind_c)
-        stringargs = gfc_chainon_list (stringargs, parmse.string_length);
+	VEC_safe_push (tree, gc, stringargs, parmse.string_length);
 
-      arglist = gfc_chainon_list (arglist, parmse.expr);
+      VEC_safe_push (tree, gc, arglist, parmse.expr);
     }
   gfc_finish_interface_mapping (&mapping, &se->pre, &se->post);
 
@@ -3160,7 +3175,7 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	     For dummies, we have to look through the formal argument list for
 	     this function and use the character length found there.*/
 	  if (!sym->attr.dummy)
-	    cl.backend_decl = TREE_VALUE (stringargs);
+	    cl.backend_decl = VEC_index (tree, stringargs, 0);
 	  else
 	    {
 	      formal = sym->ns->proc_name->formal;
@@ -3213,7 +3228,7 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
 	  result = build_fold_indirect_ref_loc (input_location,
 						se->expr);
-	  retargs = gfc_chainon_list (retargs, se->expr);
+	  VEC_safe_push (tree, gc, retargs, se->expr);
 	}
       else if (comp && comp->attr.dimension)
 	{
@@ -3237,7 +3252,7 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  /* Pass the temporary as the first argument.  */
 	  result = info->descriptor;
 	  tmp = gfc_build_addr_expr (NULL_TREE, result);
-	  retargs = gfc_chainon_list (retargs, tmp);
+	  VEC_safe_push (tree, gc, retargs, tmp);
 	}
       else if (!comp && sym->result->attr.dimension)
 	{
@@ -3261,7 +3276,7 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  /* Pass the temporary as the first argument.  */
 	  result = info->descriptor;
 	  tmp = gfc_build_addr_expr (NULL_TREE, result);
-	  retargs = gfc_chainon_list (retargs, tmp);
+	  VEC_safe_push (tree, gc, retargs, tmp);
 	}
       else if (ts.type == BT_CHARACTER)
 	{
@@ -3288,7 +3303,7 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  else
 	    var = gfc_conv_string_tmp (se, type, len);
 
-	  retargs = gfc_chainon_list (retargs, var);
+	  VEC_safe_push (tree, gc, retargs, var);
 	}
       else
 	{
@@ -3296,25 +3311,35 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
 	  type = gfc_get_complex_type (ts.kind);
 	  var = gfc_build_addr_expr (NULL_TREE, gfc_create_var (type, "cmplx"));
-	  retargs = gfc_chainon_list (retargs, var);
+	  VEC_safe_push (tree, gc, retargs, var);
 	}
 
       /* Add the string length to the argument list.  */
       if (ts.type == BT_CHARACTER)
-	retargs = gfc_chainon_list (retargs, len);
+	VEC_safe_push (tree, gc, retargs, len);
     }
   gfc_free_interface_mapping (&mapping);
 
+  /* We need to glom RETARGS + ARGLIST + STRINGARGS + APPEND_ARGS.  */
+  copy_index = VEC_length (tree, retargs);
+  arglen = (VEC_length (tree, retargs) + VEC_length (tree, arglist)
+	    + VEC_length (tree, stringargs) + VEC_length (tree, append_args));
+  if (retargs == NULL)
+    retargs = VEC_alloc (tree, gc, arglen);
+  if (arglen != 0)
+    VEC_safe_grow (tree, gc, retargs, arglen);
+
   /* Add the return arguments.  */
-  arglist = chainon (retargs, arglist);
+  copy_index = append_vec (retargs, arglist, copy_index);
 
   /* Add the hidden string length parameters to the arguments.  */
-  arglist = chainon (arglist, stringargs);
+  copy_index = append_vec (retargs, stringargs, copy_index);
 
   /* We may want to append extra arguments here.  This is used e.g. for
      calls to libgfortran_matmul_??, which need extra information.  */
-  if (append_args != NULL_TREE)
-    arglist = chainon (arglist, append_args);
+  if (!VEC_empty (tree, append_args))
+    copy_index = append_vec (retargs, append_args, copy_index);
+  arglist = retargs;
 
   /* Generate the actual call.  */
   conv_function_val (se, sym, expr);
@@ -3338,7 +3363,7 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
     }
 
   fntype = TREE_TYPE (TREE_TYPE (se->expr));
-  se->expr = build_call_list (TREE_TYPE (fntype), se->expr, arglist);
+  se->expr = build_call_vec (TREE_TYPE (fntype), se->expr, arglist);
 
   /* If we have a pointer function, but we don't want a pointer, e.g.
      something like
@@ -3786,8 +3811,7 @@  gfc_conv_function_expr (gfc_se * se, gfc_expr * expr)
   if (!sym)
     sym = expr->symtree->n.sym;
 
-  gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr,
-			  NULL_TREE);
+  gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr, NULL);
 }
 
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 06fd538..7f583da 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1570,7 +1570,7 @@  static void
 gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
 {
   gfc_symbol *sym;
-  tree append_args;
+  VEC(tree,gc) *append_args;
 
   gcc_assert (!se->ss || se->ss->expr == expr);
 
@@ -1583,7 +1583,7 @@  gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
 
   /* Calls to libgfortran_matmul need to be appended special arguments,
      to be able to call the BLAS ?gemm functions if required and possible.  */
-  append_args = NULL_TREE;
+  append_args = NULL;
   if (expr->value.function.isym->id == GFC_ISYM_MATMUL
       && sym->ts.type != BT_LOGICAL)
     {
@@ -1611,19 +1611,19 @@  gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
 		gemm_fndecl = gfor_fndecl_zgemm;
 	    }
 
-	  append_args = gfc_chainon_list (NULL_TREE, build_int_cst (cint, 1));
-	  append_args = gfc_chainon_list
-			  (append_args, build_int_cst
-					  (cint, gfc_option.blas_matmul_limit));
-	  append_args = gfc_chainon_list (append_args,
-					  gfc_build_addr_expr (NULL_TREE,
-							       gemm_fndecl));
+	  append_args = VEC_alloc (tree, gc, 3);
+	  VEC_quick_push (tree, append_args, build_int_cst (cint, 1));
+	  VEC_quick_push (tree, append_args,
+			  build_int_cst (cint, gfc_option.blas_matmul_limit));
+	  VEC_quick_push (tree, append_args,
+			  gfc_build_addr_expr (NULL_TREE, gemm_fndecl));
 	}
       else
 	{
-	  append_args = gfc_chainon_list (NULL_TREE, build_int_cst (cint, 0));
-	  append_args = gfc_chainon_list (append_args, build_int_cst (cint, 0));
-	  append_args = gfc_chainon_list (append_args, null_pointer_node);
+	  append_args = VEC_alloc (tree, gc, 3);
+	  VEC_quick_push (tree, append_args, build_int_cst (cint, 0));
+	  VEC_quick_push (tree, append_args, build_int_cst (cint, 0));
+	  VEC_quick_push (tree, append_args, null_pointer_node);
 	}
     }
 
@@ -3285,7 +3285,7 @@  conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr,
   unsigned cur_pos;
   gfc_actual_arglist* arg;
   gfc_symbol* sym;
-  tree append_args;
+  VEC(tree,gc) *append_args;
 
   /* Find the two arguments given as position.  */
   cur_pos = 0;
@@ -3309,13 +3309,14 @@  conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr,
 
   /* If we do have type CHARACTER and the optional argument is really absent,
      append a dummy 0 as string length.  */
-  append_args = NULL_TREE;
+  append_args = NULL;
   if (prim_arg->expr->ts.type == BT_CHARACTER && !opt_arg->expr)
     {
       tree dummy;
 
       dummy = build_int_cst (gfc_charlen_type_node, 0);
-      append_args = gfc_chainon_list (append_args, dummy);
+      append_args = VEC_alloc (tree, gc, 1);
+      VEC_quick_push (tree, append_args, dummy);
     }
 
   /* Build the call itself.  */
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 6fa84b9..50ad650 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -373,7 +373,7 @@  gfc_trans_call (gfc_code * code, bool dependency_check,
       /* Translate the call.  */
       has_alternate_specifier
 	= gfc_conv_procedure_call (&se, code->resolved_sym, code->ext.actual,
-				  code->expr1, NULL_TREE);
+				  code->expr1, NULL);
 
       /* A subroutine without side-effect, by definition, does nothing!  */
       TREE_SIDE_EFFECTS (se.expr) = 1;
@@ -457,8 +457,7 @@  gfc_trans_call (gfc_code * code, bool dependency_check,
 
       /* Add the subroutine call to the block.  */
       gfc_conv_procedure_call (&loopse, code->resolved_sym,
-			       code->ext.actual, code->expr1,
-			       NULL_TREE);
+			       code->ext.actual, code->expr1, NULL);
 
       if (mask && count1)
 	{
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 02361fc..fa2d583 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -314,7 +314,7 @@  int gfc_is_intrinsic_libcall (gfc_expr *);
 /* Used to call ordinary functions/subroutines
    and procedure pointer components.  */
 int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *,
-			    gfc_expr *, tree);
+			     gfc_expr *, VEC(tree,gc) *);
 
 void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool);