PR fortran/23815: Add byte-swapping to gfortran
Thomas Koenig
Thomas.Koenig@online.de
Sun Nov 13 23:19:00 GMT 2005
This adds byte swapping support for unformatted files for Fortran.
Currently, there is only one method of supplying the information
of which files to byte-swap, via a CONVERT keyword on an OPEN
statement. More are planned (and I am looking forward on some
input on how best to do this).
Regression-tested on i686-pc-linux-gnu. Documentation checked
with "make dvi".
OK for mainline?
Thomas
2005-11-13 Thomas Koenig <Thomas.Koenig@online.de>
PR fortran/23815
* io.c (top level): Add convert to io_tag.
(resolve_tag): convert is GFC_STD_GNU.
(match_open_element): Add convert.
(gfc_free_open): Likewise.
(gfc_resolve_open): Likewise.
(gfc_free_inquire): Likewise.
(match_inquire_element): Likewise.
* dump-parse-tree.c (gfc_show_code_node): Add
convet for open and inquire.
gfortran.h: Add convert to gfc_open and gfc_inquire.
* trans-io.c (top level): Add ioparm_convert and
ioparm_convert_len.
Add convert to ioparm structure.
(gfc_trans_open): Add convert.
(gfc_trans_inquire): Likewise.
* gfortran.texi: Document CONVERT.
2005-11-13 Thomas Koenig <Thomas.Koenig@online.de>
PR fortran/23815
* io/file_pos.c (unformatted_backspace): If flags.convert
does not equal CONVERT_NATIVE, reverse the record marker.
* io/open.c: Add convert_opt[].
(st_open): If no convert option is given, set CONVERT_NATIVE.
If CONVERT_BIG or CONVERT_LITTLE are given, set flags.convert to
CONVERT_NATIVE or CONVERT_SWAP (depending on wether we have
a big- or little-endian system).
* io/transfer.c (unformatted_read): If we need to reverse
bytes, break up large transfers into a loop. Split complex
numbers into its two parts.
(unformatted_write): Likewise.
(us_read): If flags.convert does not equal CONVERT_NATIVE,
reverse the record marker.
(next_record_w): Likewise.
(reverse_memcpy): New function.
* io/inquire.c (inquire_via_unit): Implement convert.
* io/io.h (top level): Add unit_convert.
Add convert to ioparm. Add convert to unit_flags.
Declare reverse_memcpy().
2005-11-13 Thomas Koenig <Thomas.Koenig@online.de>
PR fortran/23815
* gfortran.dg/unf_io_convert_1.f90: New test.
* gfortran.dg/unf_io_convert_2.f90: New test.
-------------- next part --------------
Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c (revision 106756)
+++ gcc/fortran/io.c (working copy)
@@ -78,6 +78,7 @@
tag_s_delim = {"DELIM", " delim = %v", BT_CHARACTER},
tag_s_pad = {"PAD", " pad = %v", BT_CHARACTER},
tag_iolength = {"IOLENGTH", " iolength = %v", BT_INTEGER},
+ tag_convert = {"CONVERT", " convert = %e", BT_CHARACTER},
tag_err = {"ERR", " err = %l", BT_UNKNOWN},
tag_end = {"END", " end = %l", BT_UNKNOWN},
tag_eor = {"EOR", " eor = %l", BT_UNKNOWN};
@@ -1051,6 +1052,12 @@
&e->where) == FAILURE)
return FAILURE;
}
+ if (tag == &tag_convert)
+ {
+ if (gfc_notify_std (GFC_STD_GNU, "Extension: CONVERT tag at %L",
+ &e->where) == FAILURE)
+ return FAILURE;
+ }
}
return SUCCESS;
@@ -1106,6 +1113,9 @@
m = match_ltag (&tag_err, &open->err);
if (m != MATCH_NO)
return m;
+ m = match_etag (&tag_convert, &open->convert);
+ if (m != MATCH_NO)
+ return m;
return MATCH_NO;
}
@@ -1133,6 +1143,7 @@
gfc_free_expr (open->action);
gfc_free_expr (open->delim);
gfc_free_expr (open->pad);
+ gfc_free_expr (open->convert);
gfc_free (open);
}
@@ -1157,6 +1168,7 @@
RESOLVE_TAG (&tag_e_action, open->action);
RESOLVE_TAG (&tag_e_delim, open->delim);
RESOLVE_TAG (&tag_e_pad, open->pad);
+ RESOLVE_TAG (&tag_convert, open->convert);
if (gfc_reference_st_label (open->err, ST_LABEL_TARGET) == FAILURE)
return FAILURE;
@@ -2435,6 +2447,7 @@
gfc_free_expr (inquire->delim);
gfc_free_expr (inquire->pad);
gfc_free_expr (inquire->iolength);
+ gfc_free_expr (inquire->convert);
gfc_free (inquire);
}
@@ -2476,6 +2489,7 @@
RETM m = match_vtag (&tag_s_delim, &inquire->delim);
RETM m = match_vtag (&tag_s_pad, &inquire->pad);
RETM m = match_vtag (&tag_iolength, &inquire->iolength);
+ RETM m = match_vtag (&tag_convert, &inquire->convert);
RETM return MATCH_NO;
}
@@ -2628,6 +2642,7 @@
RESOLVE_TAG (&tag_s_delim, inquire->delim);
RESOLVE_TAG (&tag_s_pad, inquire->pad);
RESOLVE_TAG (&tag_iolength, inquire->iolength);
+ RESOLVE_TAG (&tag_convert, inquire->convert);
if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)
return FAILURE;
Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi (revision 106756)
+++ gcc/fortran/gfortran.texi (working copy)
@@ -587,6 +587,7 @@
* Implicitly interconvert LOGICAL and INTEGER::
* Hollerith constants support::
* Cray pointers::
+* CONVERT specifier::
@end menu
@node Old-style kind specifications
@@ -930,6 +931,35 @@
variables in the invoked function. Subsequent changes to the pointer
will not change the base address of the array that was passed.
+@node CONVERT specifier
+@section CONVERT specifier
+@cindex CONVERT specifier
+
+gfortran allows the conversion of unformatted data between little-
+and big-endian representation to facilitate moving of data
+between different systems. The conversion is indicated with
+the @code{CONVERT} specifier on the @code{OPEN} statement.
+
+Valid values for @code{CONVERT} are:
+@itemize @w{}
+@item @code{CONVERT='NATIVE'} Use the native format. This is the default.
+@item @code{CONVERT='SWAP'} Swap between little- and big-endian.
+@item @code{CONVERT='LITTLE_ENDIAN'} Use the little-endian format
+ for unformatted files.
+@item @code{CONVERT='BIG_ENDIAN'} Use the big-endian format for
+ unformatted files.
+@end itemize
+
+Using the option could look like this:
+@smallexample
+ open(file='big.dat',form='unformatted',access='sequential', &
+ convert='big_endian')
+@end smallexample
+
+The value of the conversion can be queired by using
+@code{INQUIRE(CONVERT=ch)}. The values returned are
+@code{'BIG_ENDIAN'} and @code{'LITTLE_ENDIAN'}.
+
@c ---------------------------------------------------------------------
@include intrinsic.texi
@c ---------------------------------------------------------------------
@@ -942,10 +972,9 @@
@chapter Contributing
@cindex Contributing
-Free software is only possible if people contribute to efforts
-to create it.
-We're always in need of more people helping out with ideas
-and comments, writing documentation and contributing code.
+Free software is only possible if people contribute to efforts to create
+it. We're always in need of more people helping out with ideas and
+comments, writing documentation and contributing code.
If you want to contribute to GNU Fortran 95,
have a look at the long lists of projects you can take on.
Index: gcc/fortran/dump-parse-tree.c
===================================================================
--- gcc/fortran/dump-parse-tree.c (revision 106756)
+++ gcc/fortran/dump-parse-tree.c (working copy)
@@ -1148,6 +1148,11 @@
gfc_status (" PAD=");
gfc_show_expr (open->pad);
}
+ if (open->convert)
+ {
+ gfc_status (" CONVERT=");
+ gfc_show_expr (open->convert);
+ }
if (open->err != NULL)
gfc_status (" ERR=%d", open->err->value);
@@ -1349,6 +1354,11 @@
gfc_status (" PAD=");
gfc_show_expr (i->pad);
}
+ if (i->convert)
+ {
+ gfc_status (" CONVERT=");
+ gfc_show_expr (i->convert);
+ }
if (i->err != NULL)
gfc_status (" ERR=%d", i->err->value);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 106756)
+++ gcc/fortran/gfortran.h (working copy)
@@ -1300,7 +1300,7 @@
typedef struct
{
gfc_expr *unit, *file, *status, *access, *form, *recl,
- *blank, *position, *action, *delim, *pad, *iostat, *iomsg;
+ *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert;
gfc_st_label *err;
}
gfc_open;
@@ -1327,7 +1327,7 @@
gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
*name, *access, *sequential, *direct, *form, *formatted,
*unformatted, *recl, *nextrec, *blank, *position, *action, *read,
- *write, *readwrite, *delim, *pad, *iolength, *iomsg;
+ *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert;
gfc_st_label *err;
Index: gcc/fortran/trans-io.c
===================================================================
--- gcc/fortran/trans-io.c (revision 106756)
+++ gcc/fortran/trans-io.c (working copy)
@@ -101,6 +101,8 @@
static GTY(()) tree ioparm_namelist_read_mode;
static GTY(()) tree ioparm_iomsg;
static GTY(()) tree ioparm_iomsg_len;
+static GTY(()) tree ioparm_convert;
+static GTY(()) tree ioparm_convert_len;
/* The global I/O variables */
@@ -221,6 +223,7 @@
ADD_STRING (namelist_name);
ADD_FIELD (namelist_read_mode, gfc_int4_type_node);
ADD_STRING (iomsg);
+ ADD_STRING (convert);
gfc_finish_type (ioparm_type);
@@ -722,6 +725,10 @@
if (p->err)
set_flag (&block, ioparm_err);
+ if (p->convert)
+ set_string (&block, &post_block, ioparm_convert, ioparm_convert_len,
+ p->convert);
+
tmp = gfc_build_function_call (iocall_open, NULL_TREE);
gfc_add_expr_to_block (&block, tmp);
@@ -966,6 +973,10 @@
if (p->err)
set_flag (&block, ioparm_err);
+ if (p->convert)
+ set_string (&block, &post_block, ioparm_convert,
+ ioparm_convert_len, p->convert);
+
tmp = gfc_build_function_call (iocall_inquire, NULL);
gfc_add_expr_to_block (&block, tmp);
Index: libgfortran/io/file_pos.c
===================================================================
--- libgfortran/io/file_pos.c (revision 106756)
+++ libgfortran/io/file_pos.c (working copy)
@@ -114,7 +114,12 @@
if (p == NULL)
goto io_error;
- memcpy (&m, p, sizeof (gfc_offset));
+ /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
+ if (current_unit->flags.convert == CONVERT_NATIVE)
+ memcpy (&m, p, sizeof (gfc_offset));
+ else
+ reverse_memcpy (&m, p, sizeof (gfc_offset));
+
new = file_position (current_unit->s) - m - 2*length;
if (sseek (current_unit->s, new) == FAILURE)
goto io_error;
Index: libgfortran/io/open.c
===================================================================
--- libgfortran/io/open.c (revision 106756)
+++ libgfortran/io/open.c (working copy)
@@ -97,6 +97,14 @@
{ NULL, 0}
};
+static const st_option convert_opt[] =
+{
+ { "native", CONVERT_NATIVE},
+ { "swap", CONVERT_SWAP},
+ { "big_endian", CONVERT_BIG},
+ { "little_endian", CONVERT_LITTLE},
+ { NULL, 0}
+};
/* Given a unit, test to see if the file is positioned at the terminal
point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
@@ -478,6 +486,37 @@
find_option (ioparm.status, ioparm.status_len, status_opt,
"Bad STATUS parameter in OPEN statement");
+ if (ioparm.convert == NULL)
+ flags.convert = CONVERT_NATIVE;
+ else
+ {
+ unit_convert conv;
+ conv = find_option (ioparm.convert, ioparm.convert_len, convert_opt,
+ "Bad CONVERT parameter in OPEN statement");
+
+ /* We use l8_to_l4_offset, which is 0 on little-endian machines
+ and 1 on big-endian machines. */
+ switch (conv)
+ {
+ case CONVERT_NATIVE:
+ case CONVERT_SWAP:
+ break;
+
+ case CONVERT_BIG:
+ conv = l8_to_l4_offset ? CONVERT_NATIVE : CONVERT_SWAP;
+ break;
+
+ case CONVERT_LITTLE:
+ conv = l8_to_l4_offset ? CONVERT_SWAP : CONVERT_NATIVE;
+ break;
+
+ default:
+ internal_error ("Illegal value for CONVERT");
+ break;
+ }
+ flags.convert = conv;
+ }
+
if (ioparm.unit < 0)
generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement");
Index: libgfortran/io/transfer.c
===================================================================
--- libgfortran/io/transfer.c (revision 106756)
+++ libgfortran/io/transfer.c (working copy)
@@ -394,26 +394,74 @@
/* Master function for unformatted reads. */
static void
-unformatted_read (bt type __attribute__((unused)), void *dest,
+unformatted_read (bt type, void *dest,
int kind __attribute__((unused)),
size_t size, size_t nelems)
{
- size *= nelems;
+ /* Currently, character implies size=1. */
+ if (current_unit->flags.convert == CONVERT_NATIVE || size == 1
+ || type == BT_CHARACTER)
+ {
+ size *= nelems;
+ read_block_direct (dest, &size);
+ }
+ else
+ {
+ char buffer[16];
+ char *p;
+ size_t i, sz;
- read_block_direct (dest, &size);
+ if (type == BT_COMPLEX)
+ {
+ nelems *= 2;
+ size /= 2;
+ }
+ p = dest;
+ for (i=0; i<nelems; i++)
+ {
+ sz = size;
+ read_block_direct (buffer, &sz);
+ reverse_memcpy (p, buffer, size);
+ p += size;
+ }
+ }
}
/* Master function for unformatted writes. */
static void
-unformatted_write (bt type __attribute__((unused)), void *source,
+unformatted_write (bt type, void *source,
int kind __attribute__((unused)),
size_t size, size_t nelems)
{
- size *= nelems;
+ if (current_unit->flags.convert == CONVERT_NATIVE || size == 1
+ || type == BT_CHARACTER)
+ {
+ size *= nelems;
+ write_block_direct (source, &size);
+ }
+ else
+ {
+ char buffer[16];
+ char *p;
+ size_t i, sz;
- write_block_direct (source, &size);
+ if (type == BT_COMPLEX)
+ {
+ nelems *= 2;
+ size /= 2;
+ }
+
+ p = source;
+ for (i=0; i<nelems; i++)
+ {
+ reverse_memcpy(buffer, p, size);
+ p+= size;
+ sz = size;
+ write_block_direct (buffer, &sz);
+ }
+ }
}
@@ -1107,7 +1155,12 @@
return;
}
- memcpy (&i, p, sizeof (gfc_offset));
+ /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
+ if (current_unit->flags.convert == CONVERT_NATIVE)
+ memcpy (&i, p, sizeof (gfc_offset));
+ else
+ reverse_memcpy (&i, p, sizeof (gfc_offset));
+
current_unit->bytes_left = i;
}
@@ -1659,7 +1712,12 @@
if (p == NULL)
goto io_error;
- memcpy (p, &m, sizeof (gfc_offset));
+ /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
+ if (current_unit->flags.convert == CONVERT_NATIVE)
+ memcpy (p, &m, sizeof (gfc_offset));
+ else
+ reverse_memcpy (p, &m, sizeof (gfc_offset));
+
if (sfree (current_unit->s) == FAILURE)
goto io_error;
@@ -1670,7 +1728,11 @@
if (p == NULL)
generate_error (ERROR_OS, NULL);
- memcpy (p, &m, sizeof (gfc_offset));
+ if (current_unit->flags.convert == CONVERT_NATIVE)
+ memcpy (p, &m, sizeof (gfc_offset));
+ else
+ reverse_memcpy (p, &m, sizeof (gfc_offset));
+
if (sfree (current_unit->s) == FAILURE)
goto io_error;
@@ -2075,3 +2137,19 @@
nml->dim[n].lbound = (ssize_t)lbound;
nml->dim[n].ubound = (ssize_t)ubound;
}
+
+/* Reverse memcpy - used for byte swapping. */
+
+void reverse_memcpy (void *dest, const void *src, size_t n)
+{
+ char *d, *s;
+ size_t i;
+
+ d = (char *) dest;
+ s = (char *) src + n - 1;
+
+ /* Write with ascendig order - this is likely faster because
+ on modern architectures because of write combining. */
+ for (i=0; i<n; i++)
+ *(d++) = *(s--);
+}
Index: libgfortran/io/inquire.c
===================================================================
--- libgfortran/io/inquire.c (revision 106756)
+++ libgfortran/io/inquire.c (working copy)
@@ -286,6 +286,29 @@
cf_strcpy (ioparm.pad, ioparm.pad_len, p);
}
+
+ if (ioparm.convert != NULL)
+ {
+ if (u == NULL)
+ p = undefined;
+ else
+ switch (u->flags.convert)
+ {
+ /* l8_to_l4_offset is 0 for little-endian, 1 for big-endian. */
+ case CONVERT_NATIVE:
+ p = l8_to_l4_offset ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
+ break;
+
+ case CONVERT_SWAP:
+ p = l8_to_l4_offset ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
+ break;
+
+ default:
+ internal_error ("inquire_via_unit(): Bad convert");
+ }
+
+ cf_strcpy (ioparm.convert, ioparm.convert_len, p);
+ }
}
Index: libgfortran/io/io.h
===================================================================
--- libgfortran/io/io.h (revision 106756)
+++ libgfortran/io/io.h (working copy)
@@ -202,6 +202,10 @@
{READING, WRITING}
unit_mode;
+typedef enum
+{ CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
+unit_convert;
+
/* Statement parameters. These are all the things that can appear in
an I/O statement. Some are inputs and some are outputs, but none
are both. All of these values are initially zeroed and are zeroed
@@ -270,6 +274,7 @@
/* iomsg */
CHARACTER (iomsg);
+ CHARACTER (convert);
#undef CHARACTER
}
st_parameter;
@@ -291,6 +296,7 @@
unit_position position;
unit_status status;
unit_pad pad;
+ unit_convert convert;
}
unit_flags;
@@ -596,6 +602,9 @@
extern void next_record (int);
internal_proto(next_record);
+extern void reverse_memcpy (void *, const void *, size_t);
+internal_proto (reverse_memcpy);
+
/* read.c */
extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
-------------- next part --------------
! { dg-do run }
! This test verifies the most basic sequential unformatted I/O
! with convert="swap".
! Adapted from seq_io.f.
! write 3 records of various sizes
! then read them back
program main
implicit none
integer size
parameter(size=100)
logical debug
data debug /.FALSE./
! set debug to true for help in debugging failures.
integer m(2)
integer n
real*4 r(size)
integer i
character*4 str
m(1) = Z'11223344'
m(2) = Z'55667788'
n = Z'77AABBCC'
str = 'asdf'
do i = 1,size
r(i) = i
end do
open(9,form="unformatted",access="sequential",convert="swap") ! { dg-warning "Extension: CONVERT" }
write(9) m ! an array of 2
write(9) n ! an integer
write(9) r ! an array of reals
write(9)str ! String
! zero all the results so we can compare after they are read back
do i = 1,size
r(i) = 0
end do
m(1) = 0
m(2) = 0
n = 0
str = ' '
rewind(9)
read(9) m
read(9) n
read(9) r
read(9) str
!
! check results
if (m(1).ne.Z'11223344') then
if (debug) then
print '(A,Z8)','m(1) incorrect. m(1) = ',m(1)
else
call abort
endif
endif
if (m(2).ne.Z'55667788') then
if (debug) then
print '(A,Z8)','m(2) incorrect. m(2) = ',m(2)
else
call abort
endif
endif
if (n.ne.Z'77AABBCC') then
if (debug) then
print '(A,Z8)','n incorrect. n = ',n
else
call abort
endif
endif
do i = 1,size
if (int(r(i)).ne.i) then
if (debug) then
print*,'element ',i,' was ',r(i),' should be ',i
else
call abort
endif
endif
end do
if (str .ne. 'asdf') then
if (debug) then
print *,'str incorrect, str = ', str
else
call abort
endif
! use hexdump to look at the file "fort.9"
if (debug) then
close(9)
else
close(9,status='DELETE')
endif
end if
end program main
-------------- next part --------------
! { dg-do run }
program main
complex(kind=4) :: c
real(kind=4) :: a(2)
integer(kind=4) :: i(2)
integer(kind=1) :: b(8)
integer(kind=8) :: j
c = (3.14, 2.71)
open (10, form="unformatted",convert="swap") ! { dg-warning "Extension: CONVERT" }
write (10) c
rewind (10)
read (10) a
if (a(1) /= 3.14 .or. a(2) /= 2.71) call abort
close(10,status="delete")
open (10, form="unformatted",convert="big_endian") ! { dg-warning "Extension: CONVERT" }
i = (/ Z'11223344', Z'55667700' /)
write (10) i
rewind (10)
read (10) b
if (any(b /= (/ Z'11', Z'22', Z'33', Z'44', Z'55', Z'66', Z'77', Z'00' /))) &
call abort
backspace 10
read (10) j
if (j /= Z'1122334455667700') call abort
close (10, status="delete")
open (10, form="unformatted", convert="little_endian") ! { dg-warning "Extension: CONVERT" }
write (10) i
rewind (10)
read (10) b
if (any(b /= (/ Z'44', Z'33', Z'22', Z'11', Z'00', Z'77', Z'66', Z'55' /))) &
call abort
backspace 10
read (10) j
if (j /= Z'5566770011223344') call abort
end program main
More information about the Fortran
mailing list