re PR fortran/23815 (Add -byteswapio flag)

2005-02-06  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/23815
	* gfortran.texi: Document the GFORTRAN_CONVERT_UNIT environment
	variable.
	* invoke.texi:  Mention the "Runtime" chapter.
	Document the -fconvert= option.
	* gfortran.h:  Add options_convert.
	* lang.opt:  Add fconvert=little-endian, fconvert=big-endian,
	fconvert=native and fconvert=swap.
	* trans-decl.c (top level):  Add gfor_fndecl_set_convert.
	(gfc_build_builtin_function_decls):  Set gfor_fndecl_set_convert.
	(gfc_generate_function_code):  If -fconvert was specified,
	and this is the main program, add a call to set_convert().
	* options.c:  Handle the -fconvert options.

2005-02-06  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/23815
	* runtime/environ.c (init_unformatted):  Add GFORTRAN_CONVERT_UNIT
	environment variable.
	(top level):  Add defines, type and static variables for
	GFORTRAN_CONVERT_UNIT handling.
	(search_unit):  New function.
	(match_word): New function.
	(match_integer): New function.
	(next_token): New function.
	(push_token): New function.
	(mark_single): New function.
	(mark_range): New funciton.
	(do_parse): New function.
	(init_unformatted): New function.
	(get_unformatted_convert): New function.
	* runtime/compile_options.c:  Add set_convert().
	* libgfortran.h:  Add convert to compile_options_t.
	* io/open.c (st_open): Call get_unformatted_convert to get
	unit default; if CONVERT_NONE is returned, check for
	the presence of a CONVERT specifier and use it.
	As default, use compile_options.convert.
	* io/io.h (top level): Add CONVERT_NONE to unit_convert, to signal
	"nothing has been set".
	(top level): Add prototype for get_unformatted_convert.

2005-02-06  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/23815
	* unf_io_convert_4.f90:  New test.

From-SVN: r110664

6 files changed, 521 insertions, 29 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index ef4db4f..4bcdb84 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,30 @@
+2005-02-06  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR libfortran/23815
+	* runtime/environ.c (init_unformatted):  Add GFORTRAN_CONVERT_UNIT
+	environment variable.
+	(top level):  Add defines, type and static variables for
+	GFORTRAN_CONVERT_UNIT handling.
+	(search_unit):  New function.
+	(match_word): New function.
+	(match_integer): New function.
+	(next_token): New function.
+	(push_token): New function.
+	(mark_single): New function.
+	(mark_range): New funciton.
+	(do_parse): New function.
+	(init_unformatted): New function.
+	(get_unformatted_convert): New function.
+	* runtime/compile_options.c:  Add set_convert().
+	* libgfortran.h:  Add convert to compile_options_t.
+	* io/open.c (st_open): Call get_unformatted_convert to get
+	unit default; if CONVERT_NONE is returned, check for
+	the presence of a CONVERT specifier and use it.
+	As default, use compile_options.convert.
+	* io/io.h (top level): Add CONVERT_NONE to unit_convert, to signal
+	"nothing has been set".
+	(top level): Add prototype for get_unformatted_convert.
+
 2006-02-06  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	PR libfortran/24685
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index e364171..31b4927 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -207,7 +207,7 @@ typedef enum
 unit_mode;
 
 typedef enum
-{ CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
+{ CONVERT_NONE=-1, CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
 unit_convert;
 
 #define CHARACTER1(name) \
@@ -884,3 +884,8 @@ dec_waiting_unlocked (gfc_unit *u)
 }
 
 #endif
+
+/* ../runtime/environ.c  This is here because we return unit_convert.  */
+
+unit_convert get_unformatted_convert (int);
+internal_proto(get_unformatted_convert);
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index 3dc2b11..1459f8f 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -502,6 +502,7 @@ st_open (st_parameter_open *opp)
   unit_flags flags;
   gfc_unit *u = NULL;
   GFC_INTEGER_4 cf = opp->common.flags;
+  unit_convert conv;
  
   library_start (&opp->common);
 
@@ -539,35 +540,44 @@ 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)
+  /* First, we check wether the convert flag has been set via environment
+     variable.  This overrides the convert tag in the open statement.  */
+
+  conv = get_unformatted_convert (opp->common.unit);
+
+  if (conv == CONVERT_NONE)
     {
-      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;
+      /* Nothing has been set by environment variable, check the convert tag.  */
+      if (cf & IOPARM_OPEN_HAS_CONVERT)
+	conv = find_option (&opp->common, opp->convert, opp->convert_len,
+			    convert_opt,
+			    "Bad CONVERT parameter in OPEN statement");
+      else
+	conv = compile_options.convert;
     }
