diff mbox

avoid chainon when building record types in Fortran FE

Message ID 20100702134406.GC17877@codesourcery.com
State New
Headers show

Commit Message

Nathan Froyd July 2, 2010, 1:44 p.m. UTC 
The Fortran FE builds up the fields for RECORD_TYPEs with repeated use
of chainon:

  list = chainon (list, decl);
  list = chainon (list, decl);
  ...

which does more work than it needs to.  This patch addresses that by
adding a parameter to gfc_add_field_to_struct that points to the end
(last TREE_CHAIN field, really) of the field list being built.  It also
makes gfc_add_field_to_struct be used in a few more places, though with
a bit of complexity, as we have to be careful to not add alignment
information where it wasn't present before.

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

-Nathan

	* trans-types.h (gfc_add_field_to_struct): Add tree ** parameter.
	* trans-types.c (gfc_add_field_to_struct_1): New function, most
	of which comes from...
	(gfc_add_field_to_struct): ...here.  Call it.  Add new parameter.
	(gfc_get_desc_dim_type): Call gfc_add_field_to_struct_1 for
	building fields.
	(gfc_get_array_descriptor_base): Likewise.
	(gfc_get_mixed_entry_union): Likewise.
	(gfc_get_derived_type): Add extra chain parameter for
	gfc_add_field_to_struct.
	* trans-stmt.c (gfc_trans_character_select): Likewise.
	* trans-io.c (gfc_build_st_parameter): Likewise.

Comments

Mikael Morin July 2, 2010, 3:22 p.m. UTC | #1 
Le 02.07.2010 15:44, Nathan Froyd a écrit :
>
> The Fortran FE builds up the fields for RECORD_TYPEs with repeated use
> of chainon:
>
>    list = chainon (list, decl);
>    list = chainon (list, decl);
>    ...
>
> which does more work than it needs to.  This patch addresses that by
> adding a parameter to gfc_add_field_to_struct that points to the end
> (last TREE_CHAIN field, really) of the field list being built.  It also
> makes gfc_add_field_to_struct be used in a few more places, though with
> a bit of complexity, as we have to be careful to not add alignment
> information where it wasn't present before.
>
> Tested on x86_64-unknown-linux-gnu.  OK to commit?

[...]

