diff mbox

less build_function_type usage in the Fortran FE

Message ID 20110503190654.GB23480@codesourcery.com
State New
Headers show

Commit Message

Nathan Froyd May 3, 2011, 7:06 p.m. UTC 
The patch below eliminates almost all cases of build_function_type in
the Fortran FE.  (The last case uses TYPE_ARG_TYPES directly and will
need to be dealt with separately.)  This is accomplished by introducing
two new functions, build_{,varargs_}function_type_array, which do what
you think, and two small macro wrappers around them,
build_{,varargs_}function_type_vec.  The macro wrappers are used so that
one can use heap-, gc-, or stack-allocated vectors, as necessary.

Comments on the middle-end bits welcome; some sort of FUNCTION_TYPE
builder with a dynamically determined number of argument types is needed
for working towards the elimination of TYPE_ARG_TYPES.

As a happy side-effect, the patch eliminates uses of gfc_chainon_list
and makes the specific instances below of building function types
linear, instead of quadratic.  If the patch is approved, I will delete
gfc_chainon_list as an obvious followon patch.

Testing in progress on x86_64-unknown-linux-gnu.  OK to commit if
testing successful?

-Nathan

gcc/
	* tree.h (build_function_type_array): Declare.
	(build_varargs_function_type_array): Declare.
	(build_function_type_vec, build_varargs_function_type_vec): Define.
	* tree.c (build_function_type_array_1): New function.
	(build_function_type_array): New function.
	(build_varargs_function_type_array): New function.

gcc/fortran/
	* trans-decl.c (build_library_function_decl_1): Call
	build_function_type_vec.  Adjust argument list building accordingly.
	* trans-intrinsic.c (gfc_get_intrinsic_lib_fndecl): Likewise.
	* trans-types.c (gfc_get_function_type): Likewise.

Comments

Tobias Burnus May 4, 2011, 9:22 a.m. UTC | #1 
On 05/03/2011 09:06 PM, Nathan Froyd wrote:
> Testing in progress on x86_64-unknown-linux-gnu.  OK to commit if
> testing successful?

The Fortran part is OK. Thanks for the janitorial work.

Tobias

> gcc/
> 	* tree.h (build_function_type_array): Declare.
> 	(build_varargs_function_type_array): Declare.
> 	(build_function_type_vec, build_varargs_function_type_vec): Define.
> 	* tree.c (build_function_type_array_1): New function.
> 	(build_function_type_array): New function.
> 	(build_varargs_function_type_array): New function.
>
> gcc/fortran/
> 	* trans-decl.c (build_library_function_decl_1): Call
> 	build_function_type_vec.  Adjust argument list building accordingly.
> 	* trans-intrinsic.c (gfc_get_intrinsic_lib_fndecl): Likewise.
> 	* trans-types.c (gfc_get_function_type): Likewise.
Richard Biener May 4, 2011, 9:51 a.m. UTC | #2 
On Wed, May 4, 2011 at 11:22 AM, Tobias Burnus <burnus@net-b.de> wrote:
> On 05/03/2011 09:06 PM, Nathan Froyd wrote:
>>
>> Testing in progress on x86_64-unknown-linux-gnu.  OK to commit if
>> testing successful?
>
> The Fortran part is OK. Thanks for the janitorial work.

The middle-end parts are also ok.

Richard.

> Tobias
>
>> gcc/
>>        * tree.h (build_function_type_array): Declare.
>>        (build_varargs_function_type_array): Declare.
>>        (build_function_type_vec, build_varargs_function_type_vec): Define.
>>        * tree.c (build_function_type_array_1): New function.
>>        (build_function_type_array): New function.
>>        (build_varargs_function_type_array): New function.
>>
>> gcc/fortran/
>>        * trans-decl.c (build_library_function_decl_1): Call
>>        build_function_type_vec.  Adjust argument list building
>> accordingly.
>>        * trans-intrinsic.c (gfc_get_intrinsic_lib_fndecl): Likewise.
>>        * trans-types.c (gfc_get_function_type): Likewise.
>
diff mbox

