Re: Optimization of add_dt_to_dt_list() in resolve.c

[Andrew Benson <abenson at carnegiescience dot edu>]

I now finally have heard back from the FSF, so my paperwork is all signed and 
recorded.

I've tested my patch on the latest trunk - slightly updated version which 
applies cleanly to trunk is attached (along with the ChangeLog). 

-Andrew 

On Thursday, June 14, 2018 5:10:24 PM PDT Steve Kargl wrote:
> Ping me when you hear back from FSF.  I'll apply your
> current patch on the weekend to my tree and do some
> testing.
> 
> > Steve,
> > 
> > I have just sent my copyright assignment documents back to the FSF, so I
> > think it should be ok to submit my patch as soon as it has approval.
> > 
> > -Andrew
> > 
> > On Monday, June 11, 2018 11:17:10 AM PDT Steve Kargl wrote:
> > > On Fri, Jun 01, 2018 at 08:14:04AM +0200, Janus Weil wrote:
> > > > 2018-05-31 20:04 GMT+02:00 Andrew Benson 
<abenson@carnegiescience.edu>:
> > > > > One other question: for copyright assignment, who do I need to
> > > > > talk to to get the relevant form(s)?
> > > > 
> > > > I think you need to send a request to assign@gnu.org and
> > > > gcc@gcc.gnu.org in order to get the copyright assignment form. After
> > > > the form is mailed to you, you sign it and send it back to the FSF.
> > > 
> > > Andrew, I see that you've asked on gcc@gcc on June 1 about
> > > Copyright forms.  Has anyone responded?
> > > 
> > > I ask because my patch for PR fortran/68544 walks the
> > > gfc_derived_types list.
> > > 
> > > https://gcc.gnu.org/ml/fortran/2018-06/msg00054.html
> > > 
> > > and Thomas has approved the patch.  In my patch, I
> > > have
> > > 
> > > +static bool
> > > +is_dt_name (const char *name)
> > > +{
> > > +  gfc_dt_list *dt_list;
> > > +
> > > +  for (dt_list = gfc_derived_types; dt_list; dt_list = dt_list->next)
> > > +    if (strcmp(dt_list->derived->name, name) == 0)
> > > +      return true;
> > > +  return false;
> > > +}
> > > 
> > > we'll need to update this to deal with your change for a
> > > circular linked list.


-- 

* Andrew Benson: http://users.obs.carnegiescience.edu/abenson/contact.html

* Galacticus: https://bitbucket.org/abensonca/galacticus

Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 262545)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -1614,6 +1614,9 @@ typedef struct gfc_symbol
 
   /* Link to corresponding association-list if this is an associate name.  */
   struct gfc_association_list *assoc;
+
+  /* Link to next entry in derived type list */
+  struct gfc_symbol *dt_next;
 }
 gfc_symbol;
 
@@ -1715,19 +1718,9 @@ typedef struct gfc_symtree
 }
 gfc_symtree;
 
-/* A linked list of derived types in the namespace.  */
-typedef struct gfc_dt_list
-{
-  struct gfc_symbol *derived;
-  struct gfc_dt_list *next;
-}
-gfc_dt_list;
+/* A list of all derived types.  */
+extern gfc_symbol *gfc_derived_types;
 
