re PR libfortran/27107 (Make dependency on io/io.h broken)

	PR libfortran/27107
	* runtime/environ.c: Don't include io/io.h.
	* runtime/string.c: Don't include io/io.h.
	(compare0): Add cast to avoid warning.
	* runtime/error.c: Don't include io/io.h.
	(st_printf): Move to io/unix.c.
	* intrinsics/flush.c: Delete, contents moved to io/intrinsics.c.
	* intrinsics/fget.c: Likewise.
	* intrinsics/ftell.c: Likewise.
	* intrinsics/tty.c: Likewise.
	* libgfortran.h (DEFAULT_RECL, notification_std,
	get_unformatted_convert, IOPARM_*, st_parameter_common, unit_convert,
	DEFAULT_TEMPDIR): New declarations.
	* io/io.h (DEFAULT_RECL, notification_std, get_unformatted_convert,
	IOPARM_*, st_parameter_common, unit_convert, DEFAULT_TEMPDIR):
	Move to libgfortran.h.
	* io/unix.c: Add io/unix.h content.
	(st_printf): New function.
	* io/intrinsics.c: New file.
	* io/unix.h: Remove, contents moved into unix.c.
	* libtool-version: Update library version to 3.0.0.
	* configure.ac: Update library version to 0.3.
	* Makefile.am (intrinsics/fget.c, intrinsics/flush.c,
	intrinsics/ftell.c, intrinsics/tty.c, libgfortran.h): Remove targets.
	* Makefile.in: Regenerate.
	* configure: Regenerate.

From-SVN: r120869

4 files changed, 502 insertions, 122 deletions

