/* Copyright (C) 1991-99 Free Software Foundation, Inc.

   This file is part of GNU Pascal Library.

   Random access file routines.

The GNU Pascal Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.

The GNU Pascal Library 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
Library General Public License for more details.

You should have received a copy of the GNU Library General Public
License along with the GNU Pascal Library; see the file COPYING.LIB.  If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA.  */

/*
 * Authors: Jukka Virtanen <jtv@hut.fi>
 *          Frank Heckenbach <frank@pascal.gnu.de>
 */

#include "rts.h"
#include "fdr.h"
#include <sys/stat.h>

static int
_p_direct_warn (File, n)
FDR File;
int n;
{
  if (!tst_DIRECT(File))
    {
      if (_p_force_direct_files)
        IOERROR_FILE (n, File, 1);
      else
        _p_warning_string (_p_check_errmsg (n, "s"), m_NAM(File));
    }
  return 0;
}

/* NOTE:
 *   Extended Pascal defined the following operations only to
 * DIRECT ACCESS FILE types:
 *
 *   SeekRead, SeekWrite, SeekUpdate, Empty, Position, LastPosition
 *   and Update (in not writing to end of file)
 *
 * Direct access file is defined by: FILE [ indextype ] OF type 
 * (the ord(a) in assertions means the smallest value of indextype)
 *
 * However, GPC does not currently implement direct access files, and
 * anyhow maybe we should allow the operations also to other
 * files capable of seek(2). These non-direct access files may be
 * thought of the following direct access file type:
 *
 * TYPE Natural = 0..MaxInt;
 *      gpcfiles = FILE [ Natural ] OF <type>
 *
 * DefineSize is a GPC extension.
 *
 */

int
_p_getsize (File)
     FDR File;
{
  struct stat finfo;

  if (_p_inoutres) return 0;
    
  if (m_STATUS(File) == FiNOP)
    IOERROR_FILE (407, File,0); /* `%s' has not been opened */

  if (_p_direct_warn (File, 590)) return 0; /* Direct access routine `GetSize' applied to non-direct `%s' */

  _p_flush (File);
  if (fstat(fileno(m_FILNUM(File)), &finfo) == 0)
    return NUMBYTE (File, finfo.st_size);
  else
    IOERROR_FILE(446,File,0); /* Could not stat `%s' */
}

void
_p_truncate(File)
     FDR File;
{
  int position, size;
  long ByteNum;

  if (_p_inoutres) return;

  if (m_STATUS(File) == FiNOP)
    IOERROR_FILE (407, File,); /* `%s' has not been opened */
  else if (is_RONLY(File))
    IOERROR_FILE (438, File,); /* `Truncate' or `DefineSize' applied to read only %s */

  position = _p_position(File);
  if (_p_inoutres) return;

  size = _p_getsize(File);
  if (_p_inoutres) return;

  _p_clearbuffer (File);

  if (tst_SIZEK (File) && position < size)
    {
      ByteNum = BYTENUM(File, position);
      D(3, printf("truncating file to %ld bytes\n", ByteNum));

#ifdef HAVE_FTRUNCATE
      if (ftruncate(fileno(m_FILNUM(File)), ByteNum) == -1)
        IOERROR_FILE (425,File,); /* file truncation failed for `%s' */
#else
      /* Maybe this is not worth reporting?
       * The call is not in 10206 pascal anyway...
       */
      _p_warning ("ftruncate needed by _p_truncate()");

      /* @@ The way to go without FTRUNCATE might be to copy the
       * POSITION first elements of the file to a temp file,
       * then do some file renaming, but I won't do it now.
       */
#endif
    }
}

/* DEFINESIZE (This is a GPC extension)
 *
 * May be applied only to random access files and files opened
 * for writing.
 *
 * Define files size as count of its component type units
 */
void
_p_definesize(File, NewSize)
     FDR File;
     int NewSize;
{
  if (_p_inoutres) return;
  _p_seekwrite (File, NewSize);
  if (_p_inoutres) return;
  _p_truncate (File);
  if (_p_inoutres) return;
}