-#define gfc_get_dt_list() XCNEW (gfc_dt_list)
-
-  /* A list of all derived types.  */
-  extern gfc_dt_list *gfc_derived_types;
-
 typedef struct gfc_oacc_routine_name
 {
   struct gfc_symbol *sym;
@@ -1812,7 +1805,7 @@ typedef struct gfc_namespace
 
   gfc_charlen *cl_list;
 
-  gfc_dt_list *derived_types;
+  gfc_symbol *derived_types;
 
   int save_all, seen_save, seen_implicit_none;
 
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 262545)
+++ gcc/fortran/parse.c	(working copy)
@@ -6051,7 +6051,7 @@ add_global_program (void)
 static void
 resolve_all_program_units (gfc_namespace *gfc_global_ns_list)
 {
-  gfc_free_dt_list ();
+  gfc_derived_types = NULL;
   gfc_current_ns = gfc_global_ns_list;
   for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
     {
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 262545)
+++ gcc/fortran/resolve.c	(working copy)
@@ -2509,7 +2509,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *
       /* Resolve the gsymbol namespace if needed.  */
       if (!gsym->ns->resolved)
 	{
-	  gfc_dt_list *old_dt_list;
+	  gfc_symbol *old_dt_list;
 
 	  /* Stash away derived types so that the backend_decls do not
 	     get mixed up.  */
@@ -13474,16 +13474,21 @@ resolve_typebound_procedures (gfc_symbol* derived)
 static void
 add_dt_to_dt_list (gfc_symbol *derived)
 {
-  gfc_dt_list *dt_list;
 
-  for (dt_list = gfc_derived_types; dt_list; dt_list = dt_list->next)
-    if (derived == dt_list->derived)
-      return;
-
-  dt_list = gfc_get_dt_list ();
-  dt_list->next = gfc_derived_types;
-  dt_list->derived = derived;
-  gfc_derived_types = dt_list;
+  if (!derived->dt_next)
+    {
+      if (gfc_derived_types)
+	{
+	  derived->dt_next = gfc_derived_types->dt_next;
+	  gfc_derived_types->dt_next = derived;
+	}
+      else
+	{
+	  derived->dt_next = derived;
+	}
+      gfc_derived_types = derived;
+    }
+  
 }
 
 
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(revision 262545)
+++ gcc/fortran/symbol.c	(working copy)
@@ -107,7 +107,7 @@ gfc_namespace *gfc_global_ns_list;
 
 gfc_gsymbol *gfc_gsym_root = NULL;
 
-gfc_dt_list *gfc_derived_types;
+gfc_symbol *gfc_derived_types;
 
 static gfc_undo_change_set default_undo_chgset_var = { vNULL, vNULL, NULL };
 static gfc_undo_change_set *latest_undo_chgset = &default_undo_chgset_var;
@@ -3137,6 +3137,7 @@ gfc_new_symbol (const char *name, gfc_namespace *n
   p->common_block = NULL;
   p->f2k_derived = NULL;
   p->assoc = NULL;
+  p->dt_next = NULL;
   p->fn_result_spec = 0;
 
   return p;
@@ -3896,23 +3897,6 @@ free_sym_tree (gfc_symtree *sym_tree)
 }
 
 
-/* Free the derived type list.  */
-
-void
-gfc_free_dt_list (void)
-{
-  gfc_dt_list *dt, *n;
-
-  for (dt = gfc_derived_types; dt; dt = n)
-    {
-      n = dt->next;
-      free (dt);
-    }
-
-  gfc_derived_types = NULL;
-}
-
-
 /* Free the gfc_equiv_info's.  */
 
 static void
@@ -4098,7 +4082,7 @@ gfc_symbol_done_2 (void)
       gfc_free_namespace (gfc_current_ns);
       gfc_current_ns = NULL;
     }
-  gfc_free_dt_list ();
+  gfc_derived_types = NULL;
 
   enforce_single_undo_checkpoint ();
   free_undo_change_set_data (*latest_undo_chgset);
@@ -4361,7 +4345,7 @@ gfc_get_gsymbol (const char *name)
 static gfc_symbol *
 get_iso_c_binding_dt (int sym_id)
 {
-  gfc_dt_list *dt_list;
+  gfc_symbol *dt_list;
 
   dt_list = gfc_derived_types;
 
@@ -4368,13 +4352,16 @@ get_iso_c_binding_dt (int sym_id)
   /* Loop through the derived types in the name list, searching for
      the desired symbol from iso_c_binding.  Search the parent namespaces
      if necessary and requested to (parent_flag).  */
-  while (dt_list != NULL)
+  if (dt_list)
     {
-      if (dt_list->derived->from_intmod != INTMOD_NONE
-	  && dt_list->derived->intmod_sym_id == sym_id)
-        return dt_list->derived;
-
-      dt_list = dt_list->next;
+      while (dt_list->dt_next != gfc_derived_types)
+	{
+	  if (dt_list->from_intmod != INTMOD_NONE
+	      && dt_list->intmod_sym_id == sym_id)
+	    return dt_list;
+	
+	  dt_list = dt_list->dt_next;
+	}
     }
 
   return NULL;
@@ -4780,11 +4767,16 @@ generate_isocbinding_symbol (const char *mod_name,
       if (tmp_sym->attr.flavor == FL_DERIVED
 	  && !get_iso_c_binding_dt (tmp_sym->intmod_sym_id))
 	{
-	  gfc_dt_list *dt_list;
-	  dt_list = gfc_get_dt_list ();
-	  dt_list->derived = tmp_sym;
-	  dt_list->next = gfc_derived_types;
-  	  gfc_derived_types = dt_list;
+	  if (gfc_derived_types)
+	    {
+	      tmp_sym->dt_next = gfc_derived_types->dt_next;
+	      gfc_derived_types->dt_next = tmp_sym;
+	    }
+	  else
+	    {
+	      tmp_sym->dt_next = tmp_sym;
+	    }
+	  gfc_derived_types = tmp_sym;
         }
 
       return tmp_symtree;
@@ -4892,7 +4884,6 @@ generate_isocbinding_symbol (const char *mod_name,
       case ISOCBINDING_FUNPTR:
 	{
 	  gfc_symbol *dt_sym;
-	  gfc_dt_list **dt_list_ptr = NULL;
 	  gfc_component *tmp_comp = NULL;
 
 	  /* Generate real derived type.  */
@@ -4954,18 +4945,17 @@ generate_isocbinding_symbol (const char *mod_name,
 	  dt_sym->ts.u.derived = dt_sym;
 
 	  /* Add the symbol created for the derived type to the current ns.  */
-	  dt_list_ptr = &(gfc_derived_types);
-	  while (*dt_list_ptr != NULL && (*dt_list_ptr)->next != NULL)
-	    dt_list_ptr = &((*dt_list_ptr)->next);
-
-	  /* There is already at least one derived type in the list, so append
-	     the one we're currently building for c_ptr or c_funptr.  */
-	  if (*dt_list_ptr != NULL)
-	    dt_list_ptr = &((*dt_list_ptr)->next);
-	  (*dt_list_ptr) = gfc_get_dt_list ();
-	  (*dt_list_ptr)->derived = dt_sym;
-	  (*dt_list_ptr)->next = NULL;
-
+	  if (gfc_derived_types)
+	    {
+	      dt_sym->dt_next = gfc_derived_types->dt_next;
+	      gfc_derived_types->dt_next = dt_sym;
+	    }
+	  else
+	    {
+	      dt_sym->dt_next = dt_sym;
+	    }
+	  gfc_derived_types = dt_sym;
+      	  
 	  gfc_add_component (dt_sym, "c_address", &tmp_comp);
 	  if (tmp_comp == NULL)
 	    gcc_unreachable ();
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(revision 262545)
+++ gcc/fortran/trans-types.c	(working copy)
@@ -2542,7 +2542,6 @@ gfc_get_derived_type (gfc_symbol * derived, int co
   bool got_canonical = false;
   bool unlimited_entity = false;
   gfc_component *c;
-  gfc_dt_list *dt;
   gfc_namespace *ns;
   tree tmp;
   bool coarray_flag;
@@ -2607,16 +2606,20 @@ gfc_get_derived_type (gfc_symbol * derived, int co
 	   ns->translated && !got_canonical;
 	   ns = ns->sibling)
 	{
-	  dt = ns->derived_types;
-	  for (; dt && !canonical; dt = dt->next)
+	  if (ns->derived_types)
 	    {
-	      gfc_copy_dt_decls_ifequal (dt->derived, derived, true);
-	      if (derived->backend_decl)
-		got_canonical = true;
-	    }
-	}
+	      for (gfc_symbol *dt = ns->derived_types; dt && !got_canonical; dt = dt->dt_next)
+		{
+		  gfc_copy_dt_decls_ifequal (dt, derived, true);
+		  if (derived->backend_decl)
+		    got_canonical = true;
+		  if (dt->dt_next == ns->derived_types)
+		    break;
+		}
+ 	    }
+ 	}
     }
-
+  
   /* Store up the canonical type to be added to this one.  */
   if (got_canonical)
     {
@@ -2874,10 +2877,14 @@ copy_derived_types:
 	  TREE_NO_WARNING (c->caf_token) = 1;
 	}
     }
-
-  for (dt = gfc_derived_types; dt; dt = dt->next)
-    gfc_copy_dt_decls_ifequal (derived, dt->derived, false);
-
+  
+  for (gfc_symbol *dt = gfc_derived_types; dt; dt = dt->dt_next)
+    {
+      gfc_copy_dt_decls_ifequal (derived, dt, false);
+      if (dt->dt_next == gfc_derived_types)
+	break;
+    }
+  
   return derived->backend_decl;
 }
 

2018-05-31  Andrew Benson  <abenson@carnegiescience.edu>

	* gfortran.h: Add pointer to next derived type to
	gfc_symbol. Remove gfc_dt_list.
	* parse.c (resolve_all_program_units, resolve_global_procedure)
	(resolve_typebound_procedures): Replace gfc_free_dt_list() with
	simple nullification of gfc_derived_types. Change derived type
	linked list insertion to utilize dt_next pointers in gfc_symbol.
	* symbol.c (gfc_new_symbol, free_sym_tree, gfc_symbol_done2)
	(gfc_get_gsymbol, get_iso_c_binding_dt)
	(generate_isocbinding_symbol): Remove gfc_free_dt_list as
	gfc_dt_list is obsoleted. Change derived type linked list
	search/insertion to utilize dt_next pointers in gfc_symbol.
	* trans-types.c (gfc_get_derived_type): Change derived type linked
	list search to utilize dt_next pointers in gfc_symbol.