Re: Optimization of add_dt_to_dt_list() in resolve.c

[Andrew Benson <abenson@carnegiescience.edu>]

[-- Attachment #1: Type: text/plain, Size: 4140 bytes --]

On Thursday, May 31, 2018 10:56:47 AM PDT Janus Weil wrote:
> 2018-05-31 0:22 GMT+02:00 Andrew Benson <abenson@carnegiescience.edu>:
> >> -  for (dt = gfc_derived_types; dt; dt = dt->next)
> >> -    gfc_copy_dt_decls_ifequal (derived, dt->derived, false);
> >> -
> >> +  if (gfc_derived_types) {
> >> +    dt = gfc_derived_types;
> >> +    for (;;)
> >> +      {
> >> +    gfc_copy_dt_decls_ifequal (derived, dt, false);
> >> +    if (dt->dt_next == gfc_derived_types)
> >> +      break;
> >> +    dt = dt->dt_next;
> >> +      }
> >> +  }
> >> 
> >> Is there a particular reason why you changed the loop to "for (;;)" ?
> >> I find the old style a bit clearer and more compact. Also I think it's
> >> more common in gfortran.
> > 
> > I changed the original for loop since it wasn't possible (as far as I
> > could
> > see) to have an exit condition that worked now that list is circularly
> > linked (i.e. "dt" never becomes NULL, and testing for dt->dt_next ==
> > gfc_derived_types doesn't work as it would miss the final entry in the
> > list). So, I used for(;;) and added the exit condition explicitly into
> > the loop.
> > 
> > But, I agree, it's not very clear. An alternative would be something such
> > as:
> > 
> > -  for (dt = gfc_derived_types; dt; dt = dt->next)
> > -    gfc_copy_dt_decls_ifequal (derived, dt->derived, false);
> > -
> > +  for (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;
> > +    }
> > +
> > 
> > which is more compact, and has the advantage that if doesn't require an
> > "if
> > (gfc_derived_types)". Do you think that's a better approach?
> 
> Yes, definitely looks better to me. Note that there is another such
> case further up in gfc_get_derived_type. Actually I'd also move the
> declaration of dt ("gfc_symbol *dt") into the loops, in order to make
> it more local (it's not used outside).

Thanks - an updated patch is attached with those changes.

While staring at the patch again there's something about the following in 
trans-types.c that seems possibly wrong:

@@ -2599,16 +2598,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; 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;
+		}
 	    }
 	}
     }

In the original, the loop exits if "dt" becomes NULL (i.e. end of linked list 
found) or if "canonical" becomes non-null. I don't see any way for "canonical" 
to change within the loop though, so I suspect that the original should have 
been:

   for (; dt && !got_canonical; dt = dt->next)

i.e. tested "got_canonical" instead of "canonical". 

Currently my patch just removes the test of "canonical", and passes all tests 
cleanly. If I'm correct about this, the original, wrong test didn't cause any 
problems (since "canonical" is always NULL in this loop), but just means that 
there's no early exit from the loop once the canonical type is found.

If you agree with that I can add a "!got_canonical" test back in to my patch 
(I've already checked that it passes tests cleanly with that test in place).

> Btw, another thing that you'll need is a ChangeLog entry that lists
> every file and function touched by your patch and gives a short
> description of the modifications. You'll find plenty of examples for
> this in gcc/fortran/ChangeLog.

I've also attached a ChangeLog entry.

One other question: for copyright assignment, who do I need to talk to to get 
the relevant form(s)? 

Thanks,
Andrew
-- 

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

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

[-- Attachment #2: patch.diff --]
[-- Type: text/x-patch, Size: 8567 bytes --]

Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 260682)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -1611,6 +1611,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;
 
@@ -1712,19 +1715,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;
@@ -1809,7 +1802,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 260682)
+++ gcc/fortran/parse.c	(working copy)
@@ -6047,7 +6047,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 260682)
+++ gcc/fortran/resolve.c	(working copy)
@@ -2504,7 +2504,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.  */
@@ -13435,16 +13435,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 260682)
+++ 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;
@@ -3119,6 +3119,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;
@@ -3878,23 +3879,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
@@ -4080,7 +4064,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);
@@ -4343,7 +4327,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;
 
@@ -4350,13 +4334,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;
@@ -4762,11 +4749,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;
@@ -4874,7 +4866,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.  */
@@ -4936,18 +4927,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 260682)
+++ gcc/fortran/trans-types.c	(working copy)
@@ -2534,7 +2534,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;
@@ -2599,16 +2598,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; 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)
     {
@@ -2866,10 +2869,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;
 }
 

[-- Attachment #3: ChangeLog --]
[-- Type: text/x-changelog, Size: 808 bytes --]

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.