Patchwork less build_function_type usage in the Fortran FE

login
register
mail settings
Submitter Nathan Froyd
Date May 4, 2011, 1:45 p.m.
Message ID <20110504134520.GG23480@codesourcery.com>
Download mbox | patch
Permalink /patch/94043/
State New
Headers show

Comments

Nathan Froyd - May 4, 2011, 1:45 p.m.
On Wed, May 04, 2011 at 11:22:02AM +0200, Tobias Burnus 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.

Thanks for the review!  We'll see if the janitorial work actually leads
to something useful later on. :)

I've committed the patch below as r173375; testing showed a couple
failures.  I had originally changed this bit in trans-types.c:

  if (typelist)
    typelist = chainon (typelist, void_list_node);
  else if (sym->attr.is_main_program || sym->attr.if_source != IFSRC_UNKNOWN)
    typelist = void_list_node;

to this:

  if (typelist)
    is_varargs = false;
  else if (sym->attr.is_main_program || sym->attr.if_source != IFSRC_UNKNOWN)
    {
      VEC_free (tree, gc, typelist);
      typelist = NULL;
    }

Except that change makes the 'else if' case create a varargs function
where we weren't before.  The VEC_free is totally pointless there,
because typelist would be NULL anyway.  And we ought to be testing with
VEC_empty instead.  A little thought shows that:

  if (!VEC_empty (tree, typelist)
      || sym->attr.is_main_program
      || sym->attr.if_source != IFSRC_UNKNOWN)
    is_varargs = false;

is what we really want.

-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.

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 10dadf7..bbbf64f 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 27dcf82..cc82037 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,14 @@  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);
-  else if (sym->attr.is_main_program || sym->attr.if_source != IFSRC_UNKNOWN)
-    typelist = void_list_node;
+  if (!VEC_empty (tree, typelist)
+      || sym->attr.is_main_program
+      || sym->attr.if_source != IFSRC_UNKNOWN)
+    is_varargs = false;
 
   if (alternate_return)
     type = integer_type_node;
@@ -2690,7 +2689,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 9b4c830..5034b58 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);