unix.c

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

/* Similar to memset(), but operating on a stream instead of a string.
   Takes care of not using too much memory.  */

static try
fd_sset (unix_stream * s, int c, size_t n)
{
  size_t bytes_left;
  int trans;
  void *p;

  bytes_left = n;

  while (bytes_left > 0)
    {
      /* memset() in chunks of BUFFER_SIZE.  */
      trans = (bytes_left < BUFFER_SIZE) ? bytes_left : BUFFER_SIZE;

      p = fd_alloc_w_at (s, &trans, -1);
      if (p)
	  memset (p, c, trans);
      else
	return FAILURE;

      bytes_left -= trans;
    }

  return SUCCESS;
}


/* Stream read function. Avoids using a buffer for big reads. The
   interface is like POSIX read(), but the nbytes argument is a
   pointer; on return it contains the number of bytes written. The
   function return value is the status indicator (0 for success).  */

static int
fd_read (unix_stream * s, void * buf, size_t * nbytes)
{
  void *p;
  int tmp, status;

  if (*nbytes < BUFFER_SIZE && !s->unbuffered)
    {
      tmp = *nbytes;
      p = fd_alloc_r_at (s, &tmp, -1);
      if (p)
	{
	  *nbytes = tmp;
	  memcpy (buf, p, *nbytes);
	  return 0;
	}
      else
	{
	  *nbytes = 0;
	  return errno;
	}
    }

  /* If the request is bigger than BUFFER_SIZE we flush the buffers
     and read directly.  */
  if (fd_flush (s) == FAILURE)
    {
      *nbytes = 0;
      return errno;
    }

  if (is_seekable ((stream *) s) && s->physical_offset != s->logical_offset 
      && lseek (s->fd, s->logical_offset, SEEK_SET) < 0)
    {
      *nbytes = 0;
      return errno;
    }

  status = do_read (s, buf, nbytes);
  reset_stream (s, *nbytes);
  return status;
}


/* Stream write function. Avoids using a buffer for big writes. The
   interface is like POSIX write(), but the nbytes argument is a
   pointer; on return it contains the number of bytes written. The
   function return value is the status indicator (0 for success).  */

static int
fd_write (unix_stream * s, const void * buf, size_t * nbytes)
{
  void *p;
  int tmp, status;

  if (*nbytes < BUFFER_SIZE && !s->unbuffered)
    {
      tmp = *nbytes;
      p = fd_alloc_w_at (s, &tmp, -1);
      if (p)
	{
	  *nbytes = tmp;
	  memcpy (p, buf, *nbytes);
	  return 0;
	}
      else
	{
	  *nbytes = 0;
	  return errno;
	}
    }

  /* If the request is bigger than BUFFER_SIZE we flush the buffers
     and write directly.  */
  if (fd_flush (s) == FAILURE)
    {
      *nbytes = 0;
      return errno;
    }

  if (is_seekable ((stream *) s) && s->physical_offset != s->logical_offset
      && lseek (s->fd, s->logical_offset, SEEK_SET) < 0)
    {
      *nbytes = 0;
      return errno;
    }

  status =  do_write (s, buf, nbytes);
  reset_stream (s, *nbytes);
  return status;
}


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 (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO)
    {
      if (close (s->fd) < 0)
        return FAILURE;
    }

  free_mem (s);

  return SUCCESS;
}


static void
fd_open (unix_stream * s)
{
  if (isatty (s->fd))
    s->unbuffered = 1;

  s->st.alloc_r_at = (void *) fd_alloc_r_at;
  s->st.alloc_w_at = (void *) fd_alloc_w_at;
  s->st.sfree = (void *) fd_sfree;
  s->st.close = (void *) fd_close;
  s->st.seek = (void *) fd_seek;
  s->st.truncate = (void *) fd_truncate;
  s->st.read = (void *) fd_read;
  s->st.write = (void *) fd_write;
  s->st.set = (void *) fd_sset;

  s->buffer = NULL;
}




/*********************************************************************
  memory stream functions - These are used for internal files

  The idea here is that a single stream structure is created and all
  requests must be satisfied from it.  The location and size of the
  buffer is the character variable supplied to the READ or WRITE
  statement.

*********************************************************************/


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

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

  if (where < s->buffer_offset || where > s->buffer_offset + s->active)
    return NULL;

  s->logical_offset = where + *len;

  n = s->buffer_offset + s->active - where;
  if (*len > n)
    *len = n;

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


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

  assert (*len >= 0);  /* Negative values not allowed. */
  
  if (where == -1)
    where = s->logical_offset;

  m = where + *len;

  if (where < s->buffer_offset)
    return NULL;

  if (m > s->file_length)
    return NULL;

  s->logical_offset = m;

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


/* Stream read function for internal units. This is not actually used
   at the moment, as all internal IO is formatted and the formatted IO
   routines use mem_alloc_r_at.  */

static int
mem_read (unix_stream * s, void * buf, size_t * nbytes)
{
  void *p;
  int tmp;

  tmp = *nbytes;
  p = mem_alloc_r_at (s, &tmp, -1);
  if (p)
    {
      *nbytes = tmp;
      memcpy (buf, p, *nbytes);
      return 0;
    }
  else
    {
      *nbytes = 0;
      return errno;
    }
}


/* Stream write function for internal units. This is not actually used
   at the moment, as all internal IO is formatted and the formatted IO
   routines use mem_alloc_w_at.  */

static int
mem_write (unix_stream * s, const void * buf, size_t * nbytes)
{
  void *p;
  int tmp;

  errno = 0;

  tmp = *nbytes;
  p = mem_alloc_w_at (s, &tmp, -1);
  if (p)
    {
      *nbytes = tmp;
      memcpy (p, buf, *nbytes);
      return 0;
    }
  else
    {
      *nbytes = 0;
      return errno;
    }
}


