git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/23815 (Add -byteswapio flag) 

2005-12-10  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 (gfc_trans_open):  Add convert.
	(gfc_trans_inquire):  Likewise.
	* ioparm.def:  Add convert to open and inquire.
	* gfortran.texi:  Document CONVERT.

2005-12-10  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):  Remove unused attribute
	from arguments.
	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 enum unit_convert.
	Add convert to st_parameter_open and st_parameter_inquire.
	Define IOPARM_OPEN_HAS_CONVERT and IOPARM_INQUIRE_HAS_CONVERT.
	Increase padding for st_parameter_dt.
	Declare reverse_memcpy().

2005-12-10  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.
	* gfortran.dg/unf_io_convert_3.f90:  New test.

From-SVN: r108358
This commit is contained in:
Thomas Koenig 2005-12-10 20:01:56 +00:00 committed by Thomas Koenig
parent 775fe6e36d
commit 181c9f4a9b
17 changed files with 465 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/fortran/ChangeLog
View File

@ -1,3 +1,21 @@
2005-12-10 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 (gfc_trans_open): Add convert.
(gfc_trans_inquire): Likewise.
* ioparm.def: Add convert to open and inquire.
* gfortran.texi: Document CONVERT.
2005-12-09 Roger Sayle <roger@eyesopen.com>
PR fortran/22527

10
gcc/fortran/dump-parse-tree.c
View File

@ -1148,6 +1148,11 @@ gfc_show_code_node (int level, gfc_code * c)
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_show_code_node (int level, gfc_code * c)
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);

4
gcc/fortran/gfortran.h
View File

@ -1309,7 +1309,7 @@ gfc_alloc;
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;
@ -1336,7 +1336,7 @@ typedef struct
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;

37
gcc/fortran/gfortran.texi
View File

@ -587,6 +587,7 @@ of extensions, and @option{-std=legacy} allows both without warning.
* Implicitly interconvert LOGICAL and INTEGER::
* Hollerith constants support::
* Cray pointers::
* CONVERT specifier::
@end menu
@node Old-style kind specifications
@ -930,6 +931,42 @@ pointees are passed as arguments, they are treated as ordinary
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 queried by using
@code{INQUIRE(CONVERT=ch)}. The values returned are
@code{'BIG_ENDIAN'} and @code{'LITTLE_ENDIAN'}.
@code{CONVERT} works between big- and little-endian for
@code{INTEGER} values of all supported kinds and for @code{REAL}
on IEEE sytems of kinds 4 and 8. Conversion between different
``extended double'' types on different architectures such as
m68k and x86_64, which gfortran
supports as @code{REAL(KIND=10)} will probably not work.
@c ---------------------------------------------------------------------
@include intrinsic.texi
@c ---------------------------------------------------------------------

15
gcc/fortran/io.c
View File

@ -78,6 +78,7 @@ static const io_tag
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 @@ resolve_tag (const io_tag * tag, gfc_expr * e)
&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;
@ -1104,6 +1111,9 @@ match_open_element (gfc_open * open)
if (m != MATCH_NO)
return m;
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;
@ -1133,6 +1143,7 @@ gfc_free_open (gfc_open * open)
gfc_free_expr (open->action);
gfc_free_expr (open->delim);
gfc_free_expr (open->pad);
gfc_free_expr (open->convert);
gfc_free (open);
}
@ -1158,6 +1169,7 @@ gfc_resolve_open (gfc_open * open)
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;
@ -2438,6 +2450,7 @@ gfc_free_inquire (gfc_inquire * inquire)
gfc_free_expr (inquire->delim);
gfc_free_expr (inquire->pad);
gfc_free_expr (inquire->iolength);
gfc_free_expr (inquire->convert);
gfc_free (inquire);
}
@ -2479,6 +2492,7 @@ match_inquire_element (gfc_inquire * inquire)
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;
}
@ -2632,6 +2646,7 @@ gfc_resolve_inquire (gfc_inquire * inquire)
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;

2
gcc/fortran/ioparm.def
View File

@ -25,6 +25,7 @@ IOPARM (open, position, 1 << 13, char1)
IOPARM (open, action, 1 << 14, char2)
IOPARM (open, delim, 1 << 15, char1)
IOPARM (open, pad, 1 << 16, char2)
IOPARM (open, convert, 1 << 17, char1)
IOPARM (close, common, 0, common)
IOPARM (close, status, 1 << 7, char1)
IOPARM (filepos, common, 0, common)
@ -51,6 +52,7 @@ IOPARM (inquire, unformatted, 1 << 25, char1)
IOPARM (inquire, read, 1 << 26, char2)
IOPARM (inquire, write, 1 << 27, char1)
IOPARM (inquire, readwrite, 1 << 28, char2)
IOPARM (inquire, convert, 1 << 29, char1)
#ifndef IOPARM_dt_list_format
#define IOPARM_dt_list_format (1 << 7)
#define IOPARM_dt_namelist_read_mode (1 << 8)

