unix.c

gcc-fortran,linux使用fortran的编译软件。很好用的。

/* 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 */

#include "config.h"
#include <stdlib.h>
#include <limits.h>

#include <unistd.h>
#include <stdio.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <assert.h>

#include <string.h>
#include <errno.h>

#include "libgfortran.h"
#include "io.h"
#include "unix.h"

#ifndef SSIZE_MAX
#define SSIZE_MAX SHRT_MAX
#endif

#ifndef PATH_MAX
#define PATH_MAX 1024
#endif

#ifndef PROT_READ
#define PROT_READ 1
#endif

#ifndef PROT_WRITE
#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",
 *  O. Krieger, M. Stumm and R. Umrau, "Proceedings of the 1992 Winter
 *  USENIX conference", p. 27-42.
 *
 * It differs in a number of ways from the version described in the
 * paper.  First of all, threads are not an issue during I/O and we
 * also don't have to worry about having multiple regions, since
 * fortran's I/O model only allows you to be one place at a time.
 *
 * On the other hand, we have to be able to writing at the end of a
 * stream, read from the start of a stream or read and write blocks of
 * bytes from an arbitrary position.  After opening a file, a pointer
 * to a stream structure is returned, which is used to handle file
 * accesses until the file is closed.
 *
 * salloc_at_r(stream, len, where)-- Given a stream pointer, return a
 * pointer to a block of memory that mirror the file at position
 * 'where' that is 'len' bytes long.  The len integer is updated to
 * reflect how many bytes were actually read.  The only reason for a
 * short read is end of file.  The file pointer is updated.  The
 * pointer is valid until the next call to salloc_*.
 *
 * salloc_at_w(stream, len, where)-- Given the stream pointer, returns
 * a pointer to a block of memory that is updated to reflect the state
 * of the file.  The length of the buffer is always equal to that
 * requested.  The buffer must be completely set by the caller.  When
 * data has been written, the sfree() function must be called to
 * indicate that the caller is done writing data to the buffer.  This
 * may or may not cause a physical write.
 *
 * Short forms of these are salloc_r() and salloc_w() which drop the
 * 'where' parameter and use the current file pointer. */


/*move_pos_offset()--  Move the record pointer right or left
 *relative to current position */

int
move_pos_offset (stream* st, int pos_off)
{
  unix_stream * str = (unix_stream*)st;
  if (pos_off < 0)
    {
      str->logical_offset += pos_off;

      if (str->dirty_offset + str->ndirty > str->logical_offset)
        {
          if (str->ndirty + pos_off > 0)
            str->ndirty += pos_off;
          else
            {
              str->dirty_offset +=  pos_off + pos_off;
              str->ndirty = 0;
            }
        }

    return pos_off;
  }
  return 0;
}


/* fix_fd()-- Given a file descriptor, make sure it is not one of the
 * standard descriptors, returning a non-standard descriptor.  If the
 * user specifies that system errors should go to standard output,
 * then closes standard output, we don't want the system errors to a
 * file that has been given file descriptor 1 or 0.  We want to send
 * the error to the invalid descriptor. */

static int
fix_fd (int fd)
{
  int input, output, error;

  input = output = error = 0;

  /* Unix allocates the lowest descriptors first, so a loop is not
     required, but this order is. */

  if (fd == STDIN_FILENO)
    {
      fd = dup (fd);
      input = 1;
    }
  if (fd == STDOUT_FILENO)
    {
      fd = dup (fd);
      output = 1;
    }
  if (fd == STDERR_FILENO)
    {
      fd = dup (fd);
      error = 1;
    }

  if (input)
    close (STDIN_FILENO);
  if (output)
    close (STDOUT_FILENO);
  if (error)
    close (STDERR_FILENO);

  return fd;
}

int
is_preconnected (stream * s)
{
  int fd;

  fd = ((unix_stream *) s)->fd;
  if (fd == STDIN_FILENO || fd == STDOUT_FILENO || fd == STDERR_FILENO)
    return 1;
  else
    return 0;
}

/* If the stream corresponds to a preconnected unit, we flush the
   corresponding C stream.  This is bugware for mixed C-Fortran codes
   where the C code doesn't flush I/O before returning.  */
void
flush_if_preconnected (stream * s)
{
  int fd;

  fd = ((unix_stream *) s)->fd;
  if (fd == STDIN_FILENO)
    fflush (stdin);
  else if (fd == STDOUT_FILENO)
    fflush (stdout);
  else if (fd == STDERR_FILENO)
    fflush (stderr);
}


