From 181c9f4a9ba6b2d64c7c0b56b777ad366e05a9c1 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sat, 10 Dec 2005 20:01:56 +0000 Subject: re PR fortran/23815 (Add -byteswapio flag) 2005-12-10 Thomas Koenig 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 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 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 --- libgfortran/io/file_pos.c | 7 ++- libgfortran/io/inquire.c | 23 +++++++++ libgfortran/io/io.h | 14 +++++- libgfortran/io/open.c | 38 +++++++++++++++ libgfortran/io/transfer.c | 118 +++++++++++++++++++++++++++++++++++++++++----- 5 files changed, 186 insertions(+), 14 deletions(-) (limited to 'libgfortran/io') diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c index 0049718..3d7dd9a 100644 --- a/libgfortran/io/file_pos.c +++ b/libgfortran/io/file_pos.c @@ -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; diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c index bccd5a1..9044bf8 100644 --- a/libgfortran/io/inquire.c +++ b/libgfortran/io/inquire.c @@ -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); + } } diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index e7b0ac1..e364171 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -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); diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index 7e42cc6..3dc2b11 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -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"); diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index b2d26ac..f3ca8df 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -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; iu.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; iu.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