: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)