OSDN Git Service

2005-12-10 Thomas Koenig <Thomas.Koenig@online.de>
authortkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 10 Dec 2005 20:01:56 +0000 (20:01 +0000)
committertkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 10 Dec 2005 20:01:56 +0000 (20:01 +0000)
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

17 files changed:
gcc/fortran/ChangeLog
gcc/fortran/dump-parse-tree.c
gcc/fortran/gfortran.h
gcc/fortran/gfortran.texi
gcc/fortran/io.c
gcc/fortran/ioparm.def
gcc/fortran/trans-io.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/unf_io_convert_1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/unf_io_convert_3.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/io/file_pos.c
libgfortran/io/inquire.c
libgfortran/io/io.h
libgfortran/io/open.c
libgfortran/io/transfer.c

index 58cf367..e9a8f30 100644 (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
index 499e1fa..ef5c88a 100644 (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);
index 83de267..f22f6a4 100644 (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;
 
index 92a6d5f..ea3ac24 100644 (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 ---------------------------------------------------------------------
index 6adc1ef..090f905 100644 (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;
@@ -1106,6 +1113,9 @@ match_open_element (gfc_open * open)
   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_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;
index 9ca0cf6..0fe9a7b 100644 (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)
index 98c1d1f..87a11c3 100644 (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);
index 88cbc84..8c170f0 100644 (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
diff --git a/gcc/testsuite/gfortran.dg/unf_io_convert_1.f90 b/gcc/testsuite/gfortran.dg/unf_io_convert_1.f90
new file mode 100644 (file)
index 0000000..0ed3fc5
--- /dev/null
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 b/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90
new file mode 100644 (file)
index 0000000..42bad3e
--- /dev/null
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/unf_io_convert_3.f90 b/gcc/testsuite/gfortran.dg/unf_io_convert_3.f90
new file mode 100644 (file)
index 0000000..40ace2a
--- /dev/null
@@ -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
index a47e002..88da4a6 100644 (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
index 0049718..3d7dd9a 100644 (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;
index bccd5a1..9044bf8 100644 (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);
+    }
 }
 
 
index e7b0ac1..e364171 100644 (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);
index 7e42cc6..3dc2b11 100644 (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");
index b2d26ac..f3ca8df 100644 (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);
+    }
+  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);
+       }
+    }
 }
 
 
@@ -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--);
+}