/* Reset a stream after reading/writing. Assumes that the buffers have
   been flushed.  */

inline static void
reset_stream (unix_stream * s, size_t bytes_rw)
{
  s->physical_offset += bytes_rw;
  s->logical_offset = s->physical_offset;
  if (s->file_length != -1 && s->physical_offset > s->file_length)
    s->file_length = s->physical_offset;
}


/* Read bytes into a buffer, allowing for short reads.  If the nbytes
 * argument is less on return than on entry, it is because we've hit
 * the end of file. */

static int
do_read (unix_stream * s, void * buf, size_t * nbytes)
{
  ssize_t trans;
  size_t bytes_left;
  char *buf_st;
  int status;

  status = 0;
  bytes_left = *nbytes;
  buf_st = (char *) buf;

  /* We must read in a loop since some systems don't restart system
     calls in case of a signal.  */
  while (bytes_left > 0)
    {
      /* Requests between SSIZE_MAX and SIZE_MAX are undefined by SUSv3,
	 so we must read in chunks smaller than SSIZE_MAX.  */
      trans = (bytes_left < SSIZE_MAX) ? bytes_left : SSIZE_MAX;
      trans = read (s->fd, buf_st, trans);
      if (trans < 0)
	{
	  if (errno == EINTR)
	    continue;
	  else
	    {
	      status = errno;
	      break;
	    }
	}
      else if (trans == 0) /* We hit EOF.  */
	break;
      buf_st += trans;
      bytes_left -= trans;
    }

  *nbytes -= bytes_left;
  return status;
}


/* Write a buffer to a stream, allowing for short writes.  */

static int
do_write (unix_stream * s, const void * buf, size_t * nbytes)
{
  ssize_t trans;
  size_t bytes_left;
  char *buf_st;
  int status;

  status = 0;
  bytes_left = *nbytes;
  buf_st = (char *) buf;

  /* We must write in a loop since some systems don't restart system
     calls in case of a signal.  */
  while (bytes_left > 0)
    {
      /* Requests between SSIZE_MAX and SIZE_MAX are undefined by SUSv3,
	 so we must write in chunks smaller than SSIZE_MAX.  */
      trans = (bytes_left < SSIZE_MAX) ? bytes_left : SSIZE_MAX;
      trans = write (s->fd, buf_st, trans);
      if (trans < 0)
	{
	  if (errno == EINTR)
	    continue;
	  else
	    {
	      status = errno;
	      break;
	    }
	}
      buf_st += trans;
      bytes_left -= trans;
    }

  *nbytes -= bytes_left;
  return status;
}


/* get_oserror()-- Get the most recent operating system error.  For
 * unix, this is errno. */

const char *
get_oserror (void)
{
  return strerror (errno);
}


/* sys_exit()-- Terminate the program with an exit code */

void
sys_exit (int code)
{
  exit (code);
}


/*********************************************************************
    File descriptor stream functions
*********************************************************************/


/* fd_flush()-- Write bytes that need to be written */