diff --git a/libgfortran/io/intrinsics.c b/libgfortran/io/intrinsics.c
new file mode 100644
index 0000000..ab99b25
--- /dev/null
+++ b/libgfortran/io/intrinsics.c
@@ -0,0 +1,367 @@
+/* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH 
+   FTELL, TTYNAM and ISATTY intrinsics.
+   Copyright (C) 2005, 2007 Free Software Foundation, Inc.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
+#include <string.h>
+
+#include "io.h"
+
+static const int five = 5;
+static const int six = 6;
+
+extern int PREFIX(fgetc) (const int *, char *, gfc_charlen_type);
+export_proto_np(PREFIX(fgetc));
+
+int
+PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
+{
+  int ret;
+  size_t s;
+  gfc_unit * u = find_unit (*unit);
+
+  if (u == NULL)
+    return -1;
+
+  s = 1;
+  memset (c, ' ', c_len);
+  ret = sread (u->s, c, &s);
+  unlock_unit (u);
+
+  if (ret != 0)
+    return ret;
+
+  if (s != 1)
+    return -1;
+  else
+    return 0;
+}
+
+
+#define FGETC_SUB(kind) \
+  extern void fgetc_i ## kind ## _sub \
+    (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
+  export_proto(fgetc_i ## kind ## _sub); \
+  void fgetc_i ## kind ## _sub \
+  (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+    { if (st != NULL) \
+        *st = PREFIX(fgetc) (unit, c, c_len); \
+      else \
+        PREFIX(fgetc) (unit, c, c_len); }
+
+FGETC_SUB(1)
+FGETC_SUB(2)
+FGETC_SUB(4)
+FGETC_SUB(8)
+
+
+extern int PREFIX(fget) (char *, gfc_charlen_type);
+export_proto_np(PREFIX(fget));
+
+int
+PREFIX(fget) (char * c, gfc_charlen_type c_len)
+{
+  return PREFIX(fgetc) (&five, c, c_len);
+}
+
+
+#define FGET_SUB(kind) \
+  extern void fget_i ## kind ## _sub \
+    (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
+  export_proto(fget_i ## kind ## _sub); \
+  void fget_i ## kind ## _sub \
+  (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+    { if (st != NULL) \
+        *st = PREFIX(fgetc) (&five, c, c_len); \
+      else \
+        PREFIX(fgetc) (&five, c, c_len); }
+
+FGET_SUB(1)
+FGET_SUB(2)
+FGET_SUB(4)
+FGET_SUB(8)
+
+
+
+extern int PREFIX(fputc) (const int *, char *, gfc_charlen_type);
+export_proto_np(PREFIX(fputc));
+
+int
+PREFIX(fputc) (const int * unit, char * c,
+	       gfc_charlen_type c_len __attribute__((unused)))
+{
+  size_t s;
+  int ret;
+  gfc_unit * u = find_unit (*unit);
+
+  if (u == NULL)
+    return -1;
+
+  s = 1;
+  ret = swrite (u->s, c, &s);
+  unlock_unit (u);
+  return ret;
+}
+
+
+#define FPUTC_SUB(kind) \
+  extern void fputc_i ## kind ## _sub \
+    (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
+  export_proto(fputc_i ## kind ## _sub); \
+  void fputc_i ## kind ## _sub \
+  (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+    { if (st != NULL) \
+        *st = PREFIX(fputc) (unit, c, c_len); \
+      else \
+        PREFIX(fputc) (unit, c, c_len); }
+
+FPUTC_SUB(1)
+FPUTC_SUB(2)
+FPUTC_SUB(4)
+FPUTC_SUB(8)
+
+
+extern int PREFIX(fput) (char *, gfc_charlen_type);
+export_proto_np(PREFIX(fput));
+
+int
+PREFIX(fput) (char * c, gfc_charlen_type c_len)
+{
+  return PREFIX(fputc) (&six, c, c_len);
+}
+
+
+#define FPUT_SUB(kind) \
+  extern void fput_i ## kind ## _sub \
+    (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
+  export_proto(fput_i ## kind ## _sub); \
+  void fput_i ## kind ## _sub \
+  (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+    { if (st != NULL) \
+        *st = PREFIX(fputc) (&six, c, c_len); \
+      else \
+        PREFIX(fputc) (&six, c, c_len); }
+
+FPUT_SUB(1)
+FPUT_SUB(2)
+FPUT_SUB(4)
+FPUT_SUB(8)
+
+
+/* SUBROUTINE FLUSH(UNIT)
+   INTEGER, INTENT(IN), OPTIONAL :: UNIT  */
+
+extern void flush_i4 (GFC_INTEGER_4 *);
+export_proto(flush_i4);
+
+void
+flush_i4 (GFC_INTEGER_4 *unit)
+{
+  gfc_unit *us;
+
+  /* flush all streams */
+  if (unit == NULL)
+    flush_all_units ();
+  else
+    {
+      us = find_unit (*unit);
+      if (us != NULL)
+	{
+	  flush (us->s);
+	  unlock_unit (us);
+	}
+    }
+}
+
+
+extern void flush_i8 (GFC_INTEGER_8 *);
+export_proto(flush_i8);
+
+void
+flush_i8 (GFC_INTEGER_8 *unit)
+{
+  gfc_unit *us;
+
+  /* flush all streams */
+  if (unit == NULL)
+    flush_all_units ();
+  else
+    {
+      us = find_unit (*unit);
+      if (us != NULL)
+	{
+	  flush (us->s);
+	  unlock_unit (us);
+	}
+    }
+}
+
+
+/* FTELL intrinsic */
+
+extern size_t PREFIX(ftell) (int *);
+export_proto_np(PREFIX(ftell));
+
+size_t
+PREFIX(ftell) (int * unit)
+{
+  gfc_unit * u = find_unit (*unit);
+  size_t ret;
+  if (u == NULL)
+    return ((size_t) -1);
+  ret = (size_t) stream_offset (u->s);
+  unlock_unit (u);
+  return ret;
+}
+
+#define FTELL_SUB(kind) \
+  extern void ftell_i ## kind ## _sub (int *, GFC_INTEGER_ ## kind *); \
+  export_proto(ftell_i ## kind ## _sub); \
+  void \
+  ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \
+  { \
+    gfc_unit * u = find_unit (*unit); \
+    if (u == NULL) \
+      *offset = -1; \
+    else \
+      { \
+	*offset = stream_offset (u->s); \
+	unlock_unit (u); \
+      } \
+  }
+
+FTELL_SUB(1)
+FTELL_SUB(2)
+FTELL_SUB(4)
+FTELL_SUB(8)
+
+
+
+/* LOGICAL FUNCTION ISATTY(UNIT)
+   INTEGER, INTENT(IN) :: UNIT */
+
+extern GFC_LOGICAL_4 isatty_l4 (int *);
+export_proto(isatty_l4);
+
+GFC_LOGICAL_4
+isatty_l4 (int *unit)
+{
+  gfc_unit *u;
+  GFC_LOGICAL_4 ret = 0;
+
+  u = find_unit (*unit);
+  if (u != NULL)
+    {
+      ret = (GFC_LOGICAL_4) stream_isatty (u->s);
+      unlock_unit (u);
+    }
+  return ret;
+}
+
+
+extern GFC_LOGICAL_8 isatty_l8 (int *);
+export_proto(isatty_l8);
+
+GFC_LOGICAL_8
+isatty_l8 (int *unit)
+{
+  gfc_unit *u;
+  GFC_LOGICAL_8 ret = 0;
+
+  u = find_unit (*unit);
+  if (u != NULL)
+    {
+      ret = (GFC_LOGICAL_8) stream_isatty (u->s);
+      unlock_unit (u);
+    }
+  return ret;
+}
+
+
+/* SUBROUTINE TTYNAM(UNIT,NAME)
+   INTEGER,SCALAR,INTENT(IN) :: UNIT
+   CHARACTER,SCALAR,INTENT(OUT) :: NAME */
+
+extern void ttynam_sub (int *, char *, gfc_charlen_type);
+export_proto(ttynam_sub);
+
+void
+ttynam_sub (int *unit, char * name, gfc_charlen_type name_len)
+{
+  gfc_unit *u;
+  char * n;
+  int i;
+
+  memset (name, ' ', name_len);
+  u = find_unit (*unit);
+  if (u != NULL)
+    {
+      n = stream_ttyname (u->s);
+      if (n != NULL)
+	{
+	  i = 0;
+	  while (*n && i < name_len)
+	    name[i++] = *(n++);
+	}
+      unlock_unit (u);
+    }
+}
+
+
+extern void ttynam (char **, gfc_charlen_type *, int);
+export_proto(ttynam);
+
+void
+ttynam (char ** name, gfc_charlen_type * name_len, int unit)
+{
+  gfc_unit *u;
+
+  u = find_unit (unit);
+  if (u != NULL)
+    {
+      *name = stream_ttyname (u->s);
+      if (*name != NULL)
+	{
+	  *name_len = strlen (*name);
+	  *name = strdup (*name);
+	  unlock_unit (u);
+	  return;
+	}
+      unlock_unit (u);
+    }
+
+  *name_len = 0;
+  *name = NULL;
+}
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 314fc4c..8d8d592 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -35,8 +35,6 @@ Boston, MA 02110-1301, USA.  */
 
 #include <gthr.h>
 
-#define DEFAULT_TEMPDIR "/tmp"
-
 /* Basic types used in data transfers.  */
 
 typedef enum
@@ -205,10 +203,6 @@ typedef enum
 {READING, WRITING}
 unit_mode;
 
-typedef enum
-{ CONVERT_NONE=-1, CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
-unit_convert;
-
 #define CHARACTER1(name) \
 	      char * name; \
 	      gfc_charlen_type name ## _len
@@ -216,42 +210,6 @@ unit_convert;
 	      gfc_charlen_type name ## _len; \
 	      char * name
 
-#define IOPARM_LIBRETURN_MASK		(3 << 0)
-#define IOPARM_LIBRETURN_OK		(0 << 0)
-#define IOPARM_LIBRETURN_ERROR		(1 << 0)
-#define IOPARM_LIBRETURN_END		(2 << 0)
-#define IOPARM_LIBRETURN_EOR		(3 << 0)
-#define IOPARM_ERR			(1 << 2)
-#define IOPARM_END			(1 << 3)
-#define IOPARM_EOR			(1 << 4)
-#define IOPARM_HAS_IOSTAT		(1 << 5)
-#define IOPARM_HAS_IOMSG		(1 << 6)
-
-#define IOPARM_COMMON_MASK		((1 << 7) - 1)
-
-typedef struct st_parameter_common
-{
-  GFC_INTEGER_4 flags;
-  GFC_INTEGER_4 unit;
-  const char *filename;
-  GFC_INTEGER_4 line;
-  CHARACTER2 (iomsg);
-  GFC_INTEGER_4 *iostat;
-}
-st_parameter_common;
-
-#define IOPARM_OPEN_HAS_RECL_IN		(1 << 7)
-#define IOPARM_OPEN_HAS_FILE		(1 << 8)
-#define IOPARM_OPEN_HAS_STATUS		(1 << 9)
-#define IOPARM_OPEN_HAS_ACCESS		(1 << 10)
-#define IOPARM_OPEN_HAS_FORM		(1 << 11)
-#define IOPARM_OPEN_HAS_BLANK		(1 << 12)
-#define IOPARM_OPEN_HAS_POSITION	(1 << 13)
-#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
 {
   st_parameter_common common;
@@ -475,13 +433,6 @@ typedef struct
 unit_flags;
 
 
-/* The default value of record length for preconnected units is defined
-   here. This value can be overriden by an environment variable.
-   Default value is 1 Gb.  */
-
-#define DEFAULT_RECL 1073741824
-
-
 typedef struct gfc_unit
 {
   int unit_number;
@@ -877,10 +828,6 @@ extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
 				  size_t);
 internal_proto(list_formatted_write);
 
-/* error.c */
-extern notification notification_std(int);
-internal_proto(notification_std);
-
 /* size_from_kind.c */
 extern size_t size_from_real_kind (int);
 internal_proto(size_from_real_kind);
@@ -926,7 +873,3 @@ 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/unix.c b/libgfortran/io/unix.c
index 3419d72..aa1dd1f 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002, 2003, 2004, 2005
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -36,6 +36,7 @@ Boston, MA 02110-1301, USA.  */
 
 #include <unistd.h>
 #include <stdio.h>
+#include <stdarg.h>
 #include <sys/stat.h>
 #include <fcntl.h>
 #include <assert.h>
@@ -45,7 +46,6 @@ Boston, MA 02110-1301, USA.  */
 
 #include "libgfortran.h"
 #include "io.h"
-#include "unix.h"
 
 #ifndef SSIZE_MAX
 #define SSIZE_MAX SHRT_MAX
@@ -81,6 +81,42 @@ Boston, MA 02110-1301, USA.  */
 #define S_IWOTH 0
 #endif
 
+
+/* Unix stream I/O module */
+
+#define BUFFER_SIZE 8192
+
+typedef struct
+{
+  stream st;
+
+  int fd;
+  gfc_offset buffer_offset;	/* File offset of the start of the buffer */
+  gfc_offset physical_offset;	/* Current physical file offset */
+  gfc_offset logical_offset;	/* Current logical file offset */
+  gfc_offset dirty_offset;	/* Start of modified bytes in buffer */
+  gfc_offset file_length;	/* Length of the file, -1 if not seekable. */
+
+  char *buffer;
+  int len;			/* Physical length of the current buffer */
+  int active;			/* Length of valid bytes in the buffer */
+
+  int prot;
+  int ndirty;			/* Dirty bytes starting at dirty_offset */
+
+  int special_file;		/* =1 if the fd refers to a special file */
+
+  unsigned unbuffered:1;
+
+  char small_buffer[BUFFER_SIZE];
+
+}
+unix_stream;
+
+extern stream *init_error_stream (unix_stream *);
+internal_proto(init_error_stream);
+
+
 /* This implementation of stream I/O is based on the paper:
  *
  *  "Exploiting the advantages of mapped files for stream I/O",
@@ -1346,6 +1382,103 @@ init_error_stream (unix_stream *error)
   return (stream *) error;
 }
 
+/* st_printf()-- simple printf() function for streams that handles the
+ * formats %d, %s and %c.  This function handles printing of error
+ * messages that originate within the library itself, not from a user
+ * program. */
+
+int
+st_printf (const char *format, ...)
+{
+  int count, total;
+  va_list arg;
+  char *p;
+  const char *q;
+  stream *s;
+  char itoa_buf[GFC_ITOA_BUF_SIZE];
+  unix_stream err_stream;
+
+  total = 0;
+  s = init_error_stream (&err_stream);
+  va_start (arg, format);
+
+  for (;;)
+    {
+      count = 0;
+
+      while (format[count] != '%' && format[count] != '\0')
+	count++;
+
+      if (count != 0)
+	{
+	  p = salloc_w (s, &count);
+	  memmove (p, format, count);
+	  sfree (s);
+	}
+
+      total += count;
+      format += count;
+      if (*format++ == '\0')
+	break;
+
+      switch (*format)
+	{
+	case 'c':
+	  count = 1;
+
+	  p = salloc_w (s, &count);
+	  *p = (char) va_arg (arg, int);
+
+	  sfree (s);
+	  break;
+
+	case 'd':
+	  q = gfc_itoa (va_arg (arg, int), itoa_buf, sizeof (itoa_buf));
+	  count = strlen (q);
+
+	  p = salloc_w (s, &count);
+	  memmove (p, q, count);
+	  sfree (s);
+	  break;
+
+	case 'x':
+	  q = xtoa (va_arg (arg, unsigned), itoa_buf, sizeof (itoa_buf));
+	  count = strlen (q);
+
+	  p = salloc_w (s, &count);
+	  memmove (p, q, count);
+	  sfree (s);
+	  break;
+
+	case 's':
+	  q = va_arg (arg, char *);
+	  count = strlen (q);
+
+	  p = salloc_w (s, &count);
+	  memmove (p, q, count);
+	  sfree (s);
+	  break;
+
+	case '\0':
+	  return total;
+
+	default:
+	  count = 2;
+	  p = salloc_w (s, &count);
+	  p[0] = format[-1];
+	  p[1] = format[0];
+	  sfree (s);
+	  break;
+	}
+
+      total += count;
+      format++;
+    }
+
+  va_end (arg);
+  return total;
+}
+
 
 /* compare_file_filename()-- Given an open stream and a fortran string
  * that is a filename, figure out if the file is the same as the
diff --git a/libgfortran/io/unix.h b/libgfortran/io/unix.h
deleted file mode 100644
index 25508f1..0000000
--- a/libgfortran/io/unix.h
+++ /dev/null
@@ -1,63 +0,0 @@
-/* Copyright (C) 2002, 2003, 2004, 2005
-   Free Software Foundation, Inc.
-   Contributed by Andy Vaught
-
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
-
-Libgfortran is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file.  (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
-Libgfortran is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with Libgfortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA.  */
-
-/* Unix stream I/O module */
-
-#define BUFFER_SIZE 8192
-
-typedef struct
-{
-  stream st;
-
-  int fd;
-  gfc_offset buffer_offset;	/* File offset of the start of the buffer */
-  gfc_offset physical_offset;	/* Current physical file offset */
-  gfc_offset logical_offset;	/* Current logical file offset */
-  gfc_offset dirty_offset;	/* Start of modified bytes in buffer */
-  gfc_offset file_length;	/* Length of the file, -1 if not seekable. */
-
-  char *buffer;
-  int len;			/* Physical length of the current buffer */
-  int active;			/* Length of valid bytes in the buffer */
-
-  int prot;
-  int ndirty;			/* Dirty bytes starting at dirty_offset */
-
-  int special_file;		/* =1 if the fd refers to a special file */
-
-  unsigned unbuffered:1;
-
-  char small_buffer[BUFFER_SIZE];
-
-}
-unix_stream;
-
-extern stream *init_error_stream (unix_stream *);
-internal_proto(init_error_stream);