vec.h (VEC_splice, [...]): New macros.

gcc/
	* vec.h (VEC_splice, VEC_safe_splice): New macros.  Add function
	implementations.

gcc/fortran/
	* 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.
	(gfc_conv_procedure_call): Use build_call_vec instead of
	build_call_list.

From-SVN: r161834

7 files changed, 155 insertions, 43 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index d447360..23d71ec8 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,8 @@
+2010-07-05  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* vec.h (VEC_splice, VEC_safe_splice): New macros.  Add function
+	implementations.
+
 2010-07-05  Bernd Schmidt  <bernds@codesourcery.com>
 
 	* config/arm/arm.c (get_arm_condition_code): Remove CC_NOTBmode case.
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ca29477..3530c8f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2010-07-05  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* 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.
+	(gfc_conv_procedure_call): Use build_call_vec instead of
+	build_call_list.
+
 2010-07-04  Daniel Kraft  <d@domob.eu>
 
 	* gfc-internals.texi (gfc_code): Document BLOCK and ASSOCIATE.
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 692b3e2..1a7a4a1 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2653,7 +2653,6 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
   return 0;
 }
 
-
 /* 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.
    Return nonzero, if the call has alternate specifiers.
@@ -2662,11 +2661,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 +2676,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 +2689,11 @@ 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 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 +3136,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 +3160,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 +3213,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 +3237,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 +3261,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 +3288,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 +3296,31 @@ 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.  */
+  arglen = (VEC_length (tree, arglist)
+	    + VEC_length (tree, stringargs) + VEC_length (tree, append_args));
+  VEC_reserve_exact (tree, gc, retargs, arglen);
+
   /* Add the return arguments.  */
-  arglist = chainon (retargs, arglist);
+  VEC_splice (tree, retargs, arglist);
 
   /* Add the hidden string length parameters to the arguments.  */
-  arglist = chainon (arglist, stringargs);
+  VEC_splice (tree, retargs, stringargs);
 
   /* 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))
+    VEC_splice (tree, retargs, append_args);
+  arglist = retargs;
 
   /* Generate the actual call.  */
   conv_function_val (se, sym, expr);
@@ -3338,7 +3344,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 +3792,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 15f2acb..beada6a 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);
 
diff --git a/gcc/vec.h b/gcc/vec.h
index 93a432d..e6c42bc 100644
--- a/gcc/vec.h
+++ b/gcc/vec.h
@@ -259,6 +259,32 @@ along with GCC; see the file COPYING3.  If not see
 #define VEC_reserve_exact(T,A,V,R)	\
 	(VEC_OP(T,A,reserve_exact)(&(V),R VEC_CHECK_INFO MEM_STAT_INFO))
 