Patch

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index f80c9db..dc381f9 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2478,8 +2478,7 @@  static tree
 build_library_function_decl_1 (tree name, const char *spec,
 			       tree rettype, int nargs, va_list p)
 {
-  tree arglist;
-  tree argtype;
+  VEC(tree,gc) *arglist;
   tree fntype;
   tree fndecl;
   int n;
@@ -2488,20 +2487,18 @@  build_library_function_decl_1 (tree name, const char *spec,
   gcc_assert (current_function_decl == NULL_TREE);
 
   /* Create a list of the argument types.  */
-  for (arglist = NULL_TREE, n = abs (nargs); n > 0; n--)
+  arglist = VEC_alloc (tree, gc, abs (nargs));
+  for (n = abs (nargs); n > 0; n--)
     {
-      argtype = va_arg (p, tree);
-      arglist = gfc_chainon_list (arglist, argtype);
-    }
-
-  if (nargs >= 0)
-    {
-      /* Terminate the list.  */
-      arglist = chainon (arglist, void_list_node);
+      tree argtype = va_arg (p, tree);
+      VEC_quick_push (tree, arglist, argtype);
     }
 
   /* Build the function type and decl.  */
-  fntype = build_function_type (rettype, arglist);
+  if (nargs >= 0)
+    fntype = build_function_type_vec (rettype, arglist);
+  else
+    fntype = build_varargs_function_type_vec (rettype, arglist);
   if (spec)
     {
       tree attr_args = build_tree_list (NULL_TREE,
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 180aba1..360723c 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -722,7 +722,7 @@  static tree
 gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr)
 {
   tree type;
-  tree argtypes;
+  VEC(tree,gc) *argtypes;
   tree fndecl;
   gfc_actual_arglist *actual;
   tree *pdecl;
@@ -803,14 +803,13 @@  gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr)
 		ts->kind);
     }
 
-  argtypes = NULL_TREE;
+  argtypes = NULL;
   for (actual = expr->value.function.actual; actual; actual = actual->next)
     {
       type = gfc_typenode_for_spec (&actual->expr->ts);
-      argtypes = gfc_chainon_list (argtypes, type);
+      VEC_safe_push (tree, gc, argtypes, type);
     }
-  argtypes = chainon (argtypes, void_list_node);
-  type = build_function_type (gfc_typenode_for_spec (ts), argtypes);
+  type = build_function_type_vec (gfc_typenode_for_spec (ts), argtypes);
   fndecl = build_decl (input_location,
 		       FUNCTION_DECL, get_identifier (name), type);
 
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index ebc8c23..4606f68 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2534,10 +2534,11 @@  tree
 gfc_get_function_type (gfc_symbol * sym)
 {
   tree type;
-  tree typelist;
+  VEC(tree,gc) *typelist;
   gfc_formal_arglist *f;
   gfc_symbol *arg;
   int alternate_return;
+  bool is_varargs = true;
 
   /* Make sure this symbol is a function, a subroutine or the main
      program.  */
@@ -2548,13 +2549,11 @@  gfc_get_function_type (gfc_symbol * sym)
     return TREE_TYPE (sym->backend_decl);
 
   alternate_return = 0;
-  typelist = NULL_TREE;
+  typelist = NULL;
 
   if (sym->attr.entry_master)
-    {
-      /* Additional parameter for selecting an entry point.  */
-      typelist = gfc_chainon_list (typelist, gfc_array_index_type);
-    }
+    /* Additional parameter for selecting an entry point.  */
+    VEC_safe_push (tree, gc, typelist, gfc_array_index_type);
 
   if (sym->result)
     arg = sym->result;
@@ -2573,17 +2572,17 @@  gfc_get_function_type (gfc_symbol * sym)
 	  || arg->ts.type == BT_CHARACTER)
 	type = build_reference_type (type);
 
-      typelist = gfc_chainon_list (typelist, type);
+      VEC_safe_push (tree, gc, typelist, type);
       if (arg->ts.type == BT_CHARACTER)
 	{
 	  if (!arg->ts.deferred)
 	    /* Transfer by value.  */
-	    typelist = gfc_chainon_list (typelist, gfc_charlen_type_node);
+	    VEC_safe_push (tree, gc, typelist, gfc_charlen_type_node);
 	  else
 	    /* Deferred character lengths are transferred by reference
 	       so that the value can be returned.  */
-	    typelist = gfc_chainon_list (typelist,
-				build_pointer_type (gfc_charlen_type_node));
+	    VEC_safe_push (tree, gc, typelist,
+			   build_pointer_type (gfc_charlen_type_node));
 	}
     }
 