8
gcc/fortran/trans-io.c
View File

@ -791,6 +791,10 @@ gfc_trans_open (gfc_code * code)
if (p->err)
mask |= IOPARM_common_err;
if (p->convert)
mask |= set_string (&block, &post_block, var, IOPARM_open_convert,
p->convert);
set_parameter_const (&block, var, IOPARM_common_flags, mask);
tmp = gfc_build_addr_expr (NULL_TREE, var);
@ -1073,6 +1077,10 @@ gfc_trans_inquire (gfc_code * code)
if (p->err)
mask |= IOPARM_common_err;
if (p->convert)
mask |= set_string (&block, &post_block, var, IOPARM_inquire_convert,
p->convert);
set_parameter_const (&block, var, IOPARM_common_flags, mask);
tmp = gfc_build_addr_expr (NULL_TREE, var);

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
2005-12-10 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.
* gfortran.dg/unf_io_convert_3.f90: New test.
2005-12-10 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
PR testsuite/20772

95
gcc/testsuite/gfortran.dg/unf_io_convert_1.f90 Normal file
View File

@ -0,0 +1,95 @@
! { dg-do run }
! { dg-options "-pedantic" }
! 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

39
gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 Normal file
View File

@ -0,0 +1,39 @@
! { 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

19
gcc/testsuite/gfortran.dg/unf_io_convert_3.f90 Normal file
View File

@ -0,0 +1,19 @@
! { dg-do run}
! { dg-require-effective-target fortran_large_real }
program main
integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
real(kind=k) a,b,c
a = 1.1_k
open(10,convert="swap",form="unformatted") ! { dg-warning "Extension: CONVERT" }
write(10) a
backspace 10
read (10) b
close(10,status="delete")
if (a /= b) call abort
write (11) a
backspace 11
open (11,form="unformatted")
read (11) c
if (a .ne. c) call abort
close (11, status="delete")
end program main

27
libgfortran/ChangeLog
View File

@ -1,3 +1,30 @@
2005-12-10 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): Remove unused attribute
from arguments.
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 enum unit_convert.
Add convert to st_parameter_open and st_parameter_inquire.
Define IOPARM_OPEN_HAS_CONVERT and IOPARM_INQUIRE_HAS_CONVERT.
Increase padding for st_parameter_dt.
Declare reverse_memcpy().
2005-12-09 Jakub Jelinek <jakub@redhat.com>
PR libfortran/24991

7
libgfortran/io/file_pos.c
View File

@ -114,7 +114,12 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
if (p == NULL)
goto io_error;
memcpy (&m, p, sizeof (gfc_offset));
/* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
if (u->flags.convert == CONVERT_NATIVE)
memcpy (&m, p, sizeof (gfc_offset));
else
reverse_memcpy (&m, p, sizeof (gfc_offset));
new = file_position (u->s) - m - 2*length;
if (sseek (u->s, new) == FAILURE)
goto io_error;

23
libgfortran/io/inquire.c
View File

@ -283,6 +283,29 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
cf_strcpy (iqp->pad, iqp->pad_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0)
{
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 (&iqp->common, "inquire_via_unit(): Bad convert");
}
cf_strcpy (iqp->convert, iqp->convert_len, p);
}
}

14
libgfortran/io/io.h
View File

@ -206,6 +206,10 @@ typedef enum
{READING, WRITING}
unit_mode;
typedef enum
{ CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
unit_convert;
#define CHARACTER1(name) \
char * name; \
gfc_charlen_type name ## _len
@ -247,6 +251,7 @@ st_parameter_common;
#define IOPARM_OPEN_HAS_ACTION (1 << 14)
#define IOPARM_OPEN_HAS_DELIM (1 << 15)
#define IOPARM_OPEN_HAS_PAD (1 << 16)
#define IOPARM_OPEN_HAS_CONVERT (1 << 17)
typedef struct
{
@ -261,6 +266,7 @@ typedef struct
CHARACTER2 (action);
CHARACTER1 (delim);
CHARACTER2 (pad);
CHARACTER1 (convert);
}
st_parameter_open;
@ -301,6 +307,7 @@ st_parameter_filepos;
#define IOPARM_INQUIRE_HAS_READ (1 << 26)
#define IOPARM_INQUIRE_HAS_WRITE (1 << 27)
#define IOPARM_INQUIRE_HAS_READWRITE (1 << 28)
#define IOPARM_INQUIRE_HAS_CONVERT (1 << 29)
typedef struct
{
@ -323,6 +330,7 @@ typedef struct
CHARACTER2 (read);
CHARACTER1 (write);
CHARACTER2 (readwrite);
CHARACTER1 (convert);
}
st_parameter_inquire;
@ -419,7 +427,7 @@ typedef struct st_parameter_dt
kind. */
char value[32];
} p;
char pad[16 * sizeof (char *) + 32 * sizeof (int)];
char pad[16 * sizeof (char *) + 34 * sizeof (int)];
} u;
}
st_parameter_dt;
@ -438,6 +446,7 @@ typedef struct
unit_position position;
unit_status status;
unit_pad pad;
unit_convert convert;
}
unit_flags;
@ -738,6 +747,9 @@ internal_proto(init_loop_spec);
extern void next_record (st_parameter_dt *, 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);