static int
mem_seek (unix_stream * s, gfc_offset offset)
{
  if (offset > s->file_length)
    {
      errno = ESPIPE;
      return FAILURE;
    }

  s->logical_offset = offset;
  return SUCCESS;
}


static try
mem_set (unix_stream * s, int c, size_t n)
{
  void *p;
  int len;

  len = n;
  
  p = mem_alloc_w_at (s, &len, -1);
  if (p)
    {
      memset (p, c, len);
      return SUCCESS;
    }
  else
    return FAILURE;
}


static int
mem_truncate (unix_stream * s __attribute__ ((unused)))
{
  return SUCCESS;
}


static try
mem_close (unix_stream * s)
{
  free_mem (s);

  return SUCCESS;
}


static try
mem_sfree (unix_stream * s __attribute__ ((unused)))
{
  return SUCCESS;
}



/*********************************************************************
  Public functions -- A reimplementation of this module needs to
  define functional equivalents of the following.
*********************************************************************/

/* empty_internal_buffer()-- Zero the buffer of Internal file */

void
empty_internal_buffer(stream *strm)
{
  unix_stream * s = (unix_stream *) strm;
  memset(s->buffer, ' ', s->file_length);
}

/* open_internal()-- Returns a stream structure from an internal file */

stream *
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;

  s->logical_offset = 0;
  s->active = s->file_length = length;

  s->st.alloc_r_at = (void *) mem_alloc_r_at;
  s->st.alloc_w_at = (void *) mem_alloc_w_at;
  s->st.sfree = (void *) mem_sfree;
  s->st.close = (void *) mem_close;
  s->st.seek = (void *) mem_seek;
  s->st.truncate = (void *) mem_truncate;
  s->st.read = (void *) mem_read;
  s->st.write = (void *) mem_write;
  s->st.set = (void *) mem_set;

  return (stream *) s;
}


/* fd_to_stream()-- Given an open file descriptor, build a stream
 * around it. */

static stream *
fd_to_stream (int fd, int prot)
{
  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;
  s->physical_offset = 0;
  s->logical_offset = 0;
  s->prot = prot;

  /* Get the current length of the file. */

  fstat (fd, &statbuf);
  s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
  s->special_file = !S_ISREG (statbuf.st_mode);

  fd_open (s);

  return (stream *) s;
}


/* Given the Fortran unit number, convert it to a C file descriptor.  */

int
unit_to_fd (int unit)
{
  gfc_unit *us;
  int fd;

  us = find_unit (unit);
  if (us == NULL)
    return -1;

  fd = ((unix_stream *) us->s)->fd;
  unlock_unit (us);
  return 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.  */

int
unpack_filename (char *cstring, const char *fstring, int len)
{
  len = fstrlen (fstring, len);
  if (len >= PATH_MAX)
    return 1;

  memmove (cstring, fstring, len);
  cstring[len] = '\0';

  return 0;
}


/* 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 returned, which is -1 on error.  The template is pointed to by 
 * opp->file, which is copied into the unit structure
 * and freed later. */

static int
tempfile (st_parameter_open *opp)
{
  const char *tempdir;
  char *template;
  int fd;

  tempdir = getenv ("GFORTRAN_TMPDIR");
  if (tempdir == NULL)
    tempdir = getenv ("TMP");
  if (tempdir == NULL)
    tempdir = getenv ("TEMP");
  if (tempdir == NULL)
    tempdir = DEFAULT_TEMPDIR;

  template = get_mem (strlen (tempdir) + 20);

  st_sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);

#ifdef HAVE_MKSTEMP

  fd = mkstemp (template);

#else /* HAVE_MKSTEMP */

  if (mktemp (template))
    do
#if defined(HAVE_CRLF) && defined(O_BINARY)
      fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY,
                 S_IREAD | S_IWRITE);
#else
      fd = open (template, O_RDWR | O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
#endif
    while (!(fd == -1 && errno == EEXIST) && mktemp (template));
  else
    fd = -1;

#endif /* HAVE_MKSTEMP */

  if (fd < 0)
    free_mem (template);
  else
    {
      opp->file = template;
      opp->file_len = strlen (template);	/* Don't include trailing nul */
    }

  return fd;
}


/* 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 (st_parameter_open *opp, unit_flags *flags)
{
  char path[PATH_MAX + 1];
  int mode;
  int rwflag;
  int crflag;
  int fd;

  if (unpack_filename (path, opp->file, opp->file_len))
    {
      errno = ENOENT;		/* Fake an OS error */
      return -1;
    }

  rwflag = 0;

  switch (flags->action)
    {
    case ACTION_READ:
      rwflag = O_RDONLY;
      break;

    case ACTION_WRITE:
      rwflag = O_WRONLY;
      break;

    case ACTION_READWRITE:
    case ACTION_UNSPECIFIED:
      rwflag = O_RDWR;
      break;

    default:
      internal_error (&opp->common, "regular_file(): Bad action");
    }

  switch (flags->status)
    {
    case STATUS_NEW:
      crflag = O_CREAT | O_EXCL;
      break;

    case STATUS_OLD:		/* open will fail if the file does not exist*/
      crflag = 0;
      break;

    case STATUS_UNKNOWN:
    case STATUS_SCRATCH:
      crflag = O_CREAT;
      break;

    case STATUS_REPLACE:
        crflag = O_CREAT | O_TRUNC;
      break;

    default:
      internal_error (&opp->common, "regular_file(): Bad status");
    }

  /* rwflag |= O_LARGEFILE; */

#if defined(HAVE_CRLF) && defined(O_BINARY)
  crflag |= O_BINARY;
#endif

  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;

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