g77: portable unformatted files
Emilio Silva
emilio@MIT.EDU
Wed Feb 18 07:33:00 GMT 2004
I would like to propose an extension to create (more) portable
unformatted files, as explained in
http://gcc.gnu.org/onlinedocs/g77/Portable-Unformatted-Files.html
"g77 has no facility for exchanging unformatted files with systems
using different number formats--even differing only in endianness (byte
order)--or written by other compilers. Some compilers provide
facilities at least for doing byte-swapping during unformatted I/O."
One of such compilers is HP Visual FORTRAN, which defines an additional
keyword "CONVERT" for the OPEN statement, as documented at
http://h18009.www1.hp.com/fortran/docs/lrm/lrm0484.htm
In summary, you can open a file with
OPEN(90,form='unformatted',convert='BIG_ENDIAN')
and the resulting file will be written to and read from in big-endian
form.
I have a working patch to implement the CONVERT keyword with
BIG_ENDIAN, LITTLE_ENDIAN and NATIVE options. This required changes in
the front-end and in libg2c. I created two testcases for the change
(although only for "OPEN", not "INQUIRE"), and the tests pass on a big
endian (powerpc-apple-darwin) and on a little endian (i686-pc-cygwin)
machine. I also verified that files written by one machine can indeed
be read on the other machine.
It's a big patch and, among other ugly things like allocating memory
when writing, it will make f_open and f_inqu incompatible with older
versions of libg2c. Please advise.
Emilio.
gcc/gcc/f/ChangeLog
2004-02-17 Emilio Silva <emilio@mit.edu>
* com-rt.def: Added do_uioc (see gcc/libf2c/libI77/uic.o),
does unformatted io with possible endianness conversion.
* stb.c (ffestb_R9044_): Added a CONVERT keyword to the OPEN
statement.
(ffestb_R9234_): Added BIG_ENDIAN, CONVERT, LITTLE_ENDIAN and
NATIVE keywords to the INQUIRE statement.
* ste.c (ffeste_io_inlist_): Added CONVERT=, NATIVE=,
BIG_ENDIAN= and LITTLE_ENDIAN= arguments to the INQUIRE keyword.
(ffeste_io_olist_): Added CONVERT='x' to the argument list of
OPEN.
(ffeste_io_douio_): Call do_uioc rather than do_uio when the
data being read or written may need endianness conversion.
(ffeste_R904): Added CONVERT to the argument list of OPEN.
(ffeste_R923A): Added CONVERT, NATIVE, BIG_ENDIAN and LITTLE_ENDIAN
to the argument list of INQUIRE.
* stp.h (_ffestp_inquireix_): Added values for the new INQUIRE
keywords.
(_ffestp_openix_): Added values for the new OPEN keywords.
* str-io.fin: Added new keywords.
* str-nq.fin: Same.
* str-op.fin: Same.
* g2c.hin (olist): Added the CONVERT argument to the OPEN argument
list.
(inlist): Added CONVERT, NATIVE, BIG_ENDIAN and LITTLE_ENDIAN
arguments to the INQUIRE argument list.
gcc/libf2cf/libI77/ChangeLog
2004-02-17 Emilio Silva <emilio@mit.edu>
* backspace.c (f_back): Possible endianness conversion when reading
the record length.
* due.c (c_due): Initialize the f__converting flag if the file was
opened with a CONVERT option.
* err.c: Created flags f__converting (file is being converted from
big to little endian or vice/versa) and f__hostbigendian (set if
the host is big-endian).
(F_err): Created a new error message for when malloc fails during
endianness conversion.
(f__fatal): Add "converted" or "native" to the fatal i/o error
message.
(f__init): Added host endianness check.
* fio.h: Added new flags f__converting and f__hostbigendian.
(unit): Added a uconv member, set to 1 or 2 if this unit is being
converted.
(swapbytes): Prototype of a new function.
* inquire.c (f_inqu): Report the CONVERT, NATIVE, BIG_ENDIAN and
LITTLE_ENDIAN conversion status of a unit.
* open.c (f_open): Set uconv to the appropriate value when a
CONVERT keyword is specified.
(fk_open): Set uconv when opening a file implicitly.
* sue.c (c_sue): Set f__converting if necessary.
(s_rsue): Convert the record length read from the file, if
necessary.
(e_wsue): Write a converted record length, if necessary.
* uio.c (do_uioc): New function, i/o from/to an unformatted file
with possible endianness.
* util.c (swapbytes): New function, swaps bytes from an i/o record
for endianness conversion.
Index: gcc/gcc/f/com-rt.def
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/f/com-rt.def,v
retrieving revision 1.15
diff -c -3 -p -r1.15 com-rt.def
*** gcc/gcc/f/com-rt.def 31 May 2003 02:44:34 -0000 1.15
--- gcc/gcc/f/com-rt.def 18 Feb 2004 06:00:31 -0000
*************** DEFGFRT (FFECOM_gfrtSWSNE, "s_wsne", FFE
*** 106,111 ****
--- 106,112 ----
DEFGFRT (FFECOM_gfrtDOFIO, "do_fio", FFECOM_rttypeINTEGER_, 0, FALSE,
FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDOLIO, "do_lio", FFECOM_rttypeINTEGER_, 0, FALSE,
FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDOUIO, "do_uio", FFECOM_rttypeINTEGER_, 0, FALSE,
FALSE, FALSE)
+ DEFGFRT (FFECOM_gfrtDOUIOC, "do_uioc", FFECOM_rttypeINTEGER_, 0,
FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFOPEN, "f_open", FFECOM_rttypeINTEGER_, 0, FALSE,
FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFCLOS, "f_clos", FFECOM_rttypeINTEGER_, 0, FALSE,
FALSE, FALSE)
Index: gcc/gcc/f/stb.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/f/stb.c,v
retrieving revision 1.17
diff -c -3 -p -r1.17 stb.c
*** gcc/gcc/f/stb.c 6 Jul 2003 20:32:16 -0000 1.17
--- gcc/gcc/f/stb.c 18 Feb 2004 06:01:34 -0000
*************** ffestb_R9044_ (ffelexToken t)
*** 10462,10467 ****
--- 10462,10473 ----
ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
break;
+ case FFESTR_openCONVERT:
+ ffestb_local_.open.ix = FFESTP_openixCONVERT;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
case FFESTR_openDEFAULTFILE:
ffestb_local_.open.ix = FFESTP_openixDEFAULTFILE;
ffestb_local_.open.left = FALSE;
*************** ffestb_R9234_ (ffelexToken t)
*** 12945,12950 ****
--- 12951,12962 ----
ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
break;
+ case FFESTR_inquireBIG_ENDIAN:
+ ffestb_local_.inquire.ix = FFESTP_inquireixBIG_ENDIAN;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
case FFESTR_inquireBLANK:
ffestb_local_.inquire.ix = FFESTP_inquireixBLANK;
ffestb_local_.inquire.left = TRUE;
*************** ffestb_R9234_ (ffelexToken t)
*** 12957,12962 ****
--- 12969,12980 ----
ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
break;
+ case FFESTR_inquireCONVERT:
+ ffestb_local_.inquire.ix = FFESTP_inquireixCONVERT;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
case FFESTR_inquireDEFAULTFILE:
ffestb_local_.inquire.ix = FFESTP_inquireixDEFAULTFILE;
ffestb_local_.inquire.left = FALSE;
*************** ffestb_R9234_ (ffelexToken t)
*** 13024,13029 ****
--- 13042,13053 ----
ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
break;
+ case FFESTR_inquireLITTLE_ENDIAN:
+ ffestb_local_.inquire.ix = FFESTP_inquireixLITTLE_ENDIAN;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
case FFESTR_inquireNAME:
ffestb_local_.inquire.ix = FFESTP_inquireixNAME;
ffestb_local_.inquire.left = TRUE;
*************** ffestb_R9234_ (ffelexToken t)
*** 13034,13039 ****
--- 13058,13069 ----
ffestb_local_.inquire.ix = FFESTP_inquireixNAMED;
ffestb_local_.inquire.left = TRUE;
ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
+ break;
+
+ case FFESTR_inquireNATIVE:
+ ffestb_local_.inquire.ix = FFESTP_inquireixNATIVE;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
break;
case FFESTR_inquireNEXTREC:
Index: gcc/gcc/f/ste.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/f/ste.c,v
retrieving revision 1.42
diff -c -3 -p -r1.42 ste.c
*** gcc/gcc/f/ste.c 22 Sep 2003 05:09:30 -0000 1.42
--- gcc/gcc/f/ste.c 18 Feb 2004 06:01:50 -0000
*************** static tree ffeste_io_inlist_ (bool have
*** 128,141 ****
ffestpFile *unformatted_spec,
ffestpFile *recl_spec,
ffestpFile *nextrec_spec,
! ffestpFile *blank_spec);
static tree ffeste_io_olist_ (bool have_err, ffebld unit_expr,
ffestpFile *file_spec,
ffestpFile *stat_spec,
ffestpFile *access_spec,
ffestpFile *form_spec,
ffestpFile *recl_spec,
! ffestpFile *blank_spec);
static void ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt);
/* Internal macros. */
--- 128,146 ----
ffestpFile *unformatted_spec,
ffestpFile *recl_spec,
ffestpFile *nextrec_spec,
! ffestpFile *blank_spec,
! ffestpFile *convert_spec,
! ffestpFile *native_spec,
! ffestpFile *little_endian_spec,
! ffestpFile *big_endian_spec);
static tree ffeste_io_olist_ (bool have_err, ffebld unit_expr,
ffestpFile *file_spec,
ffestpFile *stat_spec,
ffestpFile *access_spec,
ffestpFile *form_spec,
ffestpFile *recl_spec,
! ffestpFile *blank_spec,
! ffestpFile *convert_spec);
static void ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt);
/* Internal macros. */
*************** ffeste_io_douio_ (ffebld expr)
*** 1141,1147 ****
TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, variable);
TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE,
size);
! return ffecom_call_gfrt (FFECOM_gfrtDOUIO, arglist, NULL_TREE);
}
/* Make arglist with ptr to BACKSPACE/ENDFILE/REWIND control list.
--- 1146,1156 ----
TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, variable);
TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE,
size);
! if (bt != FFEINFO_basictypeINTEGER && bt !=
FFEINFO_basictypeLOGICAL &&
! bt != FFEINFO_basictypeREAL)
! return ffecom_call_gfrt (FFECOM_gfrtDOUIO, arglist, NULL_TREE);
! else
! return ffecom_call_gfrt (FFECOM_gfrtDOUIOC, arglist, NULL_TREE);
}
/* Make arglist with ptr to BACKSPACE/ENDFILE/REWIND control list.
*************** ffeste_io_inlist_ (bool have_err,
*** 1858,1864 ****
ffestpFile *unformatted_spec,
ffestpFile *recl_spec,
ffestpFile *nextrec_spec,
! ffestpFile *blank_spec)
{
tree t;
tree ttype;
--- 1867,1877 ----
ffestpFile *unformatted_spec,
ffestpFile *recl_spec,
ffestpFile *nextrec_spec,
! ffestpFile *blank_spec,
! ffestpFile *convert_spec,
! ffestpFile *native_spec,
! ffestpFile *little_endian_spec,
! ffestpFile *big_endian_spec)
{
tree t;
tree ttype;
*************** ffeste_io_inlist_ (bool have_err,
*** 1869,1885 ****
openfield, numberfield, namedfield, namefield, namelenfield,
accessfield,
accesslenfield, sequentialfield, sequentiallenfield, directfield,
directlenfield,
formfield, formlenfield, formattedfield, formattedlenfield,
unformattedfield,
! unformattedlenfield, reclfield, nextrecfield, blankfield,
blanklenfield;
tree errinit, unitinit, fileinit, fileleninit, existinit, openinit,
numberinit,
namedinit, nameinit, nameleninit, accessinit, accessleninit,
sequentialinit,
sequentialleninit, directinit, directleninit, forminit,
formleninit,
formattedinit, formattedleninit, unformattedinit,
unformattedleninit,
! reclinit, nextrecinit, blankinit, blankleninit;
tree
unitexp, fileexp, filelenexp, existexp, openexp, numberexp,
namedexp,
nameexp, namelenexp, accessexp, accesslenexp, sequentialexp,
sequentiallenexp,
directexp, directlenexp, formexp, formlenexp, formattedexp,
formattedlenexp,
! unformattedexp, unformattedlenexp, reclexp, nextrecexp, blankexp,
blanklenexp;
static int mynumber = 0;
if (f2c_inquire_struct == NULL_TREE)
--- 1882,1904 ----
openfield, numberfield, namedfield, namefield, namelenfield,
accessfield,
accesslenfield, sequentialfield, sequentiallenfield, directfield,
directlenfield,
formfield, formlenfield, formattedfield, formattedlenfield,
unformattedfield,
! unformattedlenfield, reclfield, nextrecfield, blankfield,
blanklenfield,
!
convertfield,convertlenfield,nativefield,nativelenfield,little_endianfie
ld,
! little_endianlenfield,big_endianfield,big_endianlenfield;
tree errinit, unitinit, fileinit, fileleninit, existinit, openinit,
numberinit,
namedinit, nameinit, nameleninit, accessinit, accessleninit,
sequentialinit,
sequentialleninit, directinit, directleninit, forminit,
formleninit,
formattedinit, formattedleninit, unformattedinit,
unformattedleninit,
! reclinit, nextrecinit, blankinit, blankleninit, convertinit,
convertleninit,
!
nativeinit,nativeleninit,little_endianinit,little_endianleninit,big_endi
aninit,
! big_endianleninit;
tree
unitexp, fileexp, filelenexp, existexp, openexp, numberexp,
namedexp,
nameexp, namelenexp, accessexp, accesslenexp, sequentialexp,
sequentiallenexp,
directexp, directlenexp, formexp, formlenexp, formattedexp,
formattedlenexp,
! unformattedexp, unformattedlenexp, reclexp, nextrecexp, blankexp,
blanklenexp,
! convertexp,convertlenexp,nativeexp,nativelenexp,little_endianexp,
! little_endianlenexp,big_endianexp,big_endianlenexp;
static int mynumber = 0;
if (f2c_inquire_struct == NULL_TREE)
*************** ffeste_io_inlist_ (bool have_err,
*** 1944,1949 ****
--- 1963,1985 ----
string_type_node);
blanklenfield = ffecom_decl_field (ref, blankfield, "blanklen",
ffecom_f2c_ftnlen_type_node);
+ convertfield = ffecom_decl_field (ref, blanklenfield, "convert",
+ string_type_node);
+ convertlenfield = ffecom_decl_field (ref, convertfield,
"convertlen",
+ ffecom_f2c_ftnlen_type_node);
+ nativefield = ffecom_decl_field (ref, convertlenfield, "native",
+ string_type_node);
+ nativelenfield = ffecom_decl_field (ref, nativefield,
+ "nativelen",
+ ffecom_f2c_ftnlen_type_node);
+ little_endianfield = ffecom_decl_field (ref, nativelenfield,
"little_endian",
+ string_type_node);
+ little_endianlenfield = ffecom_decl_field (ref,
little_endianfield, "little_endianlen",
+ ffecom_f2c_ftnlen_type_node);
+ big_endianfield = ffecom_decl_field (ref,
little_endianlenfield, "big_endian",
+ string_type_node);
+ big_endianlenfield = ffecom_decl_field (ref, big_endianfield,
"big_endianlen",
+ ffecom_f2c_ftnlen_type_node);
TYPE_FIELDS (ref) = errfield;
layout_type (ref);
*************** ffeste_io_inlist_ (bool have_err,
*** 1980,1985 ****
--- 2016,2029 ----
ffeste_f2c_init_ptrtoint_ (nextrecexp, nextrecinit, nextrec_spec);
ffeste_f2c_init_char_ (blankexp, blankinit, blanklenexp,
blankleninit, blank_spec);
+ ffeste_f2c_init_char_ (convertexp, convertinit, convertlenexp,
+ convertleninit, convert_spec);
+ ffeste_f2c_init_char_ (nativeexp, nativeinit, nativelenexp,
+ nativeleninit, native_spec);
+ ffeste_f2c_init_char_ (little_endianexp, little_endianinit,
little_endianlenexp,
+ little_endianleninit, little_endian_spec);
+ ffeste_f2c_init_char_ (big_endianexp, big_endianinit,
big_endianlenexp,
+ big_endianleninit, big_endian_spec);
inits = build_tree_list ((field = TYPE_FIELDS (f2c_inquire_struct)),
errinit);
*************** ffeste_io_inlist_ (bool have_err,
*** 2009,2014 ****
--- 2053,2066 ----
ffeste_f2c_init_next_ (nextrecinit);
ffeste_f2c_init_next_ (blankinit);
ffeste_f2c_init_next_ (blankleninit);
+ ffeste_f2c_init_next_ (convertinit);
+ ffeste_f2c_init_next_ (convertleninit);
+ ffeste_f2c_init_next_ (nativeinit);
+ ffeste_f2c_init_next_ (nativeleninit);
+ ffeste_f2c_init_next_ (little_endianinit);
+ ffeste_f2c_init_next_ (little_endianleninit);
+ ffeste_f2c_init_next_ (big_endianinit);
+ ffeste_f2c_init_next_ (big_endianleninit);
inits = build_constructor (f2c_inquire_struct, inits);
TREE_CONSTANT (inits) = constantp ? 1 : 0;
*************** ffeste_io_inlist_ (bool have_err,
*** 2040,2045 ****
--- 2092,2101 ----
ffeste_f2c_prepare_ptrtoint_ (recl_spec, reclexp);
ffeste_f2c_prepare_ptrtoint_ (nextrec_spec, nextrecexp);
ffeste_f2c_prepare_char_ (blank_spec, blankexp);
+ ffeste_f2c_prepare_char_ (convert_spec, convertexp);
+ ffeste_f2c_prepare_char_ (native_spec, nativeexp);
+ ffeste_f2c_prepare_char_ (little_endian_spec, little_endianexp);
+ ffeste_f2c_prepare_char_ (big_endian_spec, big_endianexp);
ffecom_prepare_end ();
*************** ffeste_io_inlist_ (bool have_err,
*** 2072,2077 ****
--- 2128,2142 ----
ffeste_f2c_compile_ptrtoint_ (nextrecfield, nextrec_spec,
nextrecexp);
ffeste_f2c_compile_char_ (blankfield, blanklenfield, blank_spec,
blankexp,
blanklenexp);
+ ffeste_f2c_compile_char_ (convertfield, convertlenfield,
convert_spec,
+ convertexp, convertlenexp);
+ ffeste_f2c_compile_char_ (nativefield, nativelenfield,
+ native_spec, nativeexp,
+ nativelenexp);
+ ffeste_f2c_compile_char_ (little_endianfield,
little_endianlenfield, little_endian_spec,
+ little_endianexp, little_endianlenexp);
+ ffeste_f2c_compile_char_ (big_endianfield, big_endianlenfield,
big_endian_spec,
+ big_endianexp, big_endianlenexp);
ttype = build_pointer_type (TREE_TYPE (t));
t = ffecom_1 (ADDR_EXPR, ttype, t);
*************** ffeste_io_olist_ (bool have_err,
*** 2105,2111 ****
ffestpFile *access_spec,
ffestpFile *form_spec,
ffestpFile *recl_spec,
! ffestpFile *blank_spec)
{
tree t;
tree ttype;
--- 2170,2177 ----
ffestpFile *access_spec,
ffestpFile *form_spec,
ffestpFile *recl_spec,
! ffestpFile *blank_spec,
! ffestpFile *convert_spec)
{
tree t;
tree ttype;
*************** ffeste_io_olist_ (bool have_err,
*** 2114,2125 ****
tree ignore; /* Ignore length info for certain fields. */
bool constantp = TRUE;
static tree errfield, unitfield, filefield, filelenfield, statfield,
! accessfield, formfield, reclfield, blankfield;
tree errinit, unitinit, fileinit, fileleninit, statinit, accessinit,
! forminit, reclinit, blankinit;
tree
unitexp, fileexp, filelenexp, statexp, accessexp, formexp,
reclexp,
! blankexp;
static int mynumber = 0;
if (f2c_open_struct == NULL_TREE)
--- 2180,2191 ----
tree ignore; /* Ignore length info for certain fields. */
bool constantp = TRUE;
static tree errfield, unitfield, filefield, filelenfield, statfield,
! accessfield, formfield, reclfield, blankfield, convertfield;
tree errinit, unitinit, fileinit, fileleninit, statinit, accessinit,
! forminit, reclinit, blankinit, convertinit;
tree
unitexp, fileexp, filelenexp, statexp, accessexp, formexp,
reclexp,
! blankexp, convertexp;
static int mynumber = 0;
if (f2c_open_struct == NULL_TREE)
*************** ffeste_io_olist_ (bool have_err,
*** 2146,2151 ****
--- 2212,2219 ----
ffecom_f2c_ftnint_type_node);
blankfield = ffecom_decl_field (ref, reclfield, "blank",
string_type_node);
+ convertfield = ffecom_decl_field (ref, blankfield, "convert",
+ string_type_node);
TYPE_FIELDS (ref) = errfield;
layout_type (ref);
*************** ffeste_io_olist_ (bool have_err,
*** 2174,2179 ****
--- 2242,2248 ----
ffeste_f2c_init_charnolen_ (formexp, forminit, form_spec);
ffeste_f2c_init_int_ (reclexp, reclinit, recl_spec);
ffeste_f2c_init_charnolen_ (blankexp, blankinit, blank_spec);
+ ffeste_f2c_init_charnolen_ (convertexp, convertinit, convert_spec);
inits = build_tree_list ((field = TYPE_FIELDS (f2c_open_struct)),
errinit);
initn = inits;
*************** ffeste_io_olist_ (bool have_err,
*** 2185,2190 ****
--- 2254,2260 ----
ffeste_f2c_init_next_ (forminit);
ffeste_f2c_init_next_ (reclinit);
ffeste_f2c_init_next_ (blankinit);
+ ffeste_f2c_init_next_ (convertinit);
inits = build_constructor (f2c_open_struct, inits);
TREE_CONSTANT (inits) = constantp ? 1 : 0;
*************** ffeste_io_olist_ (bool have_err,
*** 2209,2214 ****
--- 2279,2285 ----
ffeste_f2c_prepare_charnolen_ (form_spec, formexp);
ffeste_f2c_prepare_int_ (recl_spec, reclexp);
ffeste_f2c_prepare_charnolen_ (blank_spec, blankexp);
+ ffeste_f2c_prepare_charnolen_ (convert_spec, convertexp);
ffecom_prepare_end ();
*************** ffeste_io_olist_ (bool have_err,
*** 2227,2232 ****
--- 2298,2304 ----
ffeste_f2c_compile_charnolen_ (formfield, form_spec, formexp);
ffeste_f2c_compile_int_ (reclfield, recl_spec, reclexp);
ffeste_f2c_compile_charnolen_ (blankfield, blank_spec, blankexp);
+ ffeste_f2c_compile_charnolen_ (convertfield, convert_spec,
convertexp);
ttype = build_pointer_type (TREE_TYPE (t));
t = ffecom_1 (ADDR_EXPR, ttype, t);
*************** ffeste_R904 (ffestpOpenStmt *info)
*** 3311,3317 ****
&info->open_spec[FFESTP_openixACCESS],
&info->open_spec[FFESTP_openixFORM],
&info->open_spec[FFESTP_openixRECL],
! &info->open_spec[FFESTP_openixBLANK]);
/* Don't generate "if (iostat != 0) goto label;" if label is temp
abort
label, since we're gonna fall through to there anyway. */
--- 3383,3390 ----
&info->open_spec[FFESTP_openixACCESS],
&info->open_spec[FFESTP_openixFORM],
&info->open_spec[FFESTP_openixRECL],
! &info->open_spec[FFESTP_openixBLANK],
! &info->open_spec[FFESTP_openixCONVERT]);
/* Don't generate "if (iostat != 0) goto label;" if label is temp
abort
label, since we're gonna fall through to there anyway. */
*************** ffeste_R923A (ffestpInquireStmt *info, b
*** 4122,4128 ****
&info->inquire_spec[FFESTP_inquireixUNFORMATTED],
&info->inquire_spec[FFESTP_inquireixRECL],
&info->inquire_spec[FFESTP_inquireixNEXTREC],
! &info->inquire_spec[FFESTP_inquireixBLANK]);
/* Don't generate "if (iostat != 0) goto label;" if label is temp
abort
label, since we're gonna fall through to there anyway. */
--- 4195,4205 ----
&info->inquire_spec[FFESTP_inquireixUNFORMATTED],
&info->inquire_spec[FFESTP_inquireixRECL],
&info->inquire_spec[FFESTP_inquireixNEXTREC],
! &info->inquire_spec[FFESTP_inquireixBLANK],
! &info->inquire_spec[FFESTP_inquireixCONVERT],
! &info->inquire_spec[FFESTP_inquireixNATIVE],
! &info->inquire_spec[FFESTP_inquireixLITTLE_ENDIAN],
! &info->inquire_spec[FFESTP_inquireixBIG_ENDIAN]);
/* Don't generate "if (iostat != 0) goto label;" if label is temp
abort
label, since we're gonna fall through to there anyway. */
Index: gcc/gcc/f/stp.h
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/f/stp.h,v
retrieving revision 1.5
diff -c -3 -p -r1.5 stp.h
*** gcc/gcc/f/stp.h 26 May 2001 01:31:46 -0000 1.5
--- gcc/gcc/f/stp.h 18 Feb 2004 06:01:50 -0000
*************** enum _ffestp_inquireix_
*** 112,119 ****
--- 112,121 ----
{
FFESTP_inquireixACCESS,
FFESTP_inquireixACTION,
+ FFESTP_inquireixBIG_ENDIAN,
FFESTP_inquireixBLANK,
FFESTP_inquireixCARRIAGECONTROL,
+ FFESTP_inquireixCONVERT,
FFESTP_inquireixDEFAULTFILE,
FFESTP_inquireixDELIM,
FFESTP_inquireixDIRECT,
*************** enum _ffestp_inquireix_
*** 125,132 ****
--- 127,136 ----
FFESTP_inquireixIOLENGTH,
FFESTP_inquireixIOSTAT,
FFESTP_inquireixKEYED,
+ FFESTP_inquireixLITTLE_ENDIAN,
FFESTP_inquireixNAME,
FFESTP_inquireixNAMED,
+ FFESTP_inquireixNATIVE,
FFESTP_inquireixNEXTREC,
FFESTP_inquireixNUMBER,
FFESTP_inquireixOPENED,
*************** enum _ffestp_openix_
*** 154,159 ****
--- 158,164 ----
FFESTP_openixBLOCKSIZE,
FFESTP_openixBUFFERCOUNT,
FFESTP_openixCARRIAGECONTROL,
+ FFESTP_openixCONVERT,
FFESTP_openixDEFAULTFILE,
FFESTP_openixDELIM,
FFESTP_openixDISPOSE,
Index: gcc/gcc/f/str-io.fin
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/f/str-io.fin,v
retrieving revision 1.4
diff -c -3 -p -r1.4 str-io.fin
*** gcc/gcc/f/str-io.fin 15 Feb 1999 18:17:43 -0000 1.4
--- gcc/gcc/f/str-io.fin 18 Feb 2004 06:01:50 -0000
*************** the Free Software Foundation, 59 Temple
*** 23,28 ****
--- 23,29 ----
FFESTR_genio // // ffestrGenio ffestr_genio 1 0
Advance ADVANCE
+ Convert CONVERT
Disp DISP
Dispose DISPOSE
End END
Index: gcc/gcc/f/str-nq.fin
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/f/str-nq.fin,v
retrieving revision 1.4
diff -c -3 -p -r1.4 str-nq.fin
*** gcc/gcc/f/str-nq.fin 15 Feb 1999 18:17:44 -0000 1.4
--- gcc/gcc/f/str-nq.fin 18 Feb 2004 06:01:50 -0000
*************** the Free Software Foundation, 59 Temple
*** 24,31 ****
--- 24,33 ----
FFESTR_inquire // // ffestrInquire ffestr_inquire 1 0
Access ACCESS
Action ACTION
+ Big_Endian BIG_ENDIAN
Blank BLANK
CarriageControl CARRIAGECONTROL
+ Convert CONVERT
DefaultFile DEFAULTFILE
Delim DELIM
Direct DIRECT
*************** Formatted FORMATTED
*** 37,44 ****
--- 39,48 ----
IOLength IOLENGTH
IOStat IOSTAT
Keyed KEYED
+ Little_Endian LITTLE_ENDIAN
Name NAME
Named NAMED
+ Native NATIVE
NextRec NEXTREC
Number NUMBER
Opened OPENED
Index: gcc/gcc/f/str-op.fin
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/f/str-op.fin,v
retrieving revision 1.4
diff -c -3 -p -r1.4 str-op.fin
*** gcc/gcc/f/str-op.fin 15 Feb 1999 18:17:46 -0000 1.4
--- gcc/gcc/f/str-op.fin 18 Feb 2004 06:01:50 -0000
*************** Blank BLANK
*** 29,34 ****
--- 29,35 ----
BlockSize BLOCKSIZE
BufferCount BUFFERCOUNT
CarriageControl CARRIAGECONTROL
+ Convert CONVERT
DefaultFile DEFAULTFILE
Delim DELIM
Disp DISP
Index: gcc/gcc/testsuite/g77.f-torture/execute/ioconv.f
===================================================================
RCS file: gcc/gcc/testsuite/g77.f-torture/execute/ioconv.f
diff -N gcc/gcc/testsuite/g77.f-torture/execute/ioconv.f
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/gcc/testsuite/g77.f-torture/execute/ioconv.f 18 Feb 2004
06:02:09 -0000
***************
*** 0 ****
--- 1,44 ----
+ program ioconv
+ implicit none
+ integer i, j
+ Real a, b
+ Double Precision d, e
+ Character*5 w
+
+ * Testing enhancement (convert= option).
+ open(90,status='scratch',form='unformatted',
+ + convert='big_endian')
+ write(90) 1, 2, 1.1, 2.2, 1.1d0, 2.2d0, 'tests'
+
+ rewind(90)
+
+ read(90) i, j, a, b, d, e, w
+
+ if(i.ne.1 .or. j.ne.2 .or. abs(a-1.1).gt.1e-6 .or.
+ + abs(b-2.2).gt.1e-6 .or. abs(d-1.1d0).gt.1e-10 .or.
+ + abs(e-2.2d0).gt.1e-10 .or. w.ne.'tests') call abort()
+
+ open(91,status='scratch',form='unformatted',
+ + convert='little_endian')
+ write(91) 1, 2, 1.1, 2.2, 1.1d0, 2.2d0, 'tests'
+
+ rewind(91)
+
+ read(91) i, j, a, b, d, e, w
+
+ if(i.ne.1 .or. j.ne.2 .or. abs(a-1.1).gt.1e-6 .or.
+ + abs(b-2.2).gt.1e-6 .or. abs(d-1.1d0).gt.1e-10 .or.
+ + abs(e-2.2d0).gt.1e-10 .or. w.ne.'tests') call abort()
+
+ open(92,status='scratch',form='unformatted',convert='native')
+ write(92) 1, 2, 1.1, 2.2, 1.1d0, 2.2d0, 'tests'
+
+ rewind(92)
+
+ read(92) i, j, a, b, d, e, w
+
+ if(i.ne.1 .or. j.ne.2 .or. abs(a-1.1).gt.1e-6 .or.
+ + abs(b-2.2).gt.1e-6 .or. abs(d-1.1d0).gt.1e-10 .or.
+ + abs(e-2.2d0).gt.1e-10 .or. w.ne.'tests') call abort()
+
+ end
Index: gcc/gcc/testsuite/g77.f-torture/execute/ioconv.x
===================================================================
RCS file: gcc/gcc/testsuite/g77.f-torture/execute/ioconv.x
diff -N gcc/gcc/testsuite/g77.f-torture/execute/ioconv.x
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/gcc/testsuite/g77.f-torture/execute/ioconv.x 18 Feb 2004
06:02:09 -0000
***************
*** 0 ****
--- 1,13 ----
+ # Scratch files aren't implemented for mmixware
+ # (_stat is a stub and files can't be deleted).
+ # Similar restrictions exist for most simulators.
+
+ if { [istarget "mmix-knuth-mmixware"]
+ || [istarget "arm*-*-elf"]
+ || [istarget "strongarm*-*-elf"]
+ || [istarget "xscale*-*-elf"]
+ || [istarget "cris-*-elf"] } {
+ set torture_execute_xfail [istarget]
+ }
+
+ return 0
Index: gcc/gcc/testsuite/g77.f-torture/execute/ioconv2.f
===================================================================
RCS file: gcc/gcc/testsuite/g77.f-torture/execute/ioconv2.f
diff -N gcc/gcc/testsuite/g77.f-torture/execute/ioconv2.f
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/gcc/testsuite/g77.f-torture/execute/ioconv2.f 18 Feb 2004
06:02:09 -0000
***************
*** 0 ****
--- 1,78 ----
+ program ioconv2
+ implicit none
+ logical test
+
+ * Testing that the convert= option works
+ if (.not.test('native',0) .or. .not.test('little_endian', 1)
+ + .or. .not.test('big_endian', 2)) call abort()
+
+ end
+
+ logical function test(convtype, expect)
+ implicit none
+ character*13 convtype
+ integer expect
+ logical rd_unit
+ external rd_unit
+ integer knd
+
+ open(90,file='tmpiocnv2.dat',form='unformatted',
+ + convert=convtype)
+ write(90) 1, 2, 1.1, 2.2, 1.1d0, 2.2d0
+ write(90) (3.3e0,4.4e0), .true., 'tests'
+ close(90)
+
+ open(91,file='tmpiocnv2.dat',form='unformatted',
+ + convert='little_endian')
+ if (rd_unit()) then
+ knd = 1
+ else
+ close(91)
+ open(91,file='tmpiocnv2.dat',form='unformatted',
+ + convert='big_endian')
+ if (rd_unit()) then
+ knd = 2
+ else
+ knd = -1
+ endif
+ endif
+ close(91)
+
+ test = (knd .eq. expect) .or. (expect .eq. 0 .and.
+ + (knd .eq. 1 .or. knd .eq. 2))
+
+ return
+ end
+
+ logical function rd_unit()
+ implicit none
+ integer i, j
+ real a, b
+ double precision d, e
+ complex z
+ logical l, lx
+ character*5 w
+
+ read(91, end=1) i
+
+ if (i .ne. 1) then
+ rd_unit = .false.
+ return
+ endif
+
+ rewind(91)
+
+ read(91) i, j, a, b, d, e
+ read(91, end=1) z, l, w
+
+ rd_unit = i.eq.1 .and. j.eq.2 .and. abs(a-1.1).le.1e-7 .and.
+ + abs(b-2.2).le.1e-7 .and. abs(d-1.1d0).le.1e-10 .and.
+ + abs(e-2.2d0).le.1e-10 .and. w.eq.'tests' .and.
+ + abs(z-(3.3e0,4.4e0)).le.1e-6 .and. l
+
+ return
+
+ 1 rd_unit = .false.
+
+ return
+ end
Index: gcc/gcc/testsuite/g77.f-torture/execute/ioconv2.x
===================================================================
RCS file: gcc/gcc/testsuite/g77.f-torture/execute/ioconv2.x
diff -N gcc/gcc/testsuite/g77.f-torture/execute/ioconv2.x
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/gcc/testsuite/g77.f-torture/execute/ioconv2.x 18 Feb 2004
06:02:09 -0000
***************
*** 0 ****
--- 1,13 ----
+ # Scratch files aren't implemented for mmixware
+ # (_stat is a stub and files can't be deleted).
+ # Similar restrictions exist for most simulators.
+
+ if { [istarget "mmix-knuth-mmixware"]
+ || [istarget "arm*-*-elf"]
+ || [istarget "strongarm*-*-elf"]
+ || [istarget "xscale*-*-elf"]
+ || [istarget "cris-*-elf"] } {
+ set torture_execute_xfail [istarget]
+ }
+
+ return 0
Index: gcc/gcc/testsuite/g77.f-torture/execute/ioconv3.f
===================================================================
RCS file: gcc/gcc/testsuite/g77.f-torture/execute/ioconv3.f
diff -N gcc/gcc/testsuite/g77.f-torture/execute/ioconv3.f
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/gcc/testsuite/g77.f-torture/execute/ioconv3.f 18 Feb 2004
06:02:09 -0000
***************
*** 0 ****
--- 1,35 ----
+ program ioconv3
+ implicit none
+
+ * Testing that rewind() works with convert=
+ call test('native')
+ call test('little_endian')
+ call test('big_endian')
+
+ end
+
+ subroutine test(convtype)
+ implicit none
+ character*13 convtype
+ logical rd_unit
+ external rd_unit
+ integer knd
+ integer i, j
+ real a, b
+ double precision d, e
+ complex z
+ logical l, lx
+ character*5 w
+
+ open(90,status='scratch',form='unformatted',
+ + convert=convtype)
+ write(90) 1, 2, 1.1, 2.2, 1.1d0, 2.2d0
+ write(90) (3.3e0,4.4e0), .true., 'tests'
+ backspace(90)
+ read(90) z, l, w
+
+ if (w.ne.'tests' .or. abs(z-(3.3e0,4.4e0)).gt.1e-6 .or. .not.l)
+ + call abort()
+
+ return
+ end
Index: gcc/gcc/testsuite/g77.f-torture/execute/ioconv3.x
===================================================================
RCS file: gcc/gcc/testsuite/g77.f-torture/execute/ioconv3.x
diff -N gcc/gcc/testsuite/g77.f-torture/execute/ioconv3.x
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/gcc/testsuite/g77.f-torture/execute/ioconv3.x 18 Feb 2004
06:02:09 -0000
***************
*** 0 ****
--- 1,13 ----
+ # Scratch files aren't implemented for mmixware
+ # (_stat is a stub and files can't be deleted).
+ # Similar restrictions exist for most simulators.
+
+ if { [istarget "mmix-knuth-mmixware"]
+ || [istarget "arm*-*-elf"]
+ || [istarget "strongarm*-*-elf"]
+ || [istarget "xscale*-*-elf"]
+ || [istarget "cris-*-elf"] } {
+ set torture_execute_xfail [istarget]
+ }
+
+ return 0
Index: gcc/libf2c/g2c.hin
===================================================================
RCS file: /cvsroot/gcc/gcc/libf2c/g2c.hin,v
retrieving revision 1.4
diff -c -3 -p -r1.4 g2c.hin
*** gcc/libf2c/g2c.hin 1 Jun 2002 01:58:09 -0000 1.4
--- gcc/libf2c/g2c.hin 18 Feb 2004 06:02:25 -0000
*************** typedef struct
*** 87,92 ****
--- 87,93 ----
char *ofm;
ftnint orl;
char *oblnk;
+ char *oconv;
} olist;
/*close*/
*************** typedef struct
*** 130,135 ****
--- 131,144 ----
ftnint *innrec;
char *inblank;
ftnlen inblanklen;
+ char *inconv;
+ ftnlen inconvlen;
+ char *innati;
+ ftnlen innatilen;
+ char *inlien;
+ ftnlen inlienlen;
+ char *inbien;
+ ftnlen inbienlen;
} inlist;
union Multitype { /* for multiple entry points */
Index: gcc/libf2c/libI77/backspace.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libf2c/libI77/backspace.c,v
retrieving revision 1.11
diff -c -3 -p -r1.11 backspace.c
*** gcc/libf2c/libI77/backspace.c 1 Jun 2002 12:38:29 -0000 1.11
--- gcc/libf2c/libI77/backspace.c 18 Feb 2004 06:02:30 -0000
*************** f_back (alist * a)
*** 50,55 ****
--- 50,58 ----
{
FSEEK (f, -(off_t) sizeof (uiolen), SEEK_CUR);
fread ((char *) &n, sizeof (uiolen), 1, f);
+ if (b->uconv && ( (f__hostbigendian && b->uconv == 1) ||
+ (!f__hostbigendian && b->uconv == 2)) )
+ swapbytes (1, (char *) &n, sizeof(uiolen));
FSEEK (f, -(off_t) n - 2 * sizeof (uiolen), SEEK_CUR);
return (0);
}
Index: gcc/libf2c/libI77/due.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libf2c/libI77/due.c,v
retrieving revision 1.11
diff -c -3 -p -r1.11 due.c
*** gcc/libf2c/libI77/due.c 2 Jun 2002 14:34:31 -0000 1.11
--- gcc/libf2c/libI77/due.c 18 Feb 2004 06:02:43 -0000
*************** c_due (cilist * a)
*** 29,34 ****
--- 29,39 ----
err (a->cierr, 130, "due");
FSEEK (f__cf, (off_t) (a->cirec - 1) * f__curunit->url, SEEK_SET);
f__curunit->uend = 0;
+ if (f__curunit->uconv && ( (f__hostbigendian && f__curunit->uconv
== 1) ||
+ (!f__hostbigendian && f__curunit->uconv
== 2)) )
+ f__converting = 1;
+ else
+ f__converting = 0;
return (0);
}
Index: gcc/libf2c/libI77/err.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libf2c/libI77/err.c,v
retrieving revision 1.12
diff -c -3 -p -r1.12 err.c
*** gcc/libf2c/libI77/err.c 2 Jun 2002 13:01:11 -0000 1.12
--- gcc/libf2c/libI77/err.c 18 Feb 2004 06:02:43 -0000
*************** int (*f__doed) (struct syl *, char *, ft
*** 31,36 ****
--- 31,38 ----
int (*f__dorevert) (void), (*f__donewrec) (void), (*f__doend) (void);
flag f__sequential; /*1 if sequential io, 0 if direct */
flag f__formatted; /*1 if formatted io, 0 if unformatted */
+ flag f__converting; /*1 if converting little to big endian or
vice-versa */
+ flag f__hostbigendian; /*1 if the host uses big endian byte ordering
*/
FILE *f__cf; /*current file */
unit *f__curunit; /*current unit */
int f__recpos; /*place in current record */
*************** char *F_err[] = {
*** 71,77 ****
"can't append to file", /* 129 */
"non-positive record number", /* 130 */
"I/O started while already doing I/O", /* 131 */
! "Temporary file name (TMPDIR?) too long" /* 132 */
};
#define MAXERR (sizeof(F_err)/sizeof(char *)+100)
--- 73,80 ----
"can't append to file", /* 129 */
"non-positive record number", /* 130 */
"I/O started while already doing I/O", /* 131 */
! "Temporary file name (TMPDIR?) too long", /* 132 */
! "no memory for endianness conversion" /* 133 */
};
#define MAXERR (sizeof(F_err)/sizeof(char *)+100)
*************** f__fatal (int n, char *s)
*** 164,174 ****
fprintf (stderr, "apparent state: internal I/O\n");
if (f__fmtbuf)
fprintf (stderr, "last format: %.*s\n", f__fmtlen, f__fmtbuf);
! fprintf (stderr, "lately %s %s %s %s",
f__reading ? "reading" : "writing",
f__sequential ? "sequential" : "direct",
f__formatted ? "formatted" : "unformatted",
! f__external ? "external" : "internal");
}
f__init &= ~2; /* No longer doing I/O (no more user code to be
called). */
sig_die (" IO", 1);
--- 167,178 ----
fprintf (stderr, "apparent state: internal I/O\n");
if (f__fmtbuf)
fprintf (stderr, "last format: %.*s\n", f__fmtlen, f__fmtbuf);
! fprintf (stderr, "lately %s %s %s %s %s",
f__reading ? "reading" : "writing",
f__sequential ? "sequential" : "direct",
f__formatted ? "formatted" : "unformatted",
! f__external ? "external" : "internal",
! f__converting ? "converted" : "native");
}
f__init &= ~2; /* No longer doing I/O (no more user code to be
called). */
sig_die (" IO", 1);
*************** void
*** 179,184 ****
--- 183,190 ----
f_init (void)
{
unit *p;
+ int i;
+ char *c;
if (f__init & 2)
f__fatal (131, "I/O recursion");
*************** f_init (void)
*** 198,203 ****
--- 204,214 ----
p->useek = f__canseek (stdout);
p->ufmt = 1;
p->uwrt = 1;
+
+ /* check endianness of host */
+ i = 1;
+ c = (char *) &i;
+ f__hostbigendian = (*c != 1);
}
int
Index: gcc/libf2c/libI77/fio.h
===================================================================
RCS file: /cvsroot/gcc/gcc/libf2c/libI77/fio.h,v
retrieving revision 1.12
diff -c -3 -p -r1.12 fio.h
*** gcc/libf2c/libI77/fio.h 1 Jun 2002 12:38:29 -0000 1.12
--- gcc/libf2c/libI77/fio.h 18 Feb 2004 06:02:43 -0000
*************** typedef struct
*** 54,65 ****
flag uend;
flag uwrt; /*last io was write */
flag uscrtch;
}
unit;
extern int f__init;
extern cilist *f__elist; /*active external io list */
! extern flag f__reading, f__external, f__sequential, f__formatted;
extern int (*f__getn) (void); /* for formatted input */
extern void (*f__putn) (int); /* for formatted output */
extern void x_putc (int);
--- 54,66 ----
flag uend;
flag uwrt; /*last io was write */
flag uscrtch;
+ int uconv; /* 0=native, 1=LITTLE_ENDIAN, 2=BIG_ENDIAN */
}
unit;
extern int f__init;
extern cilist *f__elist; /*active external io list */
! extern flag f__reading, f__external, f__sequential, f__formatted,
f__converting, f__hostbigendian;
extern int (*f__getn) (void); /* for formatted input */
extern void (*f__putn) (int); /* for formatted output */
extern void x_putc (int);
*************** extern int en_fio (void);
*** 73,78 ****
--- 74,80 ----
extern void f_init (void);
extern int (*f__donewrec) (void), t_putc (int), x_wSL (void);
extern void b_char (char *, char *, ftnlen), g_char (char *, ftnlen,
char *);
+ extern void swapbytes (ftnint, char *, ftnlen);
extern int c_sfe (cilist *), z_rnew (void);
extern int isatty (int);
extern int err__fl (int, int, char *);
Index: gcc/libf2c/libI77/inquire.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libf2c/libI77/inquire.c,v
retrieving revision 1.8
diff -c -3 -p -r1.8 inquire.c
*** gcc/libf2c/libI77/inquire.c 4 Jun 2002 02:24:25 -0000 1.8
--- gcc/libf2c/libI77/inquire.c 18 Feb 2004 06:02:43 -0000
*************** f_inqu (inlist * a)
*** 139,143 ****
--- 139,176 ----
else
b_char ("NULL", a->inblank, a->inblanklen);
}
+ if (p != NULL && p->ufmt == 0)
+ {
+ if (a->inconv != NULL)
+ {
+ if (p->uconv == 1)
+ b_char ("LITTLE_ENDIAN", a->inconv, a->inconvlen);
+ else if (p->uconv == 2)
+ b_char ("BIG_ENDIAN", a->inconv, a->inconvlen);
+ else
+ b_char ("NATIVE", a->inconv, a->inconvlen);
+ }
+ if (a->innati != NULL)
+ {
+ if (p->uconv == 0)
+ b_char ("YES", a->innati, a->innatilen);
+ else
+ b_char ("NO", a->innati, a->innatilen);
+ }
+ if (a->inlien != NULL)
+ {
+ if (p->uconv != 1)
+ b_char ("NO", a->inlien, a->inlienlen);
+ else
+ b_char ("YES", a->inlien, a->inlienlen);
+ }
+ if (a->inbien != NULL)
+ {
+ if (p->uconv != 2)
+ b_char ("NO", a->inbien, a->inbienlen);
+ else
+ b_char ("YES", a->inbien, a->inbienlen);
+ }
+ }
return (0);
}
Index: gcc/libf2c/libI77/open.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libf2c/libI77/open.c,v
retrieving revision 1.21
diff -c -3 -p -r1.21 open.c
*** gcc/libf2c/libI77/open.c 24 Mar 2003 21:20:19 -0000 1.21
--- gcc/libf2c/libI77/open.c 18 Feb 2004 06:02:43 -0000
*************** f_open (olist * a)
*** 147,152 ****
--- 147,168 ----
}
b->url = (int) a->orl;
b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
+ if (a->oconv)
+ switch (*a->oconv)
+ {
+ case 'l':
+ case 'L':
+ b->uconv = 1;
+ break;
+ case 'b':
+ case 'B':
+ b->uconv = 2;
+ break;
+ default:
+ b->uconv = 0;
+ break;
+ }
+
if (a->ofm == 0)
if ((a->oacc) && (*a->oacc == 'D' || *a->oacc == 'd'))
b->ufmt = 0;
*************** fk_open (int seq, int fmt, ftnint n)
*** 293,298 ****
--- 309,315 ----
a.ofm = fmt == FMT ? "f" : "u";
a.orl = seq == DIR ? 1 : 0;
a.oblnk = NULL;
+ a.oconv = NULL;
save_init = f__init;
f__init &= ~2;
rtn = f_open (&a);
Index: gcc/libf2c/libI77/sue.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libf2c/libI77/sue.c,v
retrieving revision 1.10
diff -c -3 -p -r1.10 sue.c
*** gcc/libf2c/libI77/sue.c 2 Jun 2002 14:34:31 -0000 1.10
--- gcc/libf2c/libI77/sue.c 18 Feb 2004 06:02:43 -0000
*************** c_sue (cilist * a)
*** 20,25 ****
--- 20,30 ----
err (a->cierr, 103, "sue");
if (!f__curunit->useek)
err (a->cierr, 103, "sue");
+ if (f__curunit->uconv && ( (f__hostbigendian && f__curunit->uconv
== 1) ||
+ (!f__hostbigendian && f__curunit->uconv
== 2) ))
+ f__converting = 1;
+ else
+ f__converting = 0;
return (0);
}
*************** s_rsue (cilist * a)
*** 46,51 ****
--- 51,59 ----
clearerr (f__cf);
err (a->cierr, errno, "start");
}
+
+ if (f__converting)
+ swapbytes(1, (char *) &f__reclen, sizeof(uiolen));
return (0);
}
*************** e_wsue (void)
*** 72,85 ****
{
off_t loc;
f__init = 1;
! fwrite ((char *) &f__reclen, sizeof (uiolen), 1, f__cf);
#ifdef ALWAYS_FLUSH
if (fflush (f__cf))
err (f__elist->cierr, errno, "write end");
#endif
loc = FTELL (f__cf);
FSEEK (f__cf, f__recloc, SEEK_SET);
! fwrite ((char *) &f__reclen, sizeof (uiolen), 1, f__cf);
FSEEK (f__cf, loc, SEEK_SET);
return (0);
}
--- 80,98 ----
{
off_t loc;
f__init = 1;
! uiolen f__reclen_ext = f__reclen;
!
! if (f__converting)
! swapbytes(1, (char *)&f__reclen_ext, sizeof(uiolen));
!
! fwrite ((char *) &f__reclen_ext, sizeof (uiolen), 1, f__cf);
#ifdef ALWAYS_FLUSH
if (fflush (f__cf))
err (f__elist->cierr, errno, "write end");
#endif
loc = FTELL (f__cf);
FSEEK (f__cf, f__recloc, SEEK_SET);
! fwrite ((char *) &f__reclen_ext, sizeof (uiolen), 1, f__cf);
FSEEK (f__cf, loc, SEEK_SET);
return (0);
}
Index: gcc/libf2c/libI77/uio.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libf2c/libI77/uio.c,v
retrieving revision 1.7
diff -c -3 -p -r1.7 uio.c
*** gcc/libf2c/libI77/uio.c 4 Jun 2002 02:25:47 -0000 1.7
--- gcc/libf2c/libI77/uio.c 18 Feb 2004 06:02:43 -0000
***************
*** 1,3 ****
--- 1,4 ----
+ #include <stdlib.h>
#include "config.h"
#include "f2c.h"
#include "fio.h"
*************** do_uio (ftnint * number, char *ptr, ftnl
*** 57,60 ****
--- 58,94 ----
return (do_us (number, ptr, len));
else
return (do_ud (number, ptr, len));
+ }
+
+ integer
+ do_uioc (ftnint * number, char *ptr, ftnlen len)
+ {
+ integer ret;
+ char *buf;
+
+ if (!f__reading && f__converting)
+ {
+ buf = (char *) malloc (*number * len);
+ if (!buf)
+ err (f__elist->cierr, 133, "do_uioc");
+ memcpy (buf, ptr, *number * len);
+ swapbytes (*number, buf, len);
+ } else {
+ buf = ptr;
+ }
+
+ if (f__sequential)
+ ret = (do_us (number, buf, len));
+ else
+ ret = (do_ud (number, buf, len));
+
+ if (f__converting)
+ {
+ if (f__reading)
+ swapbytes (*number, buf, len);
+ else
+ free (buf);
+ }
+
+ return ret;
}
Index: gcc/libf2c/libI77/util.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libf2c/libI77/util.c,v
retrieving revision 1.6
diff -c -3 -p -r1.6 util.c
*** gcc/libf2c/libI77/util.c 1 Jun 2002 12:38:30 -0000 1.6
--- gcc/libf2c/libI77/util.c 18 Feb 2004 06:02:43 -0000
*************** f__inode (char *a, int *dev)
*** 50,52 ****
--- 50,77 ----
return (x.st_ino);
}
#endif
+
+ void
+ swapbytes (ftnint number, char *ptr, ftnlen len)
+ {
+ char swap;
+ char *pstart, *pend;
+ ftnint i;
+
+ if (len < 2)
+ return;
+
+ for (i = 1; i <= number; i++)
+ {
+ pstart = ptr;
+ ptr += len;
+ pend = ptr;
+
+ while (pstart < --pend)
+ {
+ swap = *pstart;
+ *pstart++ = *pend;
+ *pend = swap;
+ }
+ }
+ }
\ No newline at end of file
More information about the Gcc-patches
mailing list