-  else
-    flags.convert = CONVERT_NATIVE;
+  
+  /* 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;
 
   if (opp->common.unit < 0)
     generate_error (&opp->common, ERROR_BAD_OPTION,
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 3b8eed2..fac9b4a 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -336,6 +336,7 @@ typedef struct
 {
   int warn_std;
   int allow_std;
+  int convert;
 }
 compile_options_t;
 
diff --git a/libgfortran/runtime/compile_options.c b/libgfortran/runtime/compile_options.c
index fdc7b78..e2a2ffa 100644
--- a/libgfortran/runtime/compile_options.c
+++ b/libgfortran/runtime/compile_options.c
@@ -59,3 +59,15 @@ init_compile_options (void)
   compile_options.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
     | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY;
 }
+
+/* Function called by the front-end to tell us the
+   default for unformatted data conversion.  */
+
+extern void set_convert (int);
+export_proto (set_convert);
+
+void
+set_convert (int conv)
+{
+  compile_options.convert = conv;
+}
diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c
index 09743a0..c519f08 100644
--- a/libgfortran/runtime/environ.c
+++ b/libgfortran/runtime/environ.c
@@ -61,8 +61,9 @@ typedef struct variable
 }
 variable;
 
+static void init_unformatted (variable *);
 
-/* print_spaces()-- Print a particular number of spaces */
+/* print_spaces()-- Print a particular number of spaces.  */
 
 static void
 print_spaces (int n)
@@ -533,6 +534,11 @@ static variable variable_table[] = {
    show_precision,
    "Precision of intermediate results.  Values are 24, 53 and 64.", 0},
 
+  /* GFORTRAN_CONVERT_UNIT - Set the default data conversion for
+   unformatted I/O.  */
+  {"GFORTRAN_CONVERT_UNIT", 0, 0, init_unformatted, show_string,
+   "Set format for unformatted files", 0},
+
   {NULL, 0, NULL, NULL, NULL, NULL, 0}
 };
 
@@ -623,3 +629,434 @@ show_variables (void)
 
   sys_exit (0);
 }
