X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=libgfortran%2Fio%2Funix.c;h=1158458879e55e92f3f3a28283b8cbf0a3982927;hb=5df4b62febf4a92175add2e154726fc4ae5850a8;hp=03dc66f58d04455e2ab4f75ba3914528bbe79d93;hpb=91e6f54a8b4fc8646c729e5d1f44cd6037dc78f5;p=pf3gnuchains%2Fgcc-fork.git

diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 03dc66f58d0..1158458879e 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+/* 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).
@@ -8,6 +9,15 @@ 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
@@ -54,6 +64,24 @@ Boston, MA 02111-1307, USA.  */
 #define PROT_WRITE 2
 #endif
 
+/* These flags aren't defined on all targets (mingw32), so provide them
+   here.  */
+#ifndef S_IRGRP
+#define S_IRGRP 0
+#endif
+
+#ifndef S_IWGRP
+#define S_IWGRP 0
+#endif
+
+#ifndef S_IROTH
+#define S_IROTH 0
+#endif
+
+#ifndef S_IWOTH
+#define S_IWOTH 0
+#endif
+
 /* This implementation of stream I/O is based on the paper:
  *
  *  "Exploiting the advantages of mapped files for stream I/O",
@@ -126,26 +154,22 @@ move_pos_offset (stream* st, int pos_off)
   unix_stream * str = (unix_stream*)st;
   if (pos_off < 0)
     {
-      str->active  += pos_off;
-      if (str->active < 0)
-         str->active = 0;
+      str->logical_offset += pos_off;
 
-      str->logical_offset  += pos_off;
-
-      if (str->dirty_offset+str->ndirty > str->logical_offset)
+      if (str->dirty_offset + str->ndirty > str->logical_offset)
         {
-          if (str->ndirty +  pos_off > 0)
-            str->ndirty += pos_off ;
+          if (str->ndirty + pos_off > 0)
+            str->ndirty += pos_off;
           else
             {
               str->dirty_offset +=  pos_off + pos_off;
-              str->ndirty = 0 ;
+              str->ndirty = 0;
             }
         }
 
-    return pos_off ;
+    return pos_off;
   }
-  return 0 ;
+  return 0;
 }
 
 
@@ -163,8 +187,8 @@ fix_fd (int fd)
 
   input = output = error = 0;
 
-/* Unix allocates the lowest descriptors first, so a loop is not
- * required, but this order is. */
+  /* Unix allocates the lowest descriptors first, so a loop is not
+     required, but this order is. */
 
   if (fd == STDIN_FILENO)
     {
@@ -253,7 +277,6 @@ readn (int fd, char *buffer, int len)
 const char *
 get_oserror (void)
 {
-
   return strerror (errno);
 }
 
@@ -263,12 +286,10 @@ get_oserror (void)
 void
 sys_exit (int code)
 {
-
   exit (code);
 }
 
 
-
 /*********************************************************************
     File descriptor stream functions
 *********************************************************************/
@@ -278,7 +299,6 @@ sys_exit (int code)
 static try
 fd_flush (unix_stream * s)
 {
-
   if (s->ndirty == 0)
     return SUCCESS;;
 
@@ -306,7 +326,8 @@ fd_flush (unix_stream * s)
  * to come next. */
 
 static void
-fd_alloc (unix_stream * s, gfc_offset where, int *len)
+fd_alloc (unix_stream * s, gfc_offset where,
+	  int *len __attribute__ ((unused)))
 {
   char *new_buffer;
   int n, read_len;
@@ -445,6 +466,9 @@ fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
 
   s->logical_offset = where + *len;
 
+  if (where + *len > s->file_length)
+    s->file_length = where + *len;
+
   n = s->logical_offset - s->buffer_offset;
   if (n > s->active)
     s->active = n;
@@ -456,7 +480,6 @@ fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
 static try
 fd_sfree (unix_stream * s)
 {
-
   if (s->ndirty != 0 &&
       (s->buffer != s->small_buffer || options.all_unbuffered ||
        s->unbuffered))
@@ -469,7 +492,6 @@ fd_sfree (unix_stream * s)
 static int
 fd_seek (unix_stream * s, gfc_offset offset)
 {
-
   s->physical_offset = s->logical_offset = offset;
 
   return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
@@ -483,17 +505,23 @@ fd_seek (unix_stream * s, gfc_offset offset)
 static try
 fd_truncate (unix_stream * s)
 {
-
   if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
     return FAILURE;
 
   /* non-seekable files, like terminals and fifo's fail the lseek.
      the fd is a regular file at this point */
 
+#ifdef HAVE_FTRUNCATE
   if (ftruncate (s->fd, s->logical_offset))
-   {
-    return FAILURE;
-   }
+#else
+#ifdef HAVE_CHSIZE
+  if (chsize (s->fd, s->logical_offset))
+#endif
+#endif
+    {
+      s->physical_offset = s->file_length = 0;
+      return FAILURE;
+    }
 
   s->physical_offset = s->file_length = s->logical_offset;
 
@@ -504,15 +532,17 @@ fd_truncate (unix_stream * s)
 static try
 fd_close (unix_stream * s)
 {
-
   if (fd_flush (s) == FAILURE)
     return FAILURE;
 
   if (s->buffer != NULL && s->buffer != s->small_buffer)
     free_mem (s->buffer);
 
-  if (close (s->fd) < 0)
-    return FAILURE;
+  if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO)
+    {
+      if (close (s->fd) < 0)
+        return FAILURE;
+    }
 
   free_mem (s);
 
@@ -523,7 +553,6 @@ fd_close (unix_stream * s)
 static void
 fd_open (unix_stream * s)
 {
-
   if (isatty (s->fd))
     s->unbuffered = 1;
 
@@ -558,7 +587,6 @@ static int page_size, page_mask;
 static try
 mmap_flush (unix_stream * s)
 {
-
   if (!s->mmaped)
     return fd_flush (s);
 
@@ -579,7 +607,8 @@ mmap_flush (unix_stream * s)
  * guaranteed to be mappable. */
 
 static try
-mmap_alloc (unix_stream * s, gfc_offset where, int *len)
+mmap_alloc (unix_stream * s, gfc_offset where,
+	    int *len __attribute__ ((unused)))
 {
   gfc_offset offset;
   int length;
@@ -649,7 +678,8 @@ mmap_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
     }
 
   if ((s->buffer == NULL || s->buffer_offset > where ||
-       where + *len > s->buffer_offset + s->active) &&
+       where + *len > s->buffer_offset + s->active ||
+       where < s->buffer_offset + s->active) &&
       mmap_alloc (s, where, len) == FAILURE)
     return NULL;
 
@@ -662,7 +692,6 @@ mmap_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
 static int
 mmap_seek (unix_stream * s, gfc_offset offset)
 {
-
   s->logical_offset = offset;
   return SUCCESS;
 }
@@ -684,9 +713,8 @@ mmap_close (unix_stream * s)
 
 
 static try
-mmap_sfree (unix_stream * s)
+mmap_sfree (unix_stream * s __attribute__ ((unused)))
 {
-
   return SUCCESS;
 }
 
@@ -695,7 +723,7 @@ mmap_sfree (unix_stream * s)
  * mmap()-ed, we fall back to the file descriptor functions. */
 
 static try
-mmap_open (unix_stream * s)
+mmap_open (unix_stream * s __attribute__ ((unused)))
 {
   char *p;
   int i;
@@ -789,7 +817,6 @@ mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
 static int
 mem_seek (unix_stream * s, gfc_offset offset)
 {
-
   if (offset > s->file_length)
     {
       errno = ESPIPE;
@@ -802,9 +829,8 @@ mem_seek (unix_stream * s, gfc_offset offset)
 
 
 static int
-mem_truncate (unix_stream * s)
+mem_truncate (unix_stream * s __attribute__ ((unused)))
 {
-
   return SUCCESS;
 }
 
@@ -819,9 +845,8 @@ mem_close (unix_stream * s)
 
 
 static try
-mem_sfree (unix_stream * s)
+mem_sfree (unix_stream * s __attribute__ ((unused)))
 {
-
   return SUCCESS;
 }
 
@@ -837,8 +862,8 @@ mem_sfree (unix_stream * s)
 void
 empty_internal_buffer(stream *strm)
 {
-   unix_stream * s = (unix_stream *) strm;
-   memset(s->buffer, ' ', s->file_length);
+  unix_stream * s = (unix_stream *) strm;
+  memset(s->buffer, ' ', s->file_length);
 }
 
 /* open_internal()-- Returns a stream structure from an internal file */
@@ -849,6 +874,7 @@ open_internal (char *base, int length)
   unix_stream *s;
 
   s = get_mem (sizeof (unix_stream));
+  memset (s, '\0', sizeof (unix_stream));
 
   s->buffer = base;
   s->buffer_offset = 0;
@@ -871,12 +897,13 @@ open_internal (char *base, int length)
  * around it. */
 
 static stream *
-fd_to_stream (int fd, int prot)
+fd_to_stream (int fd, int prot, int avoid_mmap)
 {
   struct stat statbuf;
   unix_stream *s;
 
   s = get_mem (sizeof (unix_stream));
+  memset (s, '\0', sizeof (unix_stream));
 
   s->fd = fd;
   s->buffer_offset = 0;
@@ -890,7 +917,10 @@ fd_to_stream (int fd, int prot)
   s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
 
 #if HAVE_MMAP
-  mmap_open (s);
+  if (avoid_mmap)
+    fd_open (s);
+  else
+    mmap_open (s);
 #else
   fd_open (s);
 #endif
@@ -899,6 +929,21 @@ fd_to_stream (int fd, int prot)
 }
 
 
+/* Given the Fortran unit number, convert it to a C file descriptor.  */
+
+int
+unit_to_fd(int unit)
+{
+  gfc_unit *us;
+
+  us = find_unit(unit);
+  if (us == NULL)
+    return -1;
+
+  return ((unix_stream *) us->s)->fd;
+}
+
+
 /* unpack_filename()-- Given a fortran string and a pointer to a
  * buffer that is PATH_MAX characters, convert the fortran string to a
  * C string in the buffer.  Returns nonzero if this is not possible.  */
@@ -906,7 +951,6 @@ fd_to_stream (int fd, int prot)
 static int
 unpack_filename (char *cstring, const char *fstring, int len)
 {
-
   len = fstrlen (fstring, len);
   if (len >= PATH_MAX)
     return 1;
@@ -921,8 +965,8 @@ unpack_filename (char *cstring, const char *fstring, int len)
 /* tempfile()-- Generate a temporary filename for a scratch file and
  * open it.  mkstemp() opens the file for reading and writing, but the
  * library mode prevents anything that is not allowed.  The descriptor
- * is returns, which is less than zero on error.  The template is
- * pointed to by ioparm.file, which is copied into the unit structure
+ * is returned, which is -1 on error.  The template is pointed to by 
+ * ioparm.file, which is copied into the unit structure
  * and freed later. */
 
 static int
@@ -940,10 +984,23 @@ tempfile (void)
 
   template = get_mem (strlen (tempdir) + 20);
 
-  st_sprintf (template, "%s/gfortantmpXXXXXX", tempdir);
+  st_sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
+
+#ifdef HAVE_MKSTEMP
 
   fd = mkstemp (template);
 
+#else /* HAVE_MKSTEMP */
+
+  if (mktemp (template))
+    do
+      fd = open (template, O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
+    while (!(fd == -1 && errno == EEXIST) && mktemp (template));
+  else
+    fd = -1;
+
+#endif /* HAVE_MKSTEMP */
+
   if (fd < 0)
     free_mem (template);
   else
@@ -956,14 +1013,19 @@ tempfile (void)
 }
 
 
-/* regular_file()-- Open a regular file.  Returns the descriptor, which is less than zero on error. */
+/* regular_file()-- Open a regular file.
+ * Change flags->action if it is ACTION_UNSPECIFIED on entry,
+ * unless an error occurs.
+ * Returns the descriptor, which is less than zero on error. */
 
 static int
-regular_file (unit_action action, unit_status status)
+regular_file (unit_flags *flags)
 {
   char path[PATH_MAX + 1];
-  struct stat statbuf;
   int mode;
+  int rwflag;
+  int crflag;
+  int fd;
 
   if (unpack_filename (path, ioparm.file, ioparm.file_len))
     {
@@ -971,73 +1033,118 @@ regular_file (unit_action action, unit_status status)
       return -1;
     }
 
-  mode = 0;
+  rwflag = 0;
 
-  switch (action)
+  switch (flags->action)
     {
     case ACTION_READ:
-      mode = O_RDONLY;
+      rwflag = O_RDONLY;
       break;
 
     case ACTION_WRITE:
-      mode = O_WRONLY;
+      rwflag = O_WRONLY;
       break;
 
     case ACTION_READWRITE:
-      mode = O_RDWR;
+    case ACTION_UNSPECIFIED:
+      rwflag = O_RDWR;
       break;
 
     default:
       internal_error ("regular_file(): Bad action");
     }
 
-  switch (status)
+  switch (flags->status)
     {
     case STATUS_NEW:
-      mode |= O_CREAT | O_EXCL;
+      crflag = O_CREAT | O_EXCL;
       break;
 
-    case STATUS_OLD:		/* file must exist, so check for its existence */
-      if (stat (path, &statbuf) < 0)
-	return -1;
+    case STATUS_OLD:		/* open will fail if the file does not exist*/
+      crflag = 0;
       break;
 
     case STATUS_UNKNOWN:
     case STATUS_SCRATCH:
-      mode |= O_CREAT;
+      crflag = O_CREAT;
       break;
 
     case STATUS_REPLACE:
-        mode |= O_CREAT | O_TRUNC;
+        crflag = O_CREAT | O_TRUNC;
       break;
 
     default:
       internal_error ("regular_file(): Bad status");
     }
 
-  // mode |= O_LARGEFILE;
+  /* rwflag |= O_LARGEFILE; */
+
+  mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH;
+  fd = open (path, rwflag | crflag, mode);
+  if (flags->action != ACTION_UNSPECIFIED)
+      return fd;
 
-  return open (path, mode,
-	       S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
+  if (fd >= 0)
+    {
+      flags->action = ACTION_READWRITE;
+      return fd;
+    }
+  if (errno != EACCES)
+     return fd;
+
+  /* retry for read-only access */
+  rwflag = O_RDONLY;
+  fd = open (path, rwflag | crflag, mode);
+  if (fd >=0)
+    {
+      flags->action = ACTION_READ;
+      return fd;               /* success */
+    }
+  
+  if (errno != EACCES)
+    return fd;                 /* failure */
+
+  /* retry for write-only access */
+  rwflag = O_WRONLY;
+  fd = open (path, rwflag | crflag, mode);
+  if (fd >=0)
+    {
+      flags->action = ACTION_WRITE;
+      return fd;               /* success */
+    }
+  return fd;                   /* failure */
 }
 
 
 /* open_external()-- Open an external file, unix specific version.
+ * Change flags->action if it is ACTION_UNSPECIFIED on entry.
  * Returns NULL on operating system error. */
 
 stream *
-open_external (unit_action action, unit_status status)
+open_external (unit_flags *flags)
 {
   int fd, prot;
 
-  fd =
-    (status == STATUS_SCRATCH) ? tempfile () : regular_file (action, status);
+  if (flags->status == STATUS_SCRATCH)
+    {
+      fd = tempfile ();
+      if (flags->action == ACTION_UNSPECIFIED)
+        flags->action = ACTION_READWRITE;
+      /* We can unlink scratch files now and it will go away when closed. */
+      unlink (ioparm.file);
+    }
+  else
+    {
+      /* regular_file resets flags->action if it is ACTION_UNSPECIFIED and
+       * if it succeeds */
+      fd = regular_file (flags);
+    }
 
   if (fd < 0)
     return NULL;
   fd = fix_fd (fd);
 
-  switch (action)
+  switch (flags->action)
     {
     case ACTION_READ:
       prot = PROT_READ;
@@ -1055,13 +1162,7 @@ open_external (unit_action action, unit_status status)
       internal_error ("open_external(): Bad action");
     }
 
-  /* If this is a scratch file, we can unlink it now and the file will
-   * go away when it is closed. */
-
-  if (status == STATUS_SCRATCH)
-    unlink (ioparm.file);
-
-  return fd_to_stream (fd, prot);
+  return fd_to_stream (fd, prot, 0);
 }
 
 
@@ -1071,22 +1172,29 @@ open_external (unit_action action, unit_status status)
 stream *
 input_stream (void)
 {
-
-  return fd_to_stream (STDIN_FILENO, PROT_READ);
+  return fd_to_stream (STDIN_FILENO, PROT_READ, 1);
 }
 
 
-/* output_stream()-- Return a stream pointer to the default input stream.
+/* output_stream()-- Return a stream pointer to the default output stream.
  * Called on initialization. */
 
 stream *
 output_stream (void)
 {
-
-  return fd_to_stream (STDOUT_FILENO, PROT_WRITE);
+  return fd_to_stream (STDOUT_FILENO, PROT_WRITE, 1);
 }
 
 
+/* error_stream()-- Return a stream pointer to the default error stream.
+ * Called on initialization. */
+
+stream *
+error_stream (void)
+{
+  return fd_to_stream (STDERR_FILENO, PROT_WRITE, 1);
+}
+
 /* init_error_stream()-- Return a pointer to the error stream.  This
  * subroutine is called when the stream is needed, rather than at
  * initialization.  We want to work even if memory has been seriously
@@ -1190,10 +1298,10 @@ stream_at_bof (stream * s)
 {
   unix_stream *us;
 
-  us = (unix_stream *) s;
+  if (!is_seekable (s))
+    return 0;
 
-  if (!us->mmaped)
-    return 0;			/* File is not seekable */
+  us = (unix_stream *) s;
 
   return us->logical_offset == 0;
 }
@@ -1207,10 +1315,10 @@ stream_at_eof (stream * s)
 {
   unix_stream *us;
 
-  us = (unix_stream *) s;
+  if (!is_seekable (s))
+    return 0;
 
-  if (!us->mmaped)
-    return 0;			/* File is not seekable */
+  us = (unix_stream *) s;
 
   return us->logical_offset == us->dirty_offset;
 }
@@ -1336,7 +1444,6 @@ inquire_formatted (const char *string, int len)
 const char *
 inquire_unformatted (const char *string, int len)
 {
-
   return inquire_formatted (string, len);
 }
 
@@ -1363,7 +1470,6 @@ inquire_access (const char *string, int len, int mode)
 const char *
 inquire_read (const char *string, int len)
 {
-
   return inquire_access (string, len, R_OK);
 }
 
@@ -1374,7 +1480,6 @@ inquire_read (const char *string, int len)
 const char *
 inquire_write (const char *string, int len)
 {
-
   return inquire_access (string, len, W_OK);
 }
 
@@ -1385,7 +1490,6 @@ inquire_write (const char *string, int len)
 const char *
 inquire_readwrite (const char *string, int len)
 {
-
   return inquire_access (string, len, R_OK | W_OK);
 }
 
@@ -1395,7 +1499,6 @@ inquire_readwrite (const char *string, int len)
 gfc_offset
 file_length (stream * s)
 {
-
   return ((unix_stream *) s)->file_length;
 }
 
@@ -1405,7 +1508,6 @@ file_length (stream * s)
 gfc_offset
 file_position (stream * s)
 {
-
   return ((unix_stream *) s)->logical_offset;
 }