> @@ -1853,26 +1841,44 @@ gfc_finish_type (tree type)
>   }
>   
>   /* Add a field of given NAME and TYPE to the context of a UNION_TYPE
> -   or RECORD_TYPE pointed to by STYPE.  The new field is chained
> -   to the fieldlist pointed to by FIELDLIST.
> +   or RECORD_TYPE pointed to by CONTEXT.  The new field is chained
> +   to the fieldlist pointed to by FIELDLIST through *CHAIN.
>
>      Returns a pointer to the new field.  */
>
> +static tree
> +gfc_add_field_to_struct_1 (tree *fieldlist, tree context,
> +				 tree name, tree type, tree **chain)
> +{
> +  tree decl = build_decl (input_location, FIELD_DECL, name, type);
> +
> +  DECL_CONTEXT (decl) = context;
> +  TREE_CHAIN (decl) = NULL_TREE;
> +  if (*fieldlist == NULL_TREE)
> +    *fieldlist = decl;
It seems you can remove fieldlist from the the parameters and use 
TYPE_FIELDS(context) instead here.
OK with that change.
Actually, OK even without it.

Mikael

> +  if (chain != NULL)
> +    {
> +      if (*chain != NULL)
> +	**chain = decl;
> +      *chain =&TREE_CHAIN (decl);
> +    }
> +
> +  return decl;
> +}
> +
> +/* Like `gfc_add_field_to_struct_1', but adds alignment
> +   information.  */
> +
>   tree
>   gfc_add_field_to_struct (tree *fieldlist, tree context,
> -			 tree name, tree type)
> +			 tree name, tree type, tree **chain)
>   {
> -  tree decl;
> +  tree decl = gfc_add_field_to_struct_1 (fieldlist, context,
> +					 name, type, chain);
>
> -  decl = build_decl (input_location,
> -		     FIELD_DECL, name, type);
> -
> -  DECL_CONTEXT (decl) = context;
>     DECL_INITIAL (decl) = 0;
>     DECL_ALIGN (decl) = 0;
>     DECL_USER_ALIGN (decl) = 0;
> -  TREE_CHAIN (decl) = NULL_TREE;
> -  *fieldlist = chainon (*fieldlist, decl);
>
>     return decl;
>   }
[...]
Nathan Froyd July 2, 2010, 7:58 p.m. UTC | #2 
On Fri, Jul 02, 2010 at 05:22:02PM +0200, Mikael Morin wrote:
> Le 02.07.2010 15:44, Nathan Froyd a écrit :
>> @@ -1853,26 +1841,44 @@ gfc_finish_type (tree type)
>>   }
>>   
>>   /* Add a field of given NAME and TYPE to the context of a UNION_TYPE
>> -   or RECORD_TYPE pointed to by STYPE.  The new field is chained
>> -   to the fieldlist pointed to by FIELDLIST.
>> +   or RECORD_TYPE pointed to by CONTEXT.  The new field is chained
>> +   to the fieldlist pointed to by FIELDLIST through *CHAIN.
>>
>>      Returns a pointer to the new field.  */
>>
>> +static tree
>> +gfc_add_field_to_struct_1 (tree *fieldlist, tree context,
>> +				 tree name, tree type, tree **chain)
>> +{
>> +  tree decl = build_decl (input_location, FIELD_DECL, name, type);
>> +
>> +  DECL_CONTEXT (decl) = context;
>> +  TREE_CHAIN (decl) = NULL_TREE;
>> +  if (*fieldlist == NULL_TREE)
>> +    *fieldlist = decl;
> It seems you can remove fieldlist from the the parameters and use  
> TYPE_FIELDS(context) instead here.
> OK with that change.
> Actually, OK even without it.

That's a good point.  It even seems obvious now that you mention it.
That would permit removing &fieldlist from all the other calls to this
function and just using TYPE_FIELDS (context).  But it doesn't work,
because at this call, in trans-types.c:gfc_get_derived_type:

      /* Create a backend_decl for the __c_ptr_c_address field.  */
      derived->components->backend_decl =
	gfc_add_field_to_struct (&(derived->backend_decl->type.values),
				 derived->backend_decl,
				 get_identifier (derived->components->name),
				 gfc_typenode_for_spec (
				 &(derived->components->ts)), NULL);

derived->backend_decl isn't a RECORD_TYPE-looking thing: it's a
POINTER_TYPE.  So it doesn't have TYPE_FIELDS, and an --enable-checking
build breaks.  This code looks quite dodgy anyway: why is the type field
being accessed directly?  And why are we adding a FIELD_DECL to a
POINTER_TYPE?

Since you approved it without the changes, I've committed the patch as
161738.  Thanks for the review.

-Nathan
Mikael Morin July 2, 2010, 8:36 p.m. UTC | #3 
Le 02.07.2010 21:58, Nathan Froyd a écrit :
>
> On Fri, Jul 02, 2010 at 05:22:02PM +0200, Mikael Morin wrote:
>> Le 02.07.2010 15:44, Nathan Froyd a écrit :
>>> @@ -1853,26 +1841,44 @@ gfc_finish_type (tree type)
>>>    }
>>>    
>>>    /* Add a field of given NAME and TYPE to the context of a UNION_TYPE
>>> -   or RECORD_TYPE pointed to by STYPE.  The new field is chained
>>> -   to the fieldlist pointed to by FIELDLIST.
>>> +   or RECORD_TYPE pointed to by CONTEXT.  The new field is chained
>>> +   to the fieldlist pointed to by FIELDLIST through *CHAIN.
>>>
>>>       Returns a pointer to the new field.  */
>>>
>>> +static tree
>>> +gfc_add_field_to_struct_1 (tree *fieldlist, tree context,
>>> +				 tree name, tree type, tree **chain)
>>> +{
>>> +  tree decl = build_decl (input_location, FIELD_DECL, name, type);
>>> +
>>> +  DECL_CONTEXT (decl) = context;
>>> +  TREE_CHAIN (decl) = NULL_TREE;
>>> +  if (*fieldlist == NULL_TREE)
>>> +    *fieldlist = decl;
>> It seems you can remove fieldlist from the the parameters and use
>> TYPE_FIELDS(context) instead here.
>> OK with that change.
>> Actually, OK even without it.
>
> That's a good point.  It even seems obvious now that you mention it.
> That would permit removing&fieldlist from all the other calls to this
> function and just using TYPE_FIELDS (context).  But it doesn't work,
> because at this call, in trans-types.c:gfc_get_derived_type:
>
>        /* Create a backend_decl for the __c_ptr_c_address field.  */
>        derived->components->backend_decl =
> 	gfc_add_field_to_struct (&(derived->backend_decl->type.values),
> 				 derived->backend_decl,
> 				 get_identifier (derived->components->name),
> 				 gfc_typenode_for_spec (
> 				&(derived->components->ts)), NULL);
>
> derived->backend_decl isn't a RECORD_TYPE-looking thing: it's a
> POINTER_TYPE.  So it doesn't have TYPE_FIELDS, and an --enable-checking
> build breaks.  This code looks quite dodgy anyway: why is the type field
> being accessed directly?
I bet it's because using the macro would break a checking-enabled build ;-)

> And why are we adding a FIELD_DECL to a
> POINTER_TYPE?
The iso_c interoperability code is full of hacks like this trying not to 
upset either the middle-end or fortran front-end.

The fortran standard defines a C_PTR (= pointer for interoperatbility 
with C) as an opaque structure holding a single field containing the 
actual pointer.
Thus, it should be seen as a structure from the front-end point of view 
and a pointer from the middle-end.
That's what this part is trying to achieve, I think.

Thanks for the patch anyway.

Mikael
diff mbox

Patch

diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 1608a5e..9926d2f 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -156,6 +156,7 @@  gfc_build_st_parameter (enum ioparam_type ptype, tree *types)
   char name[64];
   size_t len;
   tree t = make_node (RECORD_TYPE);
+  tree *chain = NULL;
 
   len = strlen (st_parameter[ptype].name);
   gcc_assert (len <= sizeof (name) - sizeof ("__st_parameter_"));
@@ -177,12 +178,12 @@  gfc_build_st_parameter (enum ioparam_type ptype, tree *types)
 	case IOPARM_type_pad:
 	  p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t,
 					      get_identifier (p->name),
-					      types[p->type]);
+					      types[p->type], &chain);
 	  break;
 	case IOPARM_type_char1:
 	  p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t,
 					      get_identifier (p->name),