38
libgfortran/io/open.c
View File

@ -98,6 +98,14 @@ static const st_option pad_opt[] =
{ 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.
@ -531,6 +539,36 @@ st_open (st_parameter_open *opp)
find_option (&opp->common, opp->status, opp->status_len,
status_opt, "Bad STATUS parameter in OPEN statement");
if (cf & IOPARM_OPEN_HAS_CONVERT)
{
unit_convert conv;
conv = find_option (&opp->common, opp->convert, opp->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 (&opp->common, "Illegal value for CONVERT");
break;
}
flags.convert = conv;
}
else
flags.convert = CONVERT_NATIVE;
if (opp->common.unit < 0)
generate_error (&opp->common, ERROR_BAD_OPTION,
"Bad unit number in OPEN statement");

118
libgfortran/io/transfer.c
View File

@ -399,26 +399,89 @@ write_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
/* Master function for unformatted reads. */
static void
unformatted_read (st_parameter_dt *dtp, bt type __attribute__((unused)),
void *dest, int kind __attribute__((unused)),
unformatted_read (st_parameter_dt *dtp, bt type,
void *dest, int kind,
size_t size, size_t nelems)
{
size *= nelems;
read_block_direct (dtp, dest, &size);
/* Currently, character implies size=1. */
if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE
|| size == 1 || type == BT_CHARACTER)
{
size *= nelems;
read_block_direct (dtp, dest, &size);
}
else
{
char buffer[16];
char *p;
size_t i, sz;
/* Break up complex into its constituent reals. */
if (type == BT_COMPLEX)
{
nelems *= 2;
size /= 2;
}
p = dest;
/* By now, all complex variables have been split into their
constituent reals. For types with padding, we only need to
read kind bytes. We don't care about the contents
of the padding. */
sz = kind;
for (i=0; i<nelems; i++)
{
read_block_direct (dtp, buffer, &sz);
reverse_memcpy (p, buffer, sz);
p += size;
}
}
}
/* Master function for unformatted writes. */
static void
unformatted_write (st_parameter_dt *dtp, bt type __attribute__((unused)),
void *source, int kind __attribute__((unused)),
unformatted_write (st_parameter_dt *dtp, bt type,
void *source, int kind,
size_t size, size_t nelems)
{
size *= nelems;
if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE ||
size == 1 || type == BT_CHARACTER)
{
size *= nelems;
write_block_direct (dtp, source, &size);
write_block_direct (dtp, source, &size);
}
else
{
char buffer[16];
char *p;
size_t i, sz;
/* Break up complex into its constituent reals. */
if (type == BT_COMPLEX)
{
nelems *= 2;
size /= 2;
}
p = source;
/* By now, all complex variables have been split into their
constituent reals. For types with padding, we only need to
read kind bytes. We don't care about the contents
of the padding. */
sz = kind;
for (i=0; i<nelems; i++)
{
reverse_memcpy(buffer, p, size);
p+= size;
write_block_direct (dtp, buffer, &sz);
}
}
}
@ -1154,7 +1217,12 @@ us_read (st_parameter_dt *dtp)
return;
}
memcpy (&i, p, sizeof (gfc_offset));
/* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
memcpy (&i, p, sizeof (gfc_offset));
else
reverse_memcpy (&i, p, sizeof (gfc_offset));
dtp->u.p.current_unit->bytes_left = i;
}
@ -1722,7 +1790,12 @@ next_record_w (st_parameter_dt *dtp)
if (p == NULL)
goto io_error;
memcpy (p, &m, sizeof (gfc_offset));
/* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
memcpy (p, &m, sizeof (gfc_offset));
else
reverse_memcpy (p, &m, sizeof (gfc_offset));
if (sfree (dtp->u.p.current_unit->s) == FAILURE)
goto io_error;
@ -1733,7 +1806,12 @@ next_record_w (st_parameter_dt *dtp)
if (p == NULL)
generate_error (&dtp->common, ERROR_OS, NULL);
memcpy (p, &m, sizeof (gfc_offset));
/* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
memcpy (p, &m, sizeof (gfc_offset));
else
reverse_memcpy (p, &m, sizeof (gfc_offset));
if (sfree (dtp->u.p.current_unit->s) == FAILURE)
goto io_error;
@ -2161,3 +2239,19 @@ st_set_nml_var_dim (st_parameter_dt *dtp, GFC_INTEGER_4 n_dim,
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 ascending order - this is likely faster
on modern architectures because of write combining. */
for (i=0; i<n; i++)
*(d++) = *(s--);
}