re PR fortran/23815 (Add -byteswapio flag)

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-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.

From-SVN: r108358

5 files changed, 186 insertions, 14 deletions

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; 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--);
+}