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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@108358
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
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);
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);
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;
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;
* Implicitly interconvert LOGICAL and INTEGER::
* Hollerith constants support::
* Cray pointers::
+* CONVERT specifier::
@end menu
@node Old-style kind specifications
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 ---------------------------------------------------------------------
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};
&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;
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;
}
gfc_free_expr (open->action);
gfc_free_expr (open->delim);
gfc_free_expr (open->pad);
+ gfc_free_expr (open->convert);
gfc_free (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;
gfc_free_expr (inquire->delim);
gfc_free_expr (inquire->pad);
gfc_free_expr (inquire->iolength);
+ gfc_free_expr (inquire->convert);
gfc_free (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;
}
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;
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)
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)
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);
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);
+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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
+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
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;
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);
+ }
}
{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
#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
{
CHARACTER2 (action);
CHARACTER1 (delim);
CHARACTER2 (pad);
+ CHARACTER1 (convert);
}
st_parameter_open;
#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
{
CHARACTER2 (read);
CHARACTER1 (write);
CHARACTER2 (readwrite);
+ CHARACTER1 (convert);
}
st_parameter_inquire;
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;
unit_position position;
unit_status status;
unit_pad pad;
+ unit_convert convert;
}
unit_flags;
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);
{ 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.
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");
/* 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);
+ }
+ 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;
- write_block_direct (dtp, source, &size);
+ /* 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);
+ }
+ }
}
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;
}
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;
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;
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--);
+}
projects / platform / upstream / linaro-gcc.git / commitdiff