[patch, fortran] Unformatted array IO performance improvement
Janne Blomqvist
jblomqvi@cc.hut.fi
Sun Sep 25 08:57:00 GMT 2005
:ADDPATCH fortran:
Ok, here is an updated patch that handles negative strides
correctly. Another change I made was to increment the g.item_count
counter for every call to one of the scalar transfer functions,
instead of updating it in transfer_array/transfer_real etc. This is
needed since the formatted transfer functions use item_count to signal
where an error occured.
ChangeLog, patch and a testcase attached.
--
Janne Blomqvist
-------------- next part --------------
gcc Changelog:
2005-09-24 Janne Blomqvist <jblomqvi@cc.hut.fi>
* trans-io.c (gfc_build_io_library_fndecls): Add entry
iocall_x_array for transfer_array. (transfer_array_desc): New
function. (gfc_trans_transfer): Add code to call
transfer_array_desc.
libgfortran Changelog:
2005-09-24 Janne Blomqvist <jblomqvi@cc.hut.fi>
* io.h: Changed prototypes of list_formatted_{read|write}.
* list_read.c (list_formatted_read): Renamed to
list_formatted_read_scalar and made static. (list_formatted_read):
New function.
* transfer.c: Prototype for transfer_array. Changed transfer
function pointer. (unformatted_read): Add nelems argument, use
it. (unformatted_write): Likewise. (formatted_transfer): Changed
name to formatted_transfer_scalar. (formatted_transfer): New
function. (transfer_integer): Add nelems argument to transfer
call, move updating item count to transfer
functions. (transfer_real): Likewise. (transfer_logical):
Likewise. (transfer_character): Likewise. (transfer_complex):
Likewise. (transfer_array): New function. (data_transfer_init):
Call formatted_transfer with new argument. (iolength_transfer):
New argument, use it.
* write.c (list_formatted_write): Renamed to
list_formatted_write_scalar, made static. (list_formatted_write):
New function.
-------------- next part --------------
Index: gcc/fortran/trans-io.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/trans-io.c,v
retrieving revision 1.42
diff -p -u -r1.42 trans-io.c
--- gcc/fortran/trans-io.c 14 Sep 2005 20:19:37 -0000 1.42
+++ gcc/fortran/trans-io.c 25 Sep 2005 08:27:14 -0000
@@ -120,6 +120,7 @@ static GTY(()) tree iocall_x_logical;
static GTY(()) tree iocall_x_character;
static GTY(()) tree iocall_x_real;
static GTY(()) tree iocall_x_complex;
+static GTY(()) tree iocall_x_array;
static GTY(()) tree iocall_open;
static GTY(()) tree iocall_close;
static GTY(()) tree iocall_inquire;
@@ -267,6 +268,11 @@ gfc_build_io_library_fndecls (void)
void_type_node, 2, pvoid_type_node,
gfc_int4_type_node);
+ iocall_x_array =
+ gfc_build_library_function_decl (get_identifier
+ (PREFIX("transfer_array")),
+ void_type_node, 1, pvoid_type_node);
+
/* Library entry points */
iocall_read =
@@ -1584,6 +1590,21 @@ transfer_expr (gfc_se * se, gfc_typespec
}
+/* Generate a call to pass an array descriptor to the IO library. The
+ array should be of one of the primitive types. */
+
+static void
+transfer_array_desc (gfc_se * se, tree addr_expr)
+{
+ tree args, tmp;
+
+ args = gfc_chainon_list (NULL_TREE, addr_expr);
+ tmp = gfc_build_function_call (iocall_x_array, args);
+ gfc_add_expr_to_block (&se->pre, tmp);
+ gfc_add_block_to_block (&se->pre, &se->post);
+}
+
+
/* gfc_trans_transfer()-- Translate a TRANSFER code node */
tree
@@ -1597,6 +1618,7 @@ gfc_trans_transfer (gfc_code * code)
tree tmp;
gfc_start_block (&block);
+ gfc_init_block (&body);
expr = code->expr;
ss = gfc_walk_expr (expr);
@@ -1604,8 +1626,11 @@ gfc_trans_transfer (gfc_code * code)
gfc_init_se (&se, NULL);
if (ss == gfc_ss_terminator)
- gfc_init_block (&body);
- else
+ {
+ gfc_conv_expr_reference (&se, expr);
+ transfer_expr (&se, &expr->ts, se.expr);
+ }
+ else if (expr->ts.type == BT_DERIVED)
{
/* Initialize the scalarizer. */
gfc_init_loopinfo (&loop);
@@ -1621,11 +1646,17 @@ gfc_trans_transfer (gfc_code * code)
gfc_copy_loopinfo_to_se (&se, &loop);
se.ss = ss;
- }
- gfc_conv_expr_reference (&se, expr);
-
- transfer_expr (&se, &expr->ts, se.expr);
+ gfc_conv_expr_reference (&se, expr);
+ transfer_expr (&se, &expr->ts, se.expr);
+ }
+ else
+ {
+ /* Pass the array descriptor to the library. */
+ gfc_conv_expr_descriptor (&se, expr, ss);
+ tmp = gfc_build_addr_expr (NULL, se.expr);
+ transfer_array_desc (&se, tmp);
+ }
gfc_add_block_to_block (&body, &se.pre);
gfc_add_block_to_block (&body, &se.post);
Index: libgfortran/io/io.h
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/io.h,v
retrieving revision 1.31
diff -p -u -r1.31 io.h
--- libgfortran/io/io.h 14 Sep 2005 20:18:17 -0000 1.31
+++ libgfortran/io/io.h 25 Sep 2005 08:27:39 -0000
@@ -613,7 +613,7 @@ internal_proto(read_decimal);
/* list_read.c */
-extern void list_formatted_read (bt, void *, int);
+extern void list_formatted_read (bt, void *, int, int);
internal_proto(list_formatted_read);
extern void finish_list_read (void);
@@ -666,7 +666,7 @@ internal_proto(write_x);
extern void write_z (fnode *, const char *, int);
internal_proto(write_z);
-extern void list_formatted_write (bt, void *, int);
+extern void list_formatted_write (bt, void *, int, int);
internal_proto(list_formatted_write);
/* error.c */
Index: libgfortran/io/list_read.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/list_read.c,v
retrieving revision 1.27
diff -p -u -r1.27 list_read.c
--- libgfortran/io/list_read.c 5 Sep 2005 21:13:39 -0000 1.27
+++ libgfortran/io/list_read.c 25 Sep 2005 08:27:40 -0000
@@ -1285,8 +1285,8 @@ check_type (bt type, int len)
reading, usually in the value[] array. If a repeat count is
greater than one, we copy the data item multiple times. */
-void
-list_formatted_read (bt type, void *p, int len)
+static void
+list_formatted_read_scalar (bt type, void *p, int len)
{
char c;
int m;
@@ -1405,6 +1405,29 @@ list_formatted_read (bt type, void *p, i
if (--repeat_count <= 0)
free_saved ();
}
+
+
+void
+list_formatted_read (bt type, void *p, int len, int nelems)
+{
+ int elem, size;
+ char *tmp;
+
+ tmp = (char *) p;
+
+ if (type == BT_COMPLEX)
+ size = 2 * len;
+ else
+ size = len;
+
+ /* Big loop over all the elements. */
+ for (elem = 0; elem < nelems; elem++)
+ {
+ g.item_count++;
+ list_formatted_read_scalar (type, tmp + size*elem, len);
+ }
+}
+
void
init_at_eol(void)
Index: libgfortran/io/transfer.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/transfer.c,v
retrieving revision 1.59
diff -p -u -r1.59 transfer.c
--- libgfortran/io/transfer.c 14 Sep 2005 20:18:18 -0000 1.59
+++ libgfortran/io/transfer.c 25 Sep 2005 08:27:41 -0000
@@ -78,6 +78,9 @@ export_proto(transfer_character);
extern void transfer_complex (void *, int);
export_proto(transfer_complex);
+extern void transfer_array (gfc_array_char *);
+export_proto(transfer_array);
+
gfc_unit *current_unit = NULL;
static int sf_seen_eor = 0;
static int eor_condition = 0;
@@ -101,7 +104,7 @@ static st_option advance_opt[] = {
};
-static void (*transfer) (bt, void *, int);
+static void (*transfer) (bt, void *, int, int);
typedef enum
@@ -312,7 +315,7 @@ write_block (int length)
/* Master function for unformatted reads. */
static void
-unformatted_read (bt type, void *dest, int length)
+unformatted_read (bt type, void *dest, int length, int nelems)
{
void *source;
int w;
@@ -323,6 +326,7 @@ unformatted_read (bt type, void *dest, i
if (type == BT_COMPLEX)
length *= 2;
+ length *= nelems;
w = length;
source = read_block (&w);
@@ -337,7 +341,7 @@ unformatted_read (bt type, void *dest, i
/* Master function for unformatted writes. */
static void
-unformatted_write (bt type, void *source, int length)
+unformatted_write (bt type, void *source, int length, int nelems)
{
void *dest;
@@ -345,6 +349,8 @@ unformatted_write (bt type, void *source
if (type == BT_COMPLEX)
length *= 2;
+ length *= nelems;
+
dest = write_block (length);
if (dest != NULL)
memcpy (dest, source, length);
@@ -442,7 +448,7 @@ require_type (bt expected, bt actual, fn
of the next element, then comes back here to process it. */
static void
-formatted_transfer (bt type, void *p, int len)
+formatted_transfer_scalar (bt type, void *p, int len)
{
int pos, bytes_used;
fnode *f;
@@ -837,6 +843,28 @@ formatted_transfer (bt type, void *p, in
unget_format (f);
}
+static void
+formatted_transfer (bt type, void *p, int len, int nelems)
+{
+ int elem, size;
+ char *tmp;
+
+ tmp = (char *) p;
+
+ if (type == BT_COMPLEX)
+ size = 2 * len;
+ else
+ size = len;
+
+ /* Big loop over all the elements. */
+ for (elem = 0; elem < nelems; elem++)
+ {
+ g.item_count++;
+ formatted_transfer_scalar (type, tmp + size*elem, len);
+ }
+}
+
+
/* Data transfer entry points. The type of the data entity is
implicit in the subroutine call. This prevents us from having to
@@ -845,50 +873,147 @@ formatted_transfer (bt type, void *p, in
void
transfer_integer (void *p, int kind)
{
- g.item_count++;
if (ioparm.library_return != LIBRARY_OK)
return;
- transfer (BT_INTEGER, p, kind);
+ transfer (BT_INTEGER, p, kind, 1);
}
void
transfer_real (void *p, int kind)
{
- g.item_count++;
if (ioparm.library_return != LIBRARY_OK)
return;
- transfer (BT_REAL, p, kind);
+ transfer (BT_REAL, p, kind, 1);
}
void
transfer_logical (void *p, int kind)
{
- g.item_count++;
if (ioparm.library_return != LIBRARY_OK)
return;
- transfer (BT_LOGICAL, p, kind);
+ transfer (BT_LOGICAL, p, kind, 1);
}
void
transfer_character (void *p, int len)
{
- g.item_count++;
if (ioparm.library_return != LIBRARY_OK)
return;
- transfer (BT_CHARACTER, p, len);
+ transfer (BT_CHARACTER, p, len, 1);
}
void
transfer_complex (void *p, int kind)
{
- g.item_count++;
if (ioparm.library_return != LIBRARY_OK)
return;
- transfer (BT_COMPLEX, p, kind);
+ transfer (BT_COMPLEX, p, kind, 1);
+}
+
+
+void
+transfer_array (gfc_array_char *desc)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ int n, kind;
+ char *data;
+ index_type rank, size, type, tsize;
+ bt iotype;
+
+ if (ioparm.library_return != LIBRARY_OK)
+ return;
+
+ type = GFC_DESCRIPTOR_TYPE (desc);
+ size = GFC_DESCRIPTOR_SIZE (desc);
+ kind = size;
+
+ /* FIXME: What a kludge: Array descriptors and the IO library use
+ different enums for types. */
+ switch (type)
+ {
+ case GFC_DTYPE_UNKNOWN:
+ iotype = BT_NULL; /* Is this correct? */
+ break;
+ case GFC_DTYPE_INTEGER:
+ iotype = BT_INTEGER;
+ break;
+ case GFC_DTYPE_LOGICAL:
+ iotype = BT_LOGICAL;
+ break;
+ case GFC_DTYPE_REAL:
+ iotype = BT_REAL;
+ break;
+ case GFC_DTYPE_COMPLEX:
+ iotype = BT_COMPLEX;
+ kind /= 2;
+ break;
+ case GFC_DTYPE_CHARACTER:
+ iotype = BT_CHARACTER;
+ break;
+ case GFC_DTYPE_DERIVED:
+ internal_error ("Derived type I/O should have been handled via the frontend.");
+ break;
+ default:
+ internal_error ("transfer_array(): Bad type");
+ }
+
+ if (desc->dim[0].stride == 0)
+ desc->dim[0].stride = 1;
+
+ rank = GFC_DESCRIPTOR_RANK (desc);
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ stride[n] = desc->dim[n].stride;
+ extent[n] = desc->dim[n].ubound + 1 - desc->dim[n].lbound;
+
+ /* If the extent of even one dimension is zero, then the entire
+ array section contains zero elements, so we return. */
+ if (extent[n] == 0)
+ return;
+ }
+
+ stride0 = stride[0];
+
+ /* If the innermost dimension has stride 1, we can do the transfer
+ in contiguous chunks. */
+ if (stride0 == 1)
+ tsize = extent[0];
+ else
+ tsize = 1;
+
+ data = GFC_DESCRIPTOR_DATA (desc);
+
+ while (data)
+ {
+ transfer (iotype, data, kind, tsize);
+ data += stride0 * size * tsize;
+ count[0] += tsize;
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ data -= stride[n] * extent[n] * size;
+ n++;
+ if (n == rank)
+ {
+ data = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ data += stride[n] * size;
+ }
+ }
+ }
}
@@ -1245,7 +1370,7 @@ data_transfer_init (int read_flag)
/* Start the data transfer if we are doing a formatted transfer. */
if (current_unit->flags.form == FORM_FORMATTED && !ioparm.list_format
&& ioparm.namelist_name == NULL && ionml == NULL)
- formatted_transfer (0, NULL, 0);
+ formatted_transfer (0, NULL, 0, 1);
}
@@ -1568,15 +1693,15 @@ finalize_transfer (void)
data transfer, it just updates the length counter. */
static void
-iolength_transfer (bt type , void *dest __attribute__ ((unused)),
- int len)
+iolength_transfer (bt type, void *dest __attribute__ ((unused)),
+ int len, int nelems)
{
if (ioparm.iolength != NULL)
{
if (type == BT_COMPLEX)
- *ioparm.iolength += 2*len;
+ *ioparm.iolength += 2 * len * nelems;
else
- *ioparm.iolength += len;
+ *ioparm.iolength += len * nelems;
}
}
Index: libgfortran/io/write.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/write.c,v
retrieving revision 1.47
diff -p -u -r1.47 write.c
--- libgfortran/io/write.c 7 Sep 2005 20:16:47 -0000 1.47
+++ libgfortran/io/write.c 25 Sep 2005 08:27:42 -0000
@@ -1423,8 +1423,8 @@ write_separator (void)
TODO: handle skipping to the next record correctly, particularly
with strings. */
-void
-list_formatted_write (bt type, void *p, int len)
+static void
+list_formatted_write_scalar (bt type, void *p, int len)
{
static int char_flag;
@@ -1466,6 +1466,28 @@ list_formatted_write (bt type, void *p,
}
char_flag = (type == BT_CHARACTER);
+}
+
+
+void
+list_formatted_write (bt type, void *p, int len, int nelems)
+{
+ int elem, size;
+ char *tmp;
+
+ tmp = (char *) p;
+
+ if (type == BT_COMPLEX)
+ size = 2 * len;
+ else
+ size = len;
+
+ /* Big loop over all the elements. */
+ for (elem = 0; elem < nelems; elem++)
+ {
+ g.item_count++;
+ list_formatted_write_scalar (type, tmp + size*elem, len);
+ }
}
/* NAMELIST OUTPUT
-------------- next part --------------
! { dg-do run }
! Checks that the array transfer functions work
! correctly for sections and strides.
program arrayio_6
implicit none
integer :: i, j, &
a(3, 3) = reshape ((/(i, i = 1, 9)/), (/3, 3/)), &
b(9)
open (10,FORM='unformatted',ACCESS='sequential',STATUS='scratch')
write (10) a
write (10) a(:,:)
write (10) a(::2, :)
write (10) a(:, 3:1:-1)
rewind (10)
b = 0
read (10) b
do i = 1, 9
if (b(i) /= i) call abort()
end do
b = 0
read (10) b
do i = 1, 9
if (b(i) /= i) call abort()
end do
b = 0
read (10) b
if (b(1) /= 1) call abort()
if (b(2) /= 3) call abort()
if (b(3) /= 4) call abort()
if (b(4) /= 6) call abort()
if (b(5) /= 7) call abort()
if (b(6) /= 9) call abort()
b = 0
read (10) b
close (10)
do i = 1, 3
if (b(i) /= i+6) call abort()
end do
do i = 4, 6
if (b(i) /= i) call abort()
end do
do i = 7, 9
if (b(i) /= i-6) call abort()
end do
end program arrayio_6
More information about the Gcc-patches
mailing list