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,41 @@ 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, which gfortran +supports as @code{REAL(KIND=10)} will probably not work. + @c --------------------------------------------------------------------- @include intrinsic.texi @c --------------------------------------------------------------------- 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; iflags.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; iflags.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 ascending order - this is likely faster + on modern architectures because of write combining. */ + for (i=0; iflags.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);