-					      pchar_type_node);
+					      pchar_type_node, &chain);
 	  /* FALLTHROUGH */
 	case IOPARM_type_char2:
 	  len = strlen (p->name);
@@ -191,17 +192,19 @@  gfc_build_st_parameter (enum ioparam_type ptype, tree *types)
 	  memcpy (name + len, "_len", sizeof ("_len"));
 	  p->field_len = gfc_add_field_to_struct (&TYPE_FIELDS (t), t,
 						  get_identifier (name),
-						  gfc_charlen_type_node);
+						  gfc_charlen_type_node,
+						  &chain);
 	  if (p->type == IOPARM_type_char2)
 	    p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t,
 						get_identifier (p->name),
-						pchar_type_node);
+						pchar_type_node, &chain);
 	  break;
 	case IOPARM_type_common:
 	  p->field
 	    = gfc_add_field_to_struct (&TYPE_FIELDS (t), t,
 				       get_identifier (p->name),
-				       st_parameter[IOPARM_ptype_common].type);
+				       st_parameter[IOPARM_ptype_common].type,
+				       &chain);
 	  break;
 	case IOPARM_type_num:
 	  gcc_unreachable ();
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 6fa84b9..15f2acb 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1633,6 +1633,7 @@  gfc_trans_character_select (gfc_code *code)
 
   if (select_struct[k] == NULL)
     {
+      tree *chain = NULL;
       select_struct[k] = make_node (RECORD_TYPE);
 
       if (code->expr1->ts.kind == 1)
@@ -1646,7 +1647,7 @@  gfc_trans_character_select (gfc_code *code)
 #define ADD_FIELD(NAME, TYPE)					\
   ss_##NAME[k] = gfc_add_field_to_struct				\
      (&(TYPE_FIELDS (select_struct[k])), select_struct[k],	\
-      get_identifier (stringize(NAME)), TYPE)
+      get_identifier (stringize(NAME)), TYPE, &chain)
 
       ADD_FIELD (string1, pchartype);
       ADD_FIELD (string1_len, gfc_charlen_type_node);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 2f5b759..f4e78c2 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -86,6 +86,7 @@  gfc_character_info gfc_character_kinds[MAX_CHARACTER_KINDS + 1];
 static GTY(()) tree gfc_character_types[MAX_CHARACTER_KINDS + 1];
 static GTY(()) tree gfc_pcharacter_types[MAX_CHARACTER_KINDS + 1];
 
+static tree gfc_add_field_to_struct_1 (tree *, tree, tree, tree, tree **);
 
 /* The integer kind to use for array indices.  This will be set to the
    proper value based on target information from the backend.  */