+
+/* This is the handling of the GFORTRAN_CONVERT_UNITS environment variable.
+   It is called from environ.c to parse this variable, and from
+   open.c to determine if the user specified a default for an
+   unformatted file.
+   The syntax of the environment variable is, in bison grammar:
+
+   GFORTRAN_CONVERT_UNITS: mode | mode ';' exception ;
+   mode: 'native' | 'swap' | 'big_endian' | 'little_endian' ;
+   exception: mode ':' unit_list | unit_list ;
+   unit_list: unit_spec | unit_list unit_spec ;
+   unit_spec: INTEGER | INTEGER '-' INTEGER ;
+*/
+
+/* Defines for the tokens.  Other valid tokens are ',', ':', '-'.  */
+
+
+#define NATIVE   257
+#define SWAP     258
+#define BIG      259
+#define LITTLE   260
+/* Some space for additional tokens later.  */
+#define INTEGER  273
+#define END      (-1)
+#define ILLEGAL  (-2)
+
+typedef struct
+{
+  int unit;
+  unit_convert conv;
+} exception_t;
+
+
+static char *p;            /* Main character pointer for parsing.  */
+static char *lastpos;      /* Auxiliary pointer, for backing up.  */
+static int unit_num;       /* The last unit number read.  */
+static int unit_count;     /* The number of units found. */
+static int do_count;       /* Parsing is done twice - first to count the number
+			      of units, then to fill in the table.  This
+			      variable controls what to do.  */
+static exception_t *elist; /* The list of exceptions to the default. This is
+			      sorted according to unit number.  */
+static int n_elist;        /* Number of exceptions to the default.  */
+
+static unit_convert endian; /* Current endianness.  */
+
+static unit_convert def; /* Default as specified (if any).  */
+
+/* Search for a unit number, using a binary search.  The
+   first argument is the unit number to search for.  The second argument
+   is a pointer to an index.
+   If the unit number is found, the function returns 1, and the index
+   is that of the element.
+   If the unit number is not found, the function returns 0, and the
+   index is the one where the element would be inserted.  */
+
+static int
+search_unit (int unit, int *ip)
+{
+  int low, high, mid;
+
+  low = -1;
+  high = n_elist;
+  while (high - low > 1)
+    {
+      mid = (low + high) / 2;
+      if (unit <= elist[mid].unit)
+	high = mid;
+      else
+	low = mid;
+    }
+  *ip = high;
+  if (elist[high].unit == unit)
+    return 1;
+  else
+    return 0;
+}
+
+/* This matches a keyword.  If it is found, return the token supplied,
+   otherwise return ILLEGAL.  */
+
+static int
+match_word (const char *word, int tok)
+{
+  int res;
+
+  if (strncasecmp (p, word, strlen (word)) == 0)
+    {
+      p += strlen (word);
+      res = tok;
+    }
+  else
+    res = ILLEGAL;
+  return res;
+
+}
+
+/* Match an integer and store its value in unit_num.  This only works
+   if p actually points to the start of an integer.  The caller has
+   to ensure this.  */
+
+static int
+match_integer (void)
+{
+  unit_num = 0;
+  while (isdigit (*p))
+    unit_num = unit_num * 10 + (*p++ - '0');
+  return INTEGER;
+
+}
+
+/* This reads the next token from the GFORTRAN_CONVERT_UNITS variable.
+   Returned values are the different tokens.  */
+
+static int
+next_token (void)
+{
+  int result;
+
+  lastpos = p;
+  switch (*p)
+    {
+    case '\0':
+      result = END;
+      break;
+      
+    case ':':
+    case ',': 
+    case '-':
+    case ';':
+      result = *p;
+      p++;
+      break;
+
+    case 'b':
+    case 'B':
+      result = match_word ("big_endian", BIG);
+      break;
+
+    case 'l':
+    case 'L':
+      result = match_word ("little_endian", LITTLE);
+      break;
+
+    case 'n':
+    case 'N':
+      result = match_word ("native", NATIVE);
+      break;
+
+    case 's':
+    case 'S':
+      result = match_word ("swap", SWAP);
+      break;
+
+    case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+      result = match_integer ();
+      break;
+
+    default:
+      result = ILLEGAL;
+      break;
+    }
+  return result;
+}
+
+/* Back up the last token by setting back the character pointer.  */
+
+static void
+push_token (void)
+{
+  p = lastpos;
+}
+
+/* This is called when a unit is identified.  If do_count is nonzero,
+   increment the number of units by one.  If do_count is zero,
+   put the unit into the table.  */
+
+static void
+mark_single (int unit)
+{
+  int i,j;
+
+  if (do_count)
+    {
+      unit_count++;
+      return;
+    }
+  if (search_unit (unit, &i))
+    {
+      elist[unit].conv = endian;
+    }
+  else
+    {
+      for (j=n_elist; j>=i; j--)
+	elist[j+1] = elist[j];
+    
+      n_elist += 1;
+      elist[i].unit = unit;
+      elist[i].conv = endian;
+    }
+}
+
+/* This is called when a unit range is identified.  If do_count is
+   nonzero, increase the number of units.  If do_count is zero,
+   put the unit into the table.  */
+
+static void
+mark_range (int unit1, int unit2)
+{
+  int i;
+  if (do_count)
+    unit_count += abs (unit2 - unit1) + 1;
+  else
+    {
+      if (unit2 < unit1)
+	for (i=unit2; i<=unit1; i++)
+	  mark_single (i);
+      else
+	for (i=unit1; i<=unit2; i++)
+	  mark_single (i);
+    }
+}
+
+/* Parse the GFORTRAN_CONVERT_UNITS variable.  This is called
+   twice, once to count the units and once to actually mark them in
+   the table.  When counting, we don't check for double occurences
+   of units.  */
+
+static int
+do_parse (void)
+{
+  int tok, def;
+  int unit1;
+  int continue_ulist;
+  char *start;
+
+  unit_count = 0;
+
+  def = 0;
+  start = p;
+
+  /* Parse the string.  First, let's look for a default.  */
+  tok = next_token ();
+  switch (tok)
+    {
+    case NATIVE:
+      endian = CONVERT_NATIVE;
+      break;
+
+    case SWAP:
+      endian = CONVERT_SWAP;
+      break;
+
+    case BIG:
+      endian = CONVERT_BIG;
+      break;
+
+    case LITTLE:
+      endian = CONVERT_LITTLE;
+      break;
+
+    case INTEGER:
+      /* A leading digit means that we are looking at an exception.
+	 Reset the position to the beginning, and continue processing
+	 at the exception list.  */
+      p = start;
+      goto exceptions;
+      break;
+
+    case END:
+      goto end;
+      break;
+
+    default:
+      goto error;
+      break;
+    }
+
+  tok = next_token ();
+  switch (tok)
+    {
+    case ';':
+      def = endian;
+      break;
+
+    case ':':
+      /* This isn't a default after all.  Reset the position to the
+	 beginning, and continue processing at the exception list.  */
+      p = start;
+      goto exceptions;
+      break;
+
+    case END:
+      goto end;
+      break;
+
+    default:
+      goto error;
+      break;
+    }
+
+ exceptions:
+
+  /* Loop over all exceptions.  */
+  while(1)
+    {
+      tok = next_token ();
+      switch (tok)
+	{
+	case LITTLE:
+	  if (next_token () != ':')
+	    goto error;
+	  endian = CONVERT_LITTLE;
+	  break;
+
+	case BIG:
+	  if (next_token () != ':')
+	    goto error;
+	  endian = CONVERT_BIG;
+	  break;
+
+	case INTEGER:
+	  push_token ();
+	  break;
+
+	case END:
+	  goto end;
+	  break;
+
+	default:
+	  goto error;
+	  break;
+	}
+      /* We arrive here when we want to parse a list of
+	 numbers.  */
+      continue_ulist = 1;
+      do
+	{
+	  tok = next_token ();
+	  if (tok != INTEGER)
+	    goto error;
+
+	  unit1 = unit_num;
+	  tok = next_token ();
+	  /* The number can be followed by a - and another number,
+	     which means that this is a unit range, a comma
+	     or a semicolon.  */
+	  if (tok == '-')
+	    {
+	      if (next_token () != INTEGER)
+		goto error;
+
+	      mark_range (unit1, unit_num);
+	      tok = next_token ();
+	      if (tok == END)
+		goto end;
+	      else if (tok == ';')
+		continue_ulist = 0;
+	      else if (tok != ',')
+		goto error;
+	    }
+	  else
+	    {
+	      mark_single (unit1);
+	      switch (tok)
+		{
+		case ';':
+		  continue_ulist = 0;
+		  break;
+
+		case ',':
+		  break;
+
+		case END:
+		  goto end;
+		  break;
+
+		default:
+		  goto error;
+		}
+	    }
+	} while (continue_ulist);
+    }
+ end:
+  return 0;
+ error:
+  def = CONVERT_NONE;
+  return -1;
+}
+
+void init_unformatted (variable * v)
+{
+  char *val;
+  val = getenv (v->name);
+  def = CONVERT_NONE;
+  n_elist = 0;
+
+  if (val == NULL)
+    return;
+  do_count = 1;
+  p = val;
+  do_parse ();
+  if (do_count <= 0)
+    {
+      n_elist = 0;
+      elist = NULL;
+    }
+  else
+    {
+      elist = get_mem (unit_count * sizeof (exception_t));
+      do_count = 0;
+      p = val;
+      do_parse ();
+    }
+}
+
+/* Get the default conversion for for an unformatted unit.  */
+
+unit_convert
+get_unformatted_convert (int unit)
+{
+  int i;
+
+  if (elist == NULL)
+    return def;
+  else if (search_unit (unit, &i))
+    return elist[i].conv;
+  else
+    return def;
+}