[PATCH] Thread-safe libgfortran (PRs fortran/14943 and fortran/21647)

[Jerry DeLisle]

Jakub Jelinek wrote:
> Hi!
> 
> This is a merge of the thread-safe libgfortran changes from gomp
> branch.  Some discussion about this happened already more than a month ago:
> http://gcc.gnu.org/ml/fortran/2005-10/msg00121.html
> http://gcc.gnu.org/ml/fortran/2005-10/msg00148.html
> It is just a dependency of GOMP, doesn't depend on it in any other way.
> Bootstrapped/regtested on x86_64-linux (and on the gomp branch
> it got tested on a bunch of other architectures as well), ok for trunk?
>

Handling of internal array IO has changed some.  We no longer have 
get_array_unit_length.  This has been replaced by init_loop_spec and 
next_array_record in transfer.c.  These new functions are used in next_record 
routines.  Also we changed nml_loop_spec to array_loop_spec in all of the 
namelist code.

Do you need some help with these?

gfc_offset
init_loop_spec (gfc_array_char *desc, array_loop_spec *ls)
{
   int rank = GFC_DESCRIPTOR_RANK(desc);
   int i;
   gfc_offset index;

   index = 1;
   for (i=0; i<rank; i++)
     {
       ls[i].idx = 1;
       ls[i].start = desc->dim[i].lbound;
       ls[i].end = desc->dim[i].ubound;
       ls[i].step = desc->dim[i].stride;

       index += (desc->dim[i].ubound - desc->dim[i].lbound)
                       * desc->dim[i].stride;
     }
   return index;
}

/* Determine the index to the next record in an internal unit array by
    by incrementing through the array_loop_spec.  TODO:  Implement handling
    negative strides. */

gfc_offset
next_array_record ( array_loop_spec * ls )
{
   int i, carry;
   gfc_offset index;

   carry = 1;
   index = 0;

   for (i = 0; i < current_unit->rank; i++)
     {
       if (carry)
         {
           ls[i].idx++;
           if (ls[i].idx > ls[i].end)
             {
               ls[i].idx = ls[i].start;
               carry = 1;
             }
           else
             carry = 0;
         }
       index = index + (ls[i].idx - 1) * ls[i].step;
     }
   return index;
}