@@ -1232,8 +1233,7 @@  static tree
 gfc_get_desc_dim_type (void)
 {
   tree type;
-  tree decl;
-  tree fieldlist;
+  tree fieldlist = NULL_TREE, decl, *chain = NULL;
 
   if (gfc_desc_dim_type)
     return gfc_desc_dim_type;
@@ -1245,26 +1245,20 @@  gfc_get_desc_dim_type (void)
   TYPE_PACKED (type) = 1;
 
   /* Consists of the stride, lbound and ubound members.  */
-  decl = build_decl (input_location,
-		     FIELD_DECL,
-		     get_identifier ("stride"), gfc_array_index_type);
-  DECL_CONTEXT (decl) = type;
+  decl = gfc_add_field_to_struct_1 (&fieldlist, type,
+				    get_identifier ("stride"),
+				    gfc_array_index_type, &chain);
   TREE_NO_WARNING (decl) = 1;
-  fieldlist = decl;
 
-  decl = build_decl (input_location,
-		     FIELD_DECL,
-		     get_identifier ("lbound"), gfc_array_index_type);
-  DECL_CONTEXT (decl) = type;
+  decl = gfc_add_field_to_struct_1 (&fieldlist, type,
+				    get_identifier ("lbound"),
+				    gfc_array_index_type, &chain);
   TREE_NO_WARNING (decl) = 1;
-  fieldlist = chainon (fieldlist, decl);
 
-  decl = build_decl (input_location,
-		     FIELD_DECL,
-		     get_identifier ("ubound"), gfc_array_index_type);
-  DECL_CONTEXT (decl) = type;
+  decl = gfc_add_field_to_struct_1 (&fieldlist, type,
+				    get_identifier ("ubound"),
+				    gfc_array_index_type, &chain);
   TREE_NO_WARNING (decl) = 1;
-  fieldlist = chainon (fieldlist, decl);
 
   /* Finish off the type.  */
   TYPE_FIELDS (type) = fieldlist;
@@ -1540,7 +1534,7 @@  gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
 static tree
 gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
 {
-  tree fat_type, fieldlist, decl, arraytype;
+  tree fat_type, fieldlist = NULL_TREE, decl, arraytype, *chain = NULL;
   char name[16 + 2*GFC_RANK_DIGITS + 1 + 1];
   int idx = 2 * (codimen + dimen - 1) + restricted;
 
@@ -1555,28 +1549,23 @@  gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
   TYPE_NAME (fat_type) = get_identifier (name);
 
   /* Add the data member as the first element of the descriptor.  */
-  decl = build_decl (input_location,
-		     FIELD_DECL, get_identifier ("data"),
-		     restricted ? prvoid_type_node : ptr_type_node);
-
-  DECL_CONTEXT (decl) = fat_type;
-  fieldlist = decl;
+  decl = gfc_add_field_to_struct_1 (&fieldlist, fat_type,
+				    get_identifier ("data"),
+				    (restricted
+				     ? prvoid_type_node
+				     : ptr_type_node), &chain);
 
   /* Add the base component.  */
-  decl = build_decl (input_location,
-		     FIELD_DECL, get_identifier ("offset"),
-		     gfc_array_index_type);
-  DECL_CONTEXT (decl) = fat_type;
+  decl = gfc_add_field_to_struct_1 (&fieldlist, fat_type,
+				    get_identifier ("offset"),
+				    gfc_array_index_type, &chain);
   TREE_NO_WARNING (decl) = 1;
-  fieldlist = chainon (fieldlist, decl);
 
   /* Add the dtype component.  */
-  decl = build_decl (input_location,
-		     FIELD_DECL, get_identifier ("dtype"),
-		     gfc_array_index_type);
-  DECL_CONTEXT (decl) = fat_type;
+  decl = gfc_add_field_to_struct_1 (&fieldlist, fat_type,
+				    get_identifier ("dtype"),
+				    gfc_array_index_type, &chain);
   TREE_NO_WARNING (decl) = 1;
-  fieldlist = chainon (fieldlist, decl);
 
   /* Build the array type for the stride and bound components.  */
   arraytype =
@@ -1585,11 +1574,10 @@  gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
 					gfc_index_zero_node,
 					gfc_rank_cst[codimen + dimen - 1]));
 
-  decl = build_decl (input_location,
-		     FIELD_DECL, get_identifier ("dim"), arraytype);
-  DECL_CONTEXT (decl) = fat_type;
+  decl = gfc_add_field_to_struct_1 (&fieldlist, fat_type,
+				    get_identifier ("dim"),
+				    arraytype, &chain);
   TREE_NO_WARNING (decl) = 1;
-  fieldlist = chainon (fieldlist, decl);
 
   /* Finish off the type.  */
   TYPE_FIELDS (fat_type) = fieldlist;
