[patch, libfortran] PR31501 libgfortran internal unit I/O performance issues

[Jerry DeLisle]

Jerry DeLisle wrote:
> :ADDPATCH fortran:
> 
> This patch I would like to get into trunk so that it gets some exposure.
> 
> With the test case from the PR, I removed the external file I/O 
> statements so I could isolate on internal unit I/O.
> 
> With these changes, I see improved performance from about 9.6 seconds to 
> 7.2 seconds execution time.  That is fairly significant for this simple 
> patch.
> 
> Regression tested on x86-64-Gnu/Linux.  No new test cases.  I have 
> attached the test program I used to do final timing.
> 
> OK for trunk?
> 
> Regards,
> 
> Jerry
> 
> 2007-04-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
> 
>     PR libfortran/31501
>     * io/list_read.c (next_char): Fix whitespace.
>     * io/io.h: Remove prototypes and define macros for is_array_io,
>     is_stream_io, and is_internal_unit.
>     * io/unit.c (is_array_io), (is_internal_unit), (is_stream_io): Delete
>     these functions.
>     * io/transfer.c (read_sf): Change handling of internal_unit to make a
>     single call to salloc_r and use memcpy to transfer the data.
> 
> 
> ------------------------------------------------------------------------
> 
> Index: list_read.c
> ===================================================================
> *** list_read.c	(revision 124025)
> --- list_read.c	(working copy)
> *************** next_char (st_parameter_dt *dtp)
> *** 165,171 ****
>   
>     /* Handle the end-of-record and end-of-file conditions for
>        internal array unit.  */
> !   if (is_array_io(dtp))
>       {
>         if (dtp->u.p.at_eof)
>   	longjmp (*dtp->u.p.eof_jump, 1);
> --- 165,171 ----
>   
>     /* Handle the end-of-record and end-of-file conditions for
>        internal array unit.  */
> !   if (is_array_io (dtp))
>       {
>         if (dtp->u.p.at_eof)
>   	longjmp (*dtp->u.p.eof_jump, 1);
> *************** next_char (st_parameter_dt *dtp)
> *** 201,209 ****
>     if (is_stream_io (dtp))
>       dtp->u.p.current_unit->strm_pos++;
>   
> !   if (is_internal_unit(dtp))
>       {
> !       if (is_array_io(dtp))
>   	{
>   	  /* End of record is handled in the next pass through, above.  The
>   	     check for NULL here is cautionary.  */
> --- 201,209 ----
>     if (is_stream_io (dtp))
>       dtp->u.p.current_unit->strm_pos++;
>   
> !   if (is_internal_unit (dtp))
>       {
> !       if (is_array_io (dtp))
>   	{
>   	  /* End of record is handled in the next pass through, above.  The
>   	     check for NULL here is cautionary.  */
> Index: io.h
> ===================================================================
> *** io.h	(revision 124025)
> --- io.h	(working copy)
> *************** stream;
> *** 80,85 ****
> --- 80,93 ----
>   
>   #define sset(s, c, n) ((s)->set)(s, c, n)
>   
> + /* Macros for testing what kinds of I/O we are doing.  */
> + 
> + #define is_array_io(dtp) ((dtp)->internal_unit_desc)
> + 
> + #define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal)
> + 
> + #define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM)
> + 
>   /* The array_loop_spec contains the variables for the loops over index ranges
>      that are encountered.  Since the variables can be negative, ssize_t
>      is used.  */
> *************** internal_proto(get_internal_unit);
> *** 672,686 ****
>   extern void free_internal_unit (st_parameter_dt *);
>   internal_proto(free_internal_unit);
>   
> - extern int is_internal_unit (st_parameter_dt *);
> - internal_proto(is_internal_unit);
> - 
> - extern int is_array_io (st_parameter_dt *);
> - internal_proto(is_array_io);
> - 
> - extern int is_stream_io (st_parameter_dt *);
> - internal_proto(is_stream_io);
> - 
>   extern gfc_unit *find_unit (int);
>   internal_proto(find_unit);
>   
> --- 680,685 ----
> Index: unit.c
> ===================================================================
> *** unit.c	(revision 124025)
> --- unit.c	(working copy)
> *************** get_unit (st_parameter_dt *dtp, int do_c
> *** 476,508 ****
>   }
>   
>   
> - /* is_internal_unit()-- Determine if the current unit is internal or not */
> - 
> - int
> - is_internal_unit (st_parameter_dt *dtp)
> - {
> -   return dtp->u.p.unit_is_internal;
> - }
> - 
> - 
> - /* is_array_io ()-- Determine if the I/O is to/from an array */
> - 
> - int
> - is_array_io (st_parameter_dt *dtp)
> - {
> -   return dtp->internal_unit_desc != NULL;
> - }
> - 
> - 
> - /* is_stream_io () -- Determine if I/O is access="stream" mode */
> - 
> - int
> - is_stream_io (st_parameter_dt *dtp)
> - {
> -   return dtp->u.p.current_unit->flags.access == ACCESS_STREAM;
> - }
> - 
> - 
>   /*************************/
>   /* Initialize everything */
>   
> --- 476,481 ----
> Index: transfer.c
> ===================================================================
> *** transfer.c	(revision 124025)
> --- transfer.c	(working copy)
> *************** read_sf (st_parameter_dt *dtp, int *leng
> *** 164,181 ****
>         return base;
>       }
>   
>     readlen = 1;
>     n = 0;
>   
>     do
>       {
> -       if (is_internal_unit (dtp))
> - 	{
> - 	  /* readlen may be modified inside salloc_r if
> - 	     is_internal_unit (dtp) is true.  */
> - 	  readlen = 1;
> - 	}
> - 
>         q = salloc_r (dtp->u.p.current_unit->s, &readlen);
>         if (q == NULL)
>   	break;
> --- 164,182 ----
>         return base;
>       }
>   
> +   if (is_internal_unit (dtp))
> +     {
> +       readlen = *length;
> +       q = salloc_r (dtp->u.p.current_unit->s, &readlen);
> +       memcpy (p, q, readlen);
> +       goto done;
> +     }
> + 
>     readlen = 1;
>     n = 0;
>   
>     do
>       {
>         q = salloc_r (dtp->u.p.current_unit->s, &readlen);
>         if (q == NULL)
>   	break;
> *************** read_sf (st_parameter_dt *dtp, int *leng
> *** 244,249 ****
> --- 245,252 ----
>         dtp->u.p.sf_seen_eor = 0;
>       }
>     while (n < *length);
> + 
> +  done:
>     dtp->u.p.current_unit->bytes_left -= *length;
>   
>     if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
> 
> 

I plan to commit this shortly under the obvious and simple rule.  I then have 
some additional updates for performance I will post, mostly boosting code out of 
inner loops.

Jerry