@@ -2621,7 +2620,7 @@  gfc_get_function_type (gfc_symbol * sym)
 	     used without an explicit interface, and cannot be passed as
 	     actual parameters for a dummy procedure.  */
 
-	  typelist = gfc_chainon_list (typelist, type);
+	  VEC_safe_push (tree, gc, typelist, type);
 	}
       else
         {
@@ -2644,14 +2643,17 @@  gfc_get_function_type (gfc_symbol * sym)
 	       so that the value can be returned.  */
 	    type = build_pointer_type (gfc_charlen_type_node);
 
-	  typelist = gfc_chainon_list (typelist, type);
+	  VEC_safe_push (tree, gc, typelist, type);
 	}
     }
 
   if (typelist)
-    typelist = chainon (typelist, void_list_node);
+    is_varargs = false;
   else if (sym->attr.is_main_program || sym->attr.if_source != IFSRC_UNKNOWN)
-    typelist = void_list_node;
+    {
+      VEC_free (tree, gc, typelist);
+      typelist = NULL;
+    }
 
   if (alternate_return)
     type = integer_type_node;
@@ -2690,7 +2692,10 @@  gfc_get_function_type (gfc_symbol * sym)
   else
     type = gfc_sym_type (sym);
 
-  type = build_function_type (type, typelist);
+  if (is_varargs)
+    type = build_varargs_function_type_vec (type, typelist);
+  else
+    type = build_function_type_vec (type, typelist);
   type = create_fn_spec (sym, type);
 
   return type;
diff --git a/gcc/tree.c b/gcc/tree.c
index 1f11838..baf6f2b 100644
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -7640,6 +7640,44 @@  build_varargs_function_type_list (tree return_type, ...)
   return args;
 }
 
+/* Build a function type.  RETURN_TYPE is the type returned by the
+   function; VAARGS indicates whether the function takes varargs.  The
+   function takes N named arguments, the types of which are provided in
+   ARG_TYPES.  */
+
+static tree
+build_function_type_array_1 (bool vaargs, tree return_type, int n,
+			     tree *arg_types)
+{
+  int i;
+  tree t = vaargs ? NULL_TREE : void_list_node;
+
+  for (i = n - 1; i >= 0; i--)
+    t = tree_cons (NULL_TREE, arg_types[i], t);
+
+  return build_function_type (return_type, t);
+}
+
+/* Build a function type.  RETURN_TYPE is the type returned by the
+   function.  The function takes N named arguments, the types of which
+   are provided in ARG_TYPES.  */
+
+tree
+build_function_type_array (tree return_type, int n, tree *arg_types)
+{
+  return build_function_type_array_1 (false, return_type, n, arg_types);
+}
+
+/* Build a variable argument function type.  RETURN_TYPE is the type
+   returned by the function.  The function takes N named arguments, the
+   types of which are provided in ARG_TYPES.  */
+
+tree
+build_varargs_function_type_array (tree return_type, int n, tree *arg_types)
+{
+  return build_function_type_array_1 (true, return_type, n, arg_types);
+}
+
 /* Build a METHOD_TYPE for a member of BASETYPE.  The RETTYPE (a TYPE)
    and ARGTYPES (a TREE_LIST) are the return type and arguments types
    for the method.  An implicit additional parameter (of type
diff --git a/gcc/tree.h b/gcc/tree.h
index 37507f0..e337f60 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -4256,6 +4256,13 @@  extern tree build_function_type_list (tree, ...);
 extern tree build_function_type_skip_args (tree, bitmap);
 extern tree build_function_decl_skip_args (tree, bitmap);
 extern tree build_varargs_function_type_list (tree, ...);
+extern tree build_function_type_array (tree, int, tree *);
+extern tree build_varargs_function_type_array (tree, int, tree *);
+#define build_function_type_vec(RET, V) \
+  build_function_type_array (RET, VEC_length (tree, V), VEC_address (tree, V))
+#define build_varargs_function_type_vec(RET, V) \
+  build_varargs_function_type_array (RET, VEC_length (tree, V), \
+				     VEC_address (tree, V))
 extern tree build_method_type_directly (tree, tree, tree);
 extern tree build_method_type (tree, tree);
 extern tree build_offset_type (tree, tree);