@@ -1853,26 +1841,44 @@  gfc_finish_type (tree type)
 }
 
 /* Add a field of given NAME and TYPE to the context of a UNION_TYPE
-   or RECORD_TYPE pointed to by STYPE.  The new field is chained
-   to the fieldlist pointed to by FIELDLIST.
+   or RECORD_TYPE pointed to by CONTEXT.  The new field is chained
+   to the fieldlist pointed to by FIELDLIST through *CHAIN.
 
    Returns a pointer to the new field.  */
 
+static tree
+gfc_add_field_to_struct_1 (tree *fieldlist, tree context,
+				 tree name, tree type, tree **chain)
+{
+  tree decl = build_decl (input_location, FIELD_DECL, name, type);
+
+  DECL_CONTEXT (decl) = context;
+  TREE_CHAIN (decl) = NULL_TREE;
+  if (*fieldlist == NULL_TREE)
+    *fieldlist = decl;
+  if (chain != NULL)
+    {
+      if (*chain != NULL)
+	**chain = decl;
+      *chain = &TREE_CHAIN (decl);
+    }
+
+  return decl;
+}
+
+/* Like `gfc_add_field_to_struct_1', but adds alignment
+   information.  */
+
 tree
 gfc_add_field_to_struct (tree *fieldlist, tree context,
-			 tree name, tree type)
+			 tree name, tree type, tree **chain)
 {
-  tree decl;
+  tree decl = gfc_add_field_to_struct_1 (fieldlist, context,
+					 name, type, chain);
 
-  decl = build_decl (input_location,
-		     FIELD_DECL, name, type);
-
-  DECL_CONTEXT (decl) = context;
   DECL_INITIAL (decl) = 0;
   DECL_ALIGN (decl) = 0;
   DECL_USER_ALIGN (decl) = 0;
-  TREE_CHAIN (decl) = NULL_TREE;
-  *fieldlist = chainon (*fieldlist, decl);
 
   return decl;
 }
@@ -1950,6 +1956,7 @@  gfc_get_derived_type (gfc_symbol * derived)
 {
   tree typenode = NULL, field = NULL, field_type = NULL, fieldlist = NULL;
   tree canonical = NULL_TREE;
+  tree *chain = NULL;
   bool got_canonical = false;
   gfc_component *c;
   gfc_dt_list *dt;
@@ -1975,7 +1982,7 @@  gfc_get_derived_type (gfc_symbol * derived)
 				 derived->backend_decl,
 				 get_identifier (derived->components->name),
 				 gfc_typenode_for_spec (
-				   &(derived->components->ts)));
+				 &(derived->components->ts)), NULL);
 
       derived->ts.kind = gfc_index_integer_kind;
       derived->ts.type = BT_INTEGER;
@@ -2146,7 +2153,8 @@  gfc_get_derived_type (gfc_symbol * derived)
 	field_type = build_pointer_type (field_type);
 
       field = gfc_add_field_to_struct (&fieldlist, typenode,
-				       get_identifier (c->name), field_type);
+				       get_identifier (c->name),
+				       field_type, &chain);
       if (c->loc.lb)
 	gfc_set_decl_location (field, &c->loc);
       else if (derived->declared_at.lb)
@@ -2224,8 +2232,8 @@  static tree
 gfc_get_mixed_entry_union (gfc_namespace *ns)
 {
   tree type;
-  tree decl;
   tree fieldlist;
+  tree *chain = NULL;
   char name[GFC_MAX_SYMBOL_LEN + 1];
   gfc_entry_list *el, *el2;
 
@@ -2248,14 +2256,9 @@  gfc_get_mixed_entry_union (gfc_namespace *ns)
 	  break;
 
       if (el == el2)
-	{
-	  decl = build_decl (input_location,
-			     FIELD_DECL,
-			     get_identifier (el->sym->result->name),
-			     gfc_sym_type (el->sym->result));
-	  DECL_CONTEXT (decl) = type;
-	  fieldlist = chainon (fieldlist, decl);
-	}
+	gfc_add_field_to_struct_1 (&fieldlist, type,
+				   get_identifier (el->sym->result->name),
+				   gfc_sym_type (el->sym->result), &chain);
     }
 
   /* Finish off the type.  */
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index 0b96211..0949b77 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -77,7 +77,7 @@  tree gfc_get_array_type_bounds (tree, int, int, tree *, tree *, int,
 tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed, bool);
 
 /* Add a field of given name and type to a UNION_TYPE or RECORD_TYPE.  */
-tree gfc_add_field_to_struct (tree *, tree, tree, tree);
+tree gfc_add_field_to_struct (tree *, tree, tree, tree, tree **);
 
 /* Layout and output debugging info for a type.  */
 void gfc_finish_type (tree);