+/* Copy elements with no reallocation
+   void VEC_T_splice (VEC(T) *dst, VEC(T) *src); // Integer
+   void VEC_T_splice (VEC(T) *dst, VEC(T) *src); // Pointer
+   void VEC_T_splice (VEC(T) *dst, VEC(T) *src); // Object
+
+   Copy the elements in SRC to the end of DST as if by memcpy.  DST and
+   SRC need not be allocated with the same mechanism, although they most
+   often will be.  DST is assumed to have sufficient headroom
+   available.  */
+
+#define VEC_splice(T,DST,SRC)			\
+  (VEC_OP(T,base,splice)(VEC_BASE(DST), VEC_BASE(SRC) VEC_CHECK_INFO))
+
+/* Copy elements with reallocation
+   void VEC_T_safe_splice (VEC(T,A) *&dst, VEC(T) *src); // Integer
+   void VEC_T_safe_splice (VEC(T,A) *&dst, VEC(T) *src); // Pointer
+   void VEC_T_safe_splice (VEC(T,A) *&dst, VEC(T) *src); // Object
+
+   Copy the elements in SRC to the end of DST as if by memcpy.  DST and
+   SRC need not be allocated with the same mechanism, although they most
+   often will be.  DST need not have sufficient headroom and will be
+   reallocated if needed.  */
+
+#define VEC_safe_splice(T,A,DST,SRC)					\
+  (VEC_OP(T,A,safe_splice)(&(DST), VEC_BASE(SRC) VEC_CHECK_INFO MEM_STAT_INFO))
+  
 /* Push object with no reallocation
    T *VEC_T_quick_push (VEC(T) *v, T obj); // Integer
    T *VEC_T_quick_push (VEC(T) *v, T obj); // Pointer
@@ -589,6 +615,19 @@ static inline int VEC_OP (T,base,space)	       				  \
   return vec_ ? vec_->alloc - vec_->num >= (unsigned)alloc_ : !alloc_;	  \
 }									  \
 									  \
+static inline void VEC_OP(T,base,splice)				  \
+     (VEC(T,base) *dst_, VEC(T,base) *src_ VEC_CHECK_DECL)		  \
+{									  \
+  if (src_)								  \
+    {									  \
+      unsigned len_ = src_->num;					  \
+      VEC_ASSERT (dst_->num + len_ <= dst_->alloc, "splice", T, base);	  \
+									  \
+      memcpy (&dst_->vec[dst_->num], &src_->vec[0], len_ * sizeof (T));	  \
+      dst_->num += len_;						  \
+    }									  \
+}									  \
+									  \
 static inline T *VEC_OP (T,base,quick_push)				  \
      (VEC(T,base) *vec_, T obj_ VEC_CHECK_DECL)				  \
 {									  \
@@ -796,6 +835,19 @@ static inline void VEC_OP (T,A,safe_grow_cleared)			  \
 	  sizeof (T) * (size_ - oldsize));				  \
 }									  \
 									  \
+static inline void VEC_OP(T,A,safe_splice)				  \
+     (VEC(T,A) **dst_, VEC(T,base) *src_ VEC_CHECK_DECL MEM_STAT_DECL)	  \
+{									  \
+  if (src_)								  \
+    {									  \
+      VEC_OP (T,A,reserve_exact) (dst_, src_->num			  \
+				  VEC_CHECK_PASS MEM_STAT_INFO);	  \
+									  \
+      VEC_OP (T,base,splice) (VEC_BASE (*dst_), src_			  \
+			      VEC_CHECK_PASS);				  \
+    }									  \
+}									  \
+									  \
 static inline T *VEC_OP (T,A,safe_push)					  \
      (VEC(T,A) **vec_, T obj_ VEC_CHECK_DECL MEM_STAT_DECL)       	  \
 {									  \
@@ -881,6 +933,19 @@ static inline int VEC_OP (T,base,space)	       				  \
   return vec_ ? vec_->alloc - vec_->num >= (unsigned)alloc_ : !alloc_;	  \
 }									  \
 									  \
+static inline void VEC_OP(T,base,splice)				  \
+     (VEC(T,base) *dst_, VEC(T,base) *src_ VEC_CHECK_DECL)		  \
+{									  \
+  if (src_)								  \
+    {									  \
+      unsigned len_ = src_->num;					  \
+      VEC_ASSERT (dst_->num + len_ <= dst_->alloc, "splice", T, base);	  \
+									  \
+      memcpy (&dst_->vec[dst_->num], &src_->vec[0], len_ * sizeof (T));	  \
+      dst_->num += len_;						  \
+    }									  \
+}									  \
+									  \
 static inline T *VEC_OP (T,base,quick_push)				  \
      (VEC(T,base) *vec_, const T *obj_ VEC_CHECK_DECL)			  \
 {									  \
@@ -1084,6 +1149,19 @@ static inline void VEC_OP (T,A,safe_grow_cleared)			  \
 	  sizeof (T) * (size_ - oldsize));				  \
 }									  \
 									  \
+static inline void VEC_OP(T,A,safe_splice)				  \
+     (VEC(T,A) **dst_, VEC(T,base) *src_ VEC_CHECK_DECL MEM_STAT_DECL)	  \
+{									  \
+  if (src_)								  \
+    {									  \
+      VEC_OP (T,A,reserve_exact) (dst_, src_->num			  \
+				  VEC_CHECK_PASS MEM_STAT_INFO);	  \
+									  \
+      VEC_OP (T,base,splice) (VEC_BASE (*dst_), src_			  \
+			      VEC_CHECK_PASS);				  \
+    }									  \
+}									  \
+									  \
 static inline T *VEC_OP (T,A,safe_push)					  \
      (VEC(T,A) **vec_, const T *obj_ VEC_CHECK_DECL MEM_STAT_DECL)	  \
 {									  \
@@ -1188,6 +1266,19 @@ static inline void VEC_OP (T,A,safe_grow_cleared)			  \
 	  sizeof (T) * (size_ - oldsize));				  \
 }									  \
 									  \
+static inline void VEC_OP(T,A,safe_splice)				  \
+     (VEC(T,A) **dst_, VEC(T,base) *src_ VEC_CHECK_DECL MEM_STAT_DECL)	  \
+{									  \
+  if (src_)								  \
+    {									  \
+      VEC_OP (T,A,reserve_exact) (dst_, src_->num			  \
+				  VEC_CHECK_PASS MEM_STAT_INFO);	  \
+									  \
+      VEC_OP (T,base,splice) (VEC_BASE (*dst_), src_			  \
+			      VEC_CHECK_PASS);				  \
+    }									  \
+}									  \
+									  \
 static inline T *VEC_OP (T,A,safe_push)					  \
      (VEC(T,A) **vec_, const T obj_ VEC_CHECK_DECL MEM_STAT_DECL)	  \
 {									  \