void
_p_seekall (File, NewPlace)
     FDR File;
     int NewPlace;
{
  if (_p_inoutres) return;
  _p_clearbuffer (File);
  if (is_WRITABLE (File))
    {
      if (is_READABLE (File))
        {
          _p_seekupdate (File, NewPlace);
          if (_p_inoutres) return;
        }
      else
        {
          _p_seekwrite (File, NewPlace);
          if (_p_inoutres) return;
        }
    }
  else
    {
      _p_seekread (File, NewPlace);
      if (_p_inoutres) return;
    }
}

/* SEEKREAD
 * pre-assertion: (neither f0.L nor f0.R is undefined) and
 *   (0<= ord(n)-ord(a) <= length(f0.L~f0.R))
 * post-assertion:(f.M = Inspection) and (f.L~f.R = f0.L~f0.R) and
 *   (if length(f0.L~f0.R) > ord(n)-ord(a) then
 *     ((length(f.L) =  ord(n)-ord(a)) and
 *      (f^ = f.R.first))
 *   else
 *     ((f.R = S() and f^ is undefined)))
 *
 * NEWPLACE is an offset from ZERO to the correct location.
 */
void
_p_seekread(File, NewPlace)
     FDR File;
     int NewPlace;
{
  int size;
  if (_p_inoutres) return;
  if (is_WONLY (File))
    IOERROR_FILE (426,File,); /* `SeekRead' to write only `%s' */
  else if (NewPlace < 0)
    IOERROR_FILE (410,File,); /* attempt to access elements before beginning of random access `%s' */

  _p_open (File, foSeekRead);
  if (_p_inoutres) return;

  size = _p_getsize(File);
  if (_p_inoutres) return;

  if (tst_SIZEK (File) && NewPlace > size)
    IOERROR_FILE (406,File,); /* attempt to read past end of random access `%s' */

  if (_p_direct_warn (File, 591)) return; /* Direct access routine `SeekRead' applied to non-direct `%s' */

  D(3, printf("SeekRead: seek to element %ld\n", (long)NewPlace));

  if (_p_seek (File, NewPlace, SEEK_SET, 1))
    IOERROR_FILE (427,File,); /* SeekRead seek failed on `%s' */

  /* Change the current status of file to INSPECTION */
  CLR_STATUS (File, FiANY);
  SET_STATUS (File, FiORE);

  clr_EOF (File);
  set_LGET(File);

#if 0
  /* Seek back to the place where we were before the
     GET. It's m_SIZ(File) before the place we are now at */

  if (! tst_EOF (File) && _p_seek (File, -1, SEEK_CUR, 1))
    IOERROR_FILE (428,File,); /* `SeekRead' failed to reset file position of `%s' */
#endif
}

/* SEEKWRITE
 * pre-assertion: (neither f0.L nor f0.R is undefined) and
 *   (0<= ord(n)-ord(a) <= length(f0.L~f0.R))
 * post-assertion:(f.M = Generation) and (f.L~f.R = f0.L~f0.R) and
 *   (length(f.L) = ord(n)-ord(a)) and (f^ is undefined)
 *
 * Note: this definition DOES NOT WRITE anything. It just moves the
 * file pointer and changes the MODE to GENERATION.
 *
 * NEWPLACE is an offset from ZERO to the correct location.
 */
void
_p_seekwrite(File, NewPlace)
FDR File;
int NewPlace;
{
  int size;
  if (_p_inoutres) return;
  if (is_RONLY (File))
    IOERROR_FILE (411,File,); /* attempt to modify read only `%s' */
  else if (NewPlace < 0)
    IOERROR_FILE (410,File,); /* attempt to access elements before beginning of random access `%s' */

  _p_open (File, foSeekWrite);
  if (_p_inoutres) return;

  size = _p_getsize(File);
  if (_p_inoutres) return;

  if (tst_SIZEK (File) && NewPlace > size) {
    /* It fails always in 10206.
     */
    _p_warning_string ("GPC extension: Extending file %s in `SeekWrite'", m_NAM (File));
  }

  if (_p_direct_warn (File, 592)) return; /* Direct access routine `SeekWrite' applied to non-direct `%s' */

  D(3, printf("SeekWrite: seek to element %ld\n", (long)NewPlace));
  if (_p_seek (File, NewPlace, SEEK_SET, 1))
    IOERROR_FILE (429,File,); /* SeekWrite seek failed on `%s' */

  /* Change the mode to generation */
  CLR_STATUS (File, FiANY);
  SET_STATUS (File, FiWRI);
}

/* SEEKUPDATE
 * pre-assertion: (neither f0.L nor f0.R is undefined) and
 *   (0<= ord(n)-ord(a) <= length(f0.L~f0.R))
 * post-assertion:(f.M = Update) and (f.L~f.R = f0.L~f0.R) and
 *   (if length(f0.L~f0.R) > ord(n)-ord(a) then
 *     ((length(f.L) =  ord(n)-ord(a)) and
 *      (f^ = f.R.first))
 *   else
 *     ((f.R = S()) and (f^ is undefined)))
 *
 * The (only) difference with SEEKREAD is that this leaves f.M to
 * UPDATE mode.
 */
void
_p_seekupdate(File, NewPlace)
     FDR File;
     int NewPlace;
{
  int size;
  if (_p_inoutres) return;
  if (is_RONLY (File))
    IOERROR_FILE (430,File,); /* `SeekUpdate' to read only `%s' */
  else if (NewPlace < 0)
    IOERROR_FILE (410,File,); /* attempt to access elements before beginning of random access `%s' */

  _p_open (File, foSeekUpdate);
  if (_p_inoutres) return;

  size = _p_getsize(File);
  if (_p_inoutres) return;

  if (tst_SIZEK (File) && NewPlace > size)
    IOERROR_FILE (406,File,); /* attempt to read past end of random access `%s' */

  if (_p_direct_warn (File, 593)) return; /* Direct access routine `SeekUpdate' applied to non-direct `%s' */

  D(3, printf("SeekUpdate: seek to element %ld\n", (long)NewPlace));
  if (_p_seek (File, NewPlace, SEEK_SET, 1))
    IOERROR_FILE (431,File,); /* `SeekUpdate' seek failed on `%s' */

  CLR_STATUS (File, FiANY);
  if (!(is_RONLY(File) || is_WONLY(File)))  SET_STATUS (File, FiRND);

  clr_EOF(File);
  set_LGET(File);

#if 0 
  /* Seek back to the place where we were before the
     GET. It's m_SIZ(File) before the place we are now at */

  if (! tst_EOF (File) && _p_seek (File, -1, SEEK_CUR, 0))
    IOERROR_FILE (432,File,); /* `SeekUpdate' failed to reset file position of `%s' */
#endif

}

/* EMPTY 
 *
 * Returns True if file is Empty, otherwise False
 */
int
_p_empty (File)
const FDR File;
{
  if (_p_inoutres) return 1;
  if (! (m_STATUS(File) & FiANY))
    IOERROR_FILE (407, File,1); /* `%s' has not been opened */

  if (_p_direct_warn (File, 594)) return 1; /* Direct access routine `Empty' applied to non-direct `%s' */

  return tst_EMPTY(File);
}

/* UPDATE
 * pre-assertion: (f0.M = Generation or f0.M = Update) and
 *   (neither f0.L nor f0.R is undefined) and
 *   (f is a direct access file type) and
 *   (f0^ is not undefined)
 * post-assertion:(f.M = f0.M) and (f.L = f0.L) and
 *   (if f0.R = S() then
 *     (f.R = S(f0^))
 *   else
 *     (f.R = S(f0^)~f0.R.rest)) and
 *   (f^ = f0^).
 *
 * i.e. Write the stuff in, and leave it also in the file buffer.
 * don't advance the file pointer from the pre-assert state!
 */
void
_p_update (File)
     FDR File;
{
  int is_random;

  if (_p_inoutres) return;

  if (_p_direct_warn (File, 595)) return; /* Direct access routine `Update' applied to non-direct `%s' */

  /* If the file buffer contents is lazy, validate it */
  if (tst_LGET (File))
    {
      clr_LGET (File);
      _p_get (File);
      if (_p_inoutres) return;
    }

#if 0
  /* @@ Ooops: Currently assigning a value to a file buffer
     does not clear the UND bit in the status word.
     Disable this check -> UNDefined file buffers may be written with
     update...
   */
  if (tst_UND (File))
    IOERROR_FILE (439, File,); /* `Update' with an undefined file buffer in `%s' */
#endif
  
  is_random = TST_STATUS (File, FiRND);
  if (is_random)
    {
      /* Change the mode to generation, prevents implicit GET
       * Yes, PUT in UPDATE mode gets the next element by default.
       */
      CLR_STATUS (File, FiANY);
      SET_STATUS (File, FiWRI);
    }

  /* Write to the current location.
   * _p_put does not clobber file buffer.
   */
  _p_put (File);
  if (_p_inoutres) return;

  if (is_random)
    {
      /* Change the mode back to random access */
      CLR_STATUS (File, FiANY);
      if (!(is_RONLY(File) || is_WONLY(File)))  SET_STATUS (File, FiRND);
    }
  
  /* The file buffer is still f0^ */
  clr_UND (File);

  /* Seek back to the place where we were before the
   * PUT. It's m_SIZ(File) before the place we are now at
   */
  if (_p_seek (File, -1, SEEK_CUR, 1))
    IOERROR_FILE (433,File,); /* `Update' failed to reset the position of `%s' */
}

/* LASTPOSITION
 * LastPosition(f) = succ(a, length(f.L~f.R)-1);
 */
int
_p_lastposition(File)
     FDR File;
{
  int size;
  size = _p_getsize(File);
  if (_p_inoutres) return 0;
  return size-1;
}

/* POSITION
 * Position(f) = succ(a, length(f.L));
 *
 * This is the element number always counting from ZERO
 *
 * (Since the run time system does not know the low bound
 *  of the direct access file type)
 *
 * The returned value is an offset from A, so the compiler needs to
 * adjust the value before it is returned to the user.
 */
int
_p_position(File)
     FDR File;
{
  long NumBytes;
  int pos;

  if (_p_inoutres) return 0;
  if (m_STATUS(File) == FiNOP)
    IOERROR_FILE (407, File,0); /* `%s' has not been opened */
  
  if (_p_direct_warn (File, 596)) return 0; /* Direct access routine `Position' applied to non-direct `%s' */

  NumBytes = ftell (m_FILNUM (File));

  if (File->BufPos < File->BufSize)
    NumBytes -= File->BufSize - File->BufPos;

  if (NumBytes < 0) /* Error */
    IOERROR_FILE (417,File,0); /* ftell failed in `FilePos' for `%s' */

  pos = NUMBYTE (File, NumBytes);
  if (!tst_UND(File) && !tst_LGET(File))
    pos--;
  return pos;
}

/*@@ use TFDD read/write routines */
void
_p_blockread (File, Buf, Count, Result)
  FDR File; char *Buf; unsigned int Count; unsigned int *Result;
{
  int n, m;
  if (_p_inoutres) return;
  n = 0;
  m = 0;
  if (!tst_EOF(File))
    {
      /* If something was read ahead (e.g. in _p_eof()), copy this to the
         destination buffer first */
      if (Count != 0 && !tst_LGET(File))
        {
          *Buf++ = m_FILBUF (File);
          Count--;
          m++;
          set_LGET(File);
        }
      if (File->BufPos < File->BufSize)
        {
          int s = File->BufSize - File->BufPos;
          if (s > Count) s = Count;
          memmove (Buf, File->BufPtr + File->BufPos, s);
          File->BufPos += s;
          Buf += s;
          Count -= s;
          m += s;
        }
      if (Count != 0)
        {
          n = fread (Buf, m_SIZ(File), Count, m_FILNUM(File));
          if (n < 0 || ferror (m_FILNUM (File)))
            IOERROR_FILE (413,File,); /* BlockRead error from `%s' */
          if (feof (m_FILNUM (File)))
            set_EOF (File);
        }
    }
  if (Result)
    *Result = n + m;
  else
    if (n < Count)
      IOERROR_FILE (414,File,); /* BlockRead: could not read all the data from `%s' */
}

/*@@ use TFDD read/write routines */
void
_p_blockwrite (File, Buf, Count, Result)
  FDR File; const char *Buf; unsigned int Count; unsigned int *Result;
{
  int n;
  if (_p_inoutres) return;
  n = fwrite (Buf, m_SIZ(File), Count, m_FILNUM(File));
  if (n < 0 || (n == 0 && ferror (m_FILNUM (File))))
    IOERROR_FILE (415,File,); /* BlockWrite error to `%s' */
  if (Result)
    *Result = n;
  else
    if (n < Count)
      IOERROR_FILE (416,File,); /* BlockWrite: could not write all the data to `%s' */
}