static try
fd_flush (unix_stream * s)
{
  size_t writelen;

  if (s->ndirty == 0)
    return SUCCESS;;

  if (s->physical_offset != s->dirty_offset &&
      lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
    return FAILURE;

  writelen = s->ndirty;
  if (do_write (s, s->buffer + (s->dirty_offset - s->buffer_offset),
		&writelen) != 0)
    return FAILURE;

  s->physical_offset = s->dirty_offset + writelen;

  /* don't increment file_length if the file is non-seekable */
  if (s->file_length != -1 && s->physical_offset > s->file_length)
      s->file_length = s->physical_offset; 

  s->ndirty -= writelen;
  if (s->ndirty != 0)
    return FAILURE;

  return SUCCESS;
}


/* fd_alloc()-- Arrange a buffer such that the salloc() request can be
 * satisfied.  This subroutine gets the buffer ready for whatever is
 * to come next. */

static void
fd_alloc (unix_stream * s, gfc_offset where,
	  int *len __attribute__ ((unused)))
{
  char *new_buffer;
  int n, read_len;

  if (*len <= BUFFER_SIZE)
    {
      new_buffer = s->small_buffer;
      read_len = BUFFER_SIZE;
    }
  else
    {
      new_buffer = get_mem (*len);
      read_len = *len;
    }

  /* Salvage bytes currently within the buffer.  This is important for
   * devices that cannot seek. */

  if (s->buffer != NULL && s->buffer_offset <= where &&
      where <= s->buffer_offset + s->active)
    {

      n = s->active - (where - s->buffer_offset);
      memmove (new_buffer, s->buffer + (where - s->buffer_offset), n);

      s->active = n;
    }
  else
    {				/* new buffer starts off empty */
      s->active = 0;
    }

  s->buffer_offset = where;

  /* free the old buffer if necessary */

  if (s->buffer != NULL && s->buffer != s->small_buffer)
    free_mem (s->buffer);

  s->buffer = new_buffer;
  s->len = read_len;
}


/* fd_alloc_r_at()-- Allocate a stream buffer for reading.  Either
 * we've already buffered the data or we need to load it.  Returns
 * NULL on I/O error. */

static char *
fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
{
  gfc_offset m;

  if (where == -1)
    where = s->logical_offset;

  if (s->buffer != NULL && s->buffer_offset <= where &&
      where + *len <= s->buffer_offset + s->active)
    {

      /* Return a position within the current buffer */

      s->logical_offset = where + *len;
      return s->buffer + where - s->buffer_offset;
    }

  fd_alloc (s, where, len);

  m = where + s->active;

  if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
    return NULL;

  /* do_read() hangs on read from terminals for *BSD-systems.  Only
     use read() in that case.  */

  if (s->special_file)
    {
      ssize_t n;

      n = read (s->fd, s->buffer + s->active, s->len - s->active);
      if (n < 0)
	return NULL;

      s->physical_offset = where + n;
      s->active += n;
    }
  else
    {
      size_t n;

      n = s->len - s->active;
      if (do_read (s, s->buffer + s->active, &n) != 0)
	return NULL;

      s->physical_offset = where + n;
      s->active += n;
    }

  if (s->active < *len)
    *len = s->active;		/* Bytes actually available */

  s->logical_offset = where + *len;

  return s->buffer;
}


/* fd_alloc_w_at()-- Allocate a stream buffer for writing.  Either
 * we've already buffered the data or we need to load it. */

static char *
fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
{
  gfc_offset n;

  if (where == -1)
    where = s->logical_offset;

  if (s->buffer == NULL || s->buffer_offset > where ||
      where + *len > s->buffer_offset + s->len)
    {

      if (fd_flush (s) == FAILURE)
	return NULL;
      fd_alloc (s, where, len);
    }

  /* Return a position within the current buffer */
  if (s->ndirty == 0 
      || where > s->dirty_offset + s->ndirty    
      || s->dirty_offset > where + *len)
    {  /* Discontiguous blocks, start with a clean buffer.  */  
        /* Flush the buffer.  */  
       if (s->ndirty != 0)    
         fd_flush (s);  
       s->dirty_offset = where;  
       s->ndirty = *len;
    }
  else
    {  
      gfc_offset start;  /* Merge with the existing data.  */  
      if (where < s->dirty_offset)    
        start = where;  
      else    
        start = s->dirty_offset;  
      if (where + *len > s->dirty_offset + s->ndirty)    
        s->ndirty = where + *len - start;  
      else    
        s->ndirty = s->dirty_offset + s->ndirty - start;  
        s->dirty_offset = start;
    }

  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;

  return s->buffer + where - s->buffer_offset;
}


static try
fd_sfree (unix_stream * s)
{
  if (s->ndirty != 0 &&
      (s->buffer != s->small_buffer || options.all_unbuffered ||
       s->unbuffered))
    return fd_flush (s);

  return SUCCESS;
}


static try
fd_seek (unix_stream * s, gfc_offset offset)
{
  s->logical_offset = offset;

  return SUCCESS;
}


/* truncate_file()-- Given a unit, truncate the file at the current
 * position.  Sets the physical location to the new end of the file.
 * Returns nonzero on error. */

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.
     Using ftruncate on a seekable special file (like /dev/null)
     is undefined, so we treat it as if the ftruncate failed.
  */
#ifdef HAVE_FTRUNCATE
  if (s->special_file || ftruncate (s->fd, s->logical_offset))
#else
#ifdef HAVE_CHSIZE
  if (s->special_file || 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;
  s->active = 0;
  return SUCCESS;
}