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

   This file is part of GNU Pascal Library.

   Generic file handling routines and their support.

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>
 *          Peter Gerwinski <peter@gerwinski.de>
 */

#include "rts.h"

/* File Descriptor Record definition */
#include "fdr.h"
#include <sys/stat.h>

#ifdef HAVE_SYS_PARAM_H
#include <sys/param.h>
#endif

/* needed for select() */
#if TIME_WITH_SYS_TIME
#include <sys/time.h>
#include <time.h>
#else
#if HAVE_SYS_TIME_H
#include <sys/time.h>
#else
#include <time.h>
#endif
#endif

/* workaround for bug in (e.g.) libc-5.4.46 */
#ifdef FD_ZERO
#undef FD_ZERO
#endif
#define FD_ZERO(p) memset((char *)(p), 0, sizeof(*(p)))

int _p_filemode = 2;
int _p_textfiles_binary = 0;

void
_p_clearbuffer (File)
FDR File;
{
  File->BufSize = 0;
  File->BufPos = 0;
}

void
_p_f_flush (File)
void *File;
{
/*@@ DJGPP at least clobbers the file position when fflush()ing */
#if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
  fpos_t pos;
  fgetpos ((FILE *) File, &pos);
  fflush ((FILE *) File);
  fsetpos ((FILE *) File, &pos);
#else
  fflush ((FILE *) File);
#endif
}

/* Routine to call when you wish to flush the file buffers
 * from your pascal source. */
void
_p_flush (File)
FDR File;
{
  if (_p_inoutres) return;
  if (is_WRITABLE (File) && File->FlushProc)
    File->FlushProc (File->PrivateData);
}

/* Call this if you need to use the (FILE *) pointer in your pascal program
 * for external C routines. */
FILE *
_p_getfile (File)
const FDR File;
{
  return m_FILNUM (File);
}

void
_p_inittfdd (File)
FDR File;
{
  File->hack_InFunc   = NULL;
  File->hack_OutFunc  = NULL;
  File->PrivateData   = NULL;
  File->OpenProc      = DefaultOpenProc;
  File->ReadFunc      = _p_f_read;
  File->WriteFunc     = _p_f_write;
  File->FlushProc     = _p_f_flush;
  File->CloseProc     = DefaultCloseProc;
  File->DoneProc      = NULL;
}

void
_p_initfdr(File, Name, Size, flags)
 FDR   File;
 char *Name;  /* internal name in program */
 int   Size;  /* file buffer size; in bits, if Packed, else in bytes */
 int   flags; /* see types.h */
{
  if (! Name)
    _p_internal_error (925); /* File has no internal name */

  File->BufPtr = File->InternalBuffer;

  m_FILSTA(File) = 0;
  if (flags & (1 << fkind_TEXT))
    set_TXT(File);
  if (flags & (1 << fkind_PACKED))
    set_PCK(File);
  if (flags & (1 << fkind_EXTERN))
    set_EXT(File);
  if (flags & (1 << fkind_DIRECT))
    set_DIRECT (File);
  if (flags & (1 << fkind_BYTE))
    set_BYTE (File);  /* Unused */
  if (flags & (1 << fkind_BINDABLE))
    set_BINDABLE (File);

  if (!(flags & (1 << fkind_CLOSE)))
    {
      _p_inittfdd (File);
      m_BINDING (File)    = NULL;
      m_BNDNAM  (File)    = NULL;
      m_EXTNAM  (File)    = NULL;

      if (Size)
        {
          m_SIZ (File) = Size;
          if (tst_PCK (File))
            {
              /* Convert to unpacked file, since we don't yet support
               * PACKED files. This may be done even if the compiler
               * thinks we support them :-) */
              m_SIZ(File) = (m_SIZ(File) + 7) / 8;
              clr_PCK(File);
            }
#if 1
          /* Allocate file buffer */
          m_FILBPTR(File) = _p_malloc (m_SIZ(File));
#else
          /* @@ Why was this? */
          /* Always allocate at least one word for the file buffer */
          {
            int s = m_SIZ (File);
            if (s < BYTES_PER_WORD)
              s = BYTES_PER_WORD;
            /* Allocate file buffer */
            m_FILBPTR(File) = _p_malloc (s);
          }
#endif /* 1 */
        }
    }
  m_NAM (File) = Name;
  m_BNDCHG (File) = 0;
  m_STATUS(File) = FiNOP;
  m_NXTFDR(File) = NULL;
  set_UND(File); /* Mark the file buffer contents undefined */
  m_FILNUM(File) = NULL;
}

static int
isStdFile (File)
FDR File;
{
  return tst_TXT(File) &&
         (File == &_p_stdin  ||
          File == &_p_stdout ||
          File == &_p_stderr);
}

static char *
_p_nameit(File, mode)
FDR     File;
TOpenMode mode;
{
  int    tty;
  int    n, in, out, l;
  assoc *ap;
  char  *b, buf[512];

  if (_p_inoutres) return "";
  if (!tst_EXTB(File))
    {
      b = _p_get_temp_file_name_cstring ();
      D(2, fprintf(stderr,"Opening internal file %s\n",b));
      return(b);
    }
  for(ap = _p_assoc; ap->int_name ; ap++)
    if (_p_strcasecmp(m_NAM(File),ap->int_name) == 0)
      {
        ap->int_name = "?KukkuuRESET?"; /* Allow close(a); reset(a) to access next one */
        m_EXTNAM (File) = _p_strdup (ap->ext_name);
        return(m_EXTNAM (File));
      }
  if (isStdFile (File))
    return NULL;

  /* Try to write filename prompts to /dev/tty and try to read responces
     from there also, to avoid mungling with stdin & stdout.

     However, if everything fails, try stdin & stdout, if they don't
     work, abort. You can also use -a switch to associate internal names
     to external ones. It only needs to be documented... */

  if ((tty = open ("/dev/tty", O_RDWR)) < 0)
    {
      _p_warning ("Failed to open terminal for file name read, using stdin & stdout");
      in  = 0;
      out = 1;
    }
  else
    in = out = tty;

  sprintf(buf,"%s file `%s': ",
          (mode == foReset   || mode == foSeekRead)  ? "Input"  :
          (mode == foRewrite || mode == foSeekWrite) ? "Output" :
          (mode == foSeekUpdate) ? "Input/Output" : "Extend",
          m_NAM(File));
  l = _p_strlen(buf);
  if ((n = write (out, buf, l)) != l)
    {
      if (out != 1)
        _p_warning ("Writing file name prompt to /dev/tty failed, using stdout");
      if (out == 1 || (n = write (1, buf, l)) < 0)
        {
          if (tty >= 0) close (tty);
          IOERROR_FILE (419,File,""); /* cannot prompt user for external file name bindings for %s */
        }
    }
  if ((n = read (in, buf, sizeof(buf))) < 0)
    {
      if (in != 0)
        {
          _p_warning ("Reading filename from /dev/tty failed, trying stdin");
          /* BUF should be ok still, since read failed. */
          (void) write (tty, buf, _p_strlen(buf));
        }
      if (in == 0 || (n = read (0, buf, sizeof(buf))) < 0)
        {
          if (tty >= 0) close (tty);
          IOERROR_FILE (420,File,""); /* cannot query user for external file name bindings for %s */
        }
    }
  if (tty >= 0) close (tty);

  if (buf[0] == EOT)
    IOERROR_FILE (421,File,""); /* EOT character given for query of file name for %s */

  buf[n] = '\0';
  if (n > 0 && buf[n-1] == '\n') buf[n-1] = '\0';
  m_EXTNAM (File) = _p_strdup (buf);
  _p_osdirseparator2slash_cstring (m_EXTNAM (File));
  return m_EXTNAM (File);
}

void
_p_fdrchain(Fdr, What)
FDR Fdr;
int What;
{
  FDR scan = NULL;

  _p_init_files_atexit ();
  switch (What)
    {
      case TRUE:
        if (!FirstFdr)
          {
            FirstFdr = LastFdr = Fdr;
            m_NXTFDR(Fdr) = NULL;
            D(4, fprintf(stderr, "Adding %s to empty fdr list\n",m_NAM(Fdr)));
          }
        else
          {
            for(scan=FirstFdr; scan; scan = m_NXTFDR(scan))
              if (scan == Fdr) /* FDR already in list, do nothing */
                break;
            if (!scan)
              {
                D(4, fprintf(stderr, "Adding %s to fdr list\n", m_NAM(Fdr)));
                if (m_NXTFDR(LastFdr))
                    _p_warning ("LastFdr->nxtfdr is not NULL");
                m_NXTFDR(LastFdr) = Fdr;
                m_NXTFDR(Fdr) = NULL;
                LastFdr = Fdr;
              }
          }
        break;
      case FALSE:
        if (FirstFdr == Fdr) /* First in the Fdr list */
          {
            FirstFdr = m_NXTFDR(Fdr);
            m_NXTFDR(Fdr) = NULL;
            if (LastFdr == Fdr) /* The only element */
              LastFdr = NULL;
            D(4, fprintf(stderr, "Removed fdr %s (first) from list\n", m_NAM(Fdr)));
          }
        else
          {
            /* Look for the element before Fdr in the list */
            for (scan=FirstFdr; scan && m_NXTFDR(scan) != Fdr; scan = m_NXTFDR(scan));
            if (scan)
              {
                D(4, fprintf(stderr, "Removed fdr %s from list\n",m_NAM(Fdr)));
                m_NXTFDR(scan) = m_NXTFDR(Fdr); /* skip over */
                m_NXTFDR(Fdr)  = NULL;
                if (LastFdr == Fdr) LastFdr = scan;
              }
            else if (m_NXTFDR(Fdr))
              {
                _p_warning ("Fdr not found in list");
                m_NXTFDR(Fdr) = NULL;
              }
          }
        break;
    }
}

/* Move the file pointer to the requested pascal record of the FILE.
 * RECORD specifies how much to move, negative is backward, positive
 * is forward.
 * RELATIVE is 0 if this is an absolute move, 1 if relative, 2 if
 * counting starts from end of file.
 *
 * Note: The FSEEK 3rd parameter matches these values in UN*X systems.
 *
 * The file is flushed before the move is attempted.
 */
int
_p_seek (File, record, relative, flush_it)
     FDR File;
     int record;
     int relative;
     int flush_it;
{
  long bytenum;

  if (flush_it)
    {
      D(3, printf("flush before seek\n"));
      _p_flush (File);
    }
  
  if (relative)
    bytenum = record * m_SIZ(File);
  else
    bytenum = BYTENUM (File, record);
      
  D(3, printf("seek to byte %ld relative=%d\n", bytenum, relative));

  set_LGET (File);
  if (fseek (m_FILNUM(File), bytenum, relative))
    return -1;

  return 0;
}

/* Check if FILE has a binding, and if so, set its external name */
static void
check_binding(File)
FDR File;
{
  if (m_BINDING (File))
    {
      set_EXTB (File);
      if (m_BNDCHG (File))
        {
          m_BNDCHG (File) = 0;
          _p_close (File);
          if (_p_inoutres) return;
          m_EXTNAM (File) = m_BNDNAM (File);
        }
    }
  else
    if (tst_EXT (File))
      set_EXTB (File);
    else
      clr_EXTB (File);
}

/*
   Open a FILE in MODE, depending on its bindings etc.

   foReset:
   pre-assertion: The components f0.L and f0.R are not undefined
   post-assertion: (f.L = S()) and (f.R = (f0.L~f0.R~X))
                   and (f.M = Inspection)
                   and (if f.R = S() then (f^ is undefined) else (f^ = f^.R.first))

   foRewrite:
   pre-assertion: true.
   post-assertion: (f.L = f.R = S()) and (f.M = Generation)
                   and (f^ is undefined)

   foAppend:
   pre-assertion: f0.L and f0.R are not undefined
   post-assertion: (f.M = Generation) and (f.L = f0.L~f0.R~X)
                   and (f.R = S())
                   and (f^ is undefined)

   where, if F is of type TEXT, and f0.L~f0.R is not empty and
   if (f0.L~f0.R).last is not an end-of-line, then X shall be a sequence
   having an end-of-line component as its only component;
   otherwise X = S().
*/
#if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
#define DOSBIN (!tst_TXT(File) || _p_textfiles_binary)
#else
#define DOSBIN 0
#endif
#ifdef __EMX__
#define S_ISFIFO(f) 0
#define S_ISBLK(f)  0
#endif
void
_p_open (File, mode)
     FDR       File;
     TOpenMode mode;
{
  if (_p_inoutres) return;
  if (m_SIZ (File) == 0)
    _p_internal_error (914); /* _p_initfdr has not been called for file */

  fil_clr (File, ~(STATUS_KEEP | FiRONLY | FiWONLY)); /* Clear file status bits */
  set_UND(File); /* Mark the file buffer contents undefined */

  if (File->OpenProc != DefaultOpenProc)
    {
      if (m_STATUS(File) != FiNOP)
        {
          _p_close (File);
          if (_p_inoutres) return;
        }
      if (File->OpenProc) File->OpenProc (File->PrivateData, mode);
      set_FLUSH(File);
    }
  else
    {
      char *filename = (char *) NULL;
      int stdinout = FALSE;
      struct stat finfo;

      if (m_BINDING (File) && m_BINDING (File) -> Directory)
        IOERROR_STRING (401,m_BNDNAM (File),); /* cannot open directory `%s' */

      check_binding (File);
      if (_p_inoutres) return;
      filename = m_EXTNAM (File);

      if (m_STATUS(File) != FiNOP)
        {
          /* File is currently open in Pascal program */
          int tempcloseflag = 0;
          if (!(mode == foReset || mode == foSeekRead) && is_RONLY (File))
            IOERROR_FILE (422,File,); /* cannot write to read only %s */

          if (mode == foAppend)
            _p_seek (File, 0, SEEK_END, is_WRITABLE(File)); /* Start appending */
          else if (mode != foRewrite)
            {
              if (is_WONLY (File))
                tempcloseflag++;
              else
                _p_seek (File, 0, SEEK_SET, is_WRITABLE(File)); /* Start reading or update */
            }
          else
            {
              #ifdef HAVE_FTRUNCATE
              /* We have ftruncate () */
              _p_seek (File, 0, SEEK_SET, is_WRITABLE(File)); /* Start writing */

              if (ftruncate(fileno(m_FILNUM(File)), 0) == -1)
                IOERROR_FILE (423,File,); /* ftruncate failed when re-opening %s with `Rewrite' */
              #else
              /* If you don't have ftruncate() emulate the behaviour */
              tempcloseflag++;
              #endif
            }
          if (tempcloseflag)
            {
              int extb = tst_EXTB (File);
              filename = m_EXTNAM(File);
              m_EXTNAM(File) = NULL;
              _p_close(File);
              if (_p_inoutres) return;
              m_EXTNAM(File) = filename;
              if (extb) set_EXTB (File);
              /* Let the code below re-open the same external file for writing */
              /* If the file is internal, it will not be the same, but who cares. */
            }
        }

      if (m_STATUS(File) == FiNOP)
        {
          int errcode = 0;

          if ((mode == foReset || mode == foSeekRead || mode == foSeekUpdate) && !tst_EXTB(File))
            IOERROR_FILE (436, File,); /* `Reset', `SeekUpdate' or `SeekRead' to nonexistent %s */

          if (m_BINDING(File) && m_BINDING(File) -> CFile && m_BNDNAM(File)[0] == 0)
            m_FILNUM(File) = m_BINDING(File) -> CFile;
          else
            {
              if (!filename)
                filename = _p_nameit(File, mode);
              if (_p_inoutres) return;

              if (!filename || filename[0] == 0 ||
                 (filename[0] == '-' && filename[1] == 0))
                {
                  stdinout = TRUE;
                  m_FILNUM(File) = (mode == foReset ? (_p_current_stdin ? _p_current_stdin : stdin) :
                   ((File == &_p_stderr) ? stderr : stdout));
                }
              else
                {
                  char *how;
                  how = NULL;
                  switch (mode)
                    {
                      case foReset:
                      case foSeekRead:
                        if (_p_filemode & 2 && !tst_TXT (File)) how = DOSBIN ? "rb+" : "r+";
                        errcode = 442; /* %s cannot be opened for reading */
                        break;
                      case foRewrite:
                        if (!(_p_filemode & 4)) how = DOSBIN ? "wb+" : "w+";
                        errcode = 443; /* %s cannot be opened for writing */
                        break;
                      case foAppend:
                        if (!(_p_filemode & 8)) how = DOSBIN ? "ab+" : "a+";
                        errcode = 445; /* %s cannot be extended */
                        break;
                      /* SeekWrite needs to open the file as "r+" because "a+"
                         does not allow seeking before the current end of file
                         on some systems (e.g. Linux), and "w+" would erase
                         the file contents */
                      case foSeekWrite:
                      case foSeekUpdate:
                        how = DOSBIN ? "rb+" : "r+";
                        errcode = 444; /* %s cannot be opened for updating */
                        break;
                      default:
                        _p_internal_error (921); /* Unknown mode in _p_open */
                    }

                  if (how)
                    m_FILNUM(File) = fopen (filename, how);
                  else
                    m_FILNUM(File) = NULL;

                  /* Now, if the file could not be opened, but we want to only
                     read from or only write to it, check if that is possible */
                  if (! m_FILNUM (File))
                    {
                      switch (mode)
                        {
                          case foReset:
                          case foSeekRead:
                            m_FILNUM(File) = fopen(filename, DOSBIN ? "rb" : "r");
                            if (m_FILNUM(File))
                              {
                                SET_STATUS (File, FiRONLY);
                                _p_warning ("File is read only");
                              }
                            break;
                          case foRewrite:
                          case foSeekWrite:
                            m_FILNUM(File) = fopen(filename, DOSBIN ? "wb" : "w");
                            if (m_FILNUM(File))
                              {
                                SET_STATUS (File, FiWONLY);
                                _p_warning ("File is write only");
                              }
                            break;
                          case foAppend:
                            m_FILNUM(File) = fopen(filename, DOSBIN ? "ab" : "a");
                            if (m_FILNUM(File))
                              {
                                SET_STATUS (File, FiWONLY);
                                _p_warning ("File is write only");
                              }
                            break;
                          case foSeekUpdate:
                            /* nothing */
                            break;
                        }
                    }
                }
            }
          if (! m_FILNUM(File))
            {
              IOERROR_FILE (errcode, File,);
              filename = (char *)NULL;
            }
          else
            if (!tst_EXTB(File) && !_p_debug)
              unlink(filename);
        }

      File->PrivateData = m_FILNUM (File);

      if (fstat(fileno(m_FILNUM(File)), &finfo) == 0)
        {
          if (mode == foReset || foSeekRead)
            {
              if (NUMBYTE (File, finfo.st_size) == 0)
                set_EMPTY(File);
            }
          if (S_ISCHR(finfo.st_mode) || S_ISFIFO (finfo.st_mode)) set_FLUSH(File);
          if (S_ISCHR(finfo.st_mode) && isatty(fileno(m_FILNUM(File)))) set_TTY(File);

          /* Regular files and block devies are assumed seekable, nothing else.
             stdin, stdout, stderr are considered non-seekable (even if they're
             redirected to something seekable) to cause uniform behaviour for
             different kinds of input/output. The size is known only for
             regular files. */
          if (!stdinout && S_ISREG(finfo.st_mode)) set_SIZEK(File);
          if (!stdinout && (S_ISREG(finfo.st_mode) || S_ISBLK(finfo.st_mode))) set_SEEK(File);
        }
    }
  if (mode == foRewrite || mode == foSeekWrite || mode == foAppend) SET_STATUS(File, FiWRI);
  if (mode == foReset   || mode == foSeekRead  || mode == foSeekUpdate || (!tst_TXT(File) && !is_WONLY(File))) SET_STATUS(File, FiORE);
  if (!(is_RONLY(File) || is_WONLY(File) || tst_TXT(File))) SET_STATUS(File, FiRND);
  if (tst_TXT (File)) set_EOFOK (File);

  switch (mode)
    {
      case foAppend:
        if (tst_TXT (File) && !tst_EMPTY(File))
          {
            if (is_WONLY(File))
              _p_warning_string ("Write only text file `%s' append. Trailing EOLN not checked", m_NAM(File));
            else if (_p_seek (File, -1, SEEK_END, 0))
              _p_warning_string ("Can't check trailing EOLN when appending `%s'", m_NAM(File));
            else
              {
                _p_internal_getc (File);
                #if defined(__EMX__)
                _p_internal_getc (File);
                #endif
                /* file pointer is now at EOF */
                if (!tst_EOLN (File) && (putc(NEWLINE, m_FILNUM (File)) == EOF))
                  IOERROR_FILE (437, File,); /* cannot append implicit EOLN to %s in append mode */
              }
          }
        /* FALLTHROUGH */
      case foRewrite:
        set_EOF(File);
        clr_EOLN(File);
        set_LGET (File);
        break;

      case foReset:
        clr_EOF(File);
        clr_EOLN(File);
        clr_UND (File);
        set_LGET(File);
        if (tst_TXT(File) && tst_TTY(File))
          {
            if (_p_eoln_reset_hack)
              set_EMPTY (File); /* Mark for EOLN; nothing has been read yet */
            else
              clr_EMPTY(File);
          }
        /* Please do not remove this. It's here as an inside joke */
        D(1, fprintf(stderr,"Kukkuu RESET (TM)\n"));
        break;

      case foSeekRead:
      case foSeekWrite:
      case foSeekUpdate:
        /* NOTHING */
    }
  if (File->ReadFunc == _p_f_read_tty || File->ReadFunc == _p_f_read)
    {
      if (tst_SEEK (File) && !tst_TTY (File))
        File->ReadFunc = _p_f_read;
      else
        File->ReadFunc = _p_f_read_tty;
    }
  File->Flags = 0;
  _p_clearbuffer (File);
  /* Add to FDR chain. Do it only when necessary, to speed up e.g. the
     string TFDD */
  if (File->FlushProc || File->CloseProc || File->DoneProc) _p_fdrchain(File, TRUE);
}

void
_p_rewrite(File, filename, length)
FDR File; char *filename; int length;
{
  if (length) _p_internal_assign (File, filename, length);
  _p_open (File, foRewrite);
}

void
_p_extend(File, filename, length)
FDR File; char *filename; int length;
{
  if (length) _p_internal_assign (File, filename, length);
  _p_open (File, foAppend);
}

void
_p_reset(File, filename, length)
FDR File; char *filename; int length;
{
  if (length) _p_internal_assign (File, filename, length);
  _p_open (File, foReset);
}

inline int
_p_ok_READ(File)
    FDR File;
{
  if (is_READABLE(File)) return 1;
  IOERROR_FILE (452,File,0); /* %s is not open for reading */
}

inline int
_p_ok_EOF(File)
    FDR File;
{
  if (_p_inoutres || !_p_ok_READ) return 0;
  if (!tst_EOF(File)) return 1;
  if (!(File->Flags & READ_WRITE_STRING_MASK))
    IOERROR(550,0); /* Attempt to read past end of string in `ReadStr'*/
  else
    IOERROR_FILE (454,File,0); /* attempt to read past end of %s */
}

inline int
_p_ok_WRITE(File)
    FDR File;
{
  if (is_WRITABLE(File)) return 1;
  IOERROR_FILE (450,File,0); /* %s is not open for writing */
}

size_t
_p_f_read(File, Buf, Size)
void *File; char *Buf; size_t Size;
{
  size_t result = fread (Buf, 1, Size, (FILE *) File);
  if (ferror ((FILE *) File))
    {
      clearerr ((FILE *) File);
      _p_inoutres = 464; /* error when reading from %s */
    }
  return result;
}

size_t
_p_f_read_tty (File, Buf, Size)
void *File; char *Buf; size_t Size;
{
  size_t result;
  /* read only one line at a time from TTYs */
  if (fgets (Buf, Size, (FILE *) File))
    result = _p_strlen (Buf);
  else
    result = 0;
  if (ferror ((FILE *) File))
    {
      clearerr ((FILE *) File);
      _p_inoutres = 464; /* error when reading from %s */
    }
  return result;
}

size_t
_p_f_write (File, Buf, Size)
void *File; const char *Buf; size_t Size;
{
  size_t result = fwrite (Buf, 1, Size, (FILE *) File);
  if (ferror ((FILE *) File))
    {
      clearerr ((FILE *) File);
      _p_inoutres = 466; /* error when writing to %s */
    }
  return result;
}

/* GET
 * pre-assertion: (f0.M = Inspection or f0.M = Update) and
 *                (neither f0.L nor f0.R is undefined) and
 *                (f0.R <> S())
 * post-assertion:(f.M = f0.M) and (f.L = f0.L~S(f0.R.first)) and
 *                (f.R = f0.R.rest)) and
 *                (if (f.R = S()) then
 *                    (f^ is undefined)
 *                  else
 *                    (f^ = f.R.first))
 *
 */
void
_p_get(File)
FDR     File;
{
  if (_p_inoutres) return;
  _p_got(File);
  if (_p_inoutres) return;
  _p_lazyget(File);
  if (_p_inoutres) return;
}

void
_p_got(File)
FDR     File;
{
  if (_p_inoutres) return;
  _p_lazyget(File);
  if (_p_inoutres) return;
  set_LGET(File);
}

Boolean
_p_data_ready (File)
FDR File;
{
  int fn;
  fd_set f;
  struct timeval tv;
  if (m_STATUS(File) == FiNOP)
    return 0;
  if (tst_SEEK (File))
    {
      int position, size;

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

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

      return position < size;
    }
  if (tst_EOF (File))
    return 0;
  /* @@ the TFDD mechanism actually needs a new function here */
  if (File->ReadFunc != _p_f_read_tty && File->ReadFunc != _p_f_read)
    return !_p_eof (File);
  fn = fileno (m_FILNUM (File));
  FD_ZERO (&f);
  FD_SET (fn, &f);
  tv.tv_sec = 0;
  tv.tv_usec = 0;
  return select (fn + 1, &f, NULL, NULL, &tv) > 0 && !_p_eof (File);
}

/* The standard requires that EOLN be set before EOF in text files.
 *
 * Based on this I do not validate an undefined buffer for text files
 * when reading from a terminal if EOLN is not set.
 */
int
_p_eof (File)
FDR     File;
{
  if (_p_inoutres) return 1;
  if (m_STATUS(File) == FiNOP)
    IOERROR_FILE (455,File,1); /* `Eof' tested for unopened %s */

  if (!tst_TXT (File) && tst_SEEK (File))
    {
      int position, size;

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

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

      return position >= size;
    }

  /* If EOF is already set, don't try to read past EOF */
  if (tst_EOF (File))
    return 1;

  if (tst_LGET (File) && is_READABLE (File))
  {
    /* If we do not have EOLN or EOFOK when reading from terminal text file,
     * this can't be eof */
    if (tst_TXT(File) && tst_TTY(File) && !(tst_EOLN(File) || tst_EOFOK(File)))
      return 0;
    else
      {
        _p_lazyget (File);
        if (_p_inoutres) return 1;
      }
  }
  return tst_EOF (File);
}

int
_p_eoln (File)
     FDR File;
{
  if (_p_inoutres) return 1;
  if (m_STATUS(File) == FiNOP)
    IOERROR_FILE (456,File,1); /* `Eoln' tested for unopened %s */
  if (!tst_TXT (File))
    IOERROR_FILE (458,File,1); /* `Eoln' applied to non-text %s */
  if (tst_LGET (File) && is_READABLE (File))
    {
      if (tst_UND (File))
        {
          /* If EOLN is tested in TERMINAL DEVICE where nothing has
           * been read yet, return TRUE
           * If it is not tested, it is FALSE.
           *
           * EMPTY is a special flag in this case, set before anything
           * is read. On direct access files it means what it says.
           */
          if (tst_TTY(File) && tst_EMPTY(File))
            {
              m_FILBUF (File) = ' ';
              set_EOLN (File);
              clr_LGET (File);
              clr_UND  (File);
              clr_EMPTY(File);
              
              return TRUE;
            }
        }
      _p_lazyget (File);
      if (_p_inoutres) return 1;
    }

  if (tst_EOF(File))
    IOERROR_FILE (457,File,1); /* `Eoln' tested for %s when `Eof' is true */
  
  return tst_EOLN (File);
}

void
_p_read_buffer (File)
FDR File;
{
  File->BufPos = 0;
  if (File->hack_InFunc)
    {
      int errcode = File->hack_InFunc (File->PrivateData, File->BufPtr, FILE_BUFSIZE, &File->BufSize);
      if (errcode) IOERROR_FILE (errcode, File,);
    }
  else if (File->ReadFunc)
    {
      File->BufSize = File->ReadFunc (File->PrivateData, File->BufPtr, FILE_BUFSIZE);
      if (_p_inoutres) IOERROR_FILE (_p_inoutres, File,);
    }
  else
    File->BufSize = 0;
}

static void
_p_internal_fread(ptr, size, presult, File)
    void *ptr; size_t size; size_t *presult; FDR File;
{
  size_t result = 0;
  if (tst_EOF (File)) return;
  while (_p_inoutres == 0 && result < size)
    {
      if (File->BufPos < File->BufSize)
        {
          int r = File->BufSize - File->BufPos;
          if (r > size - result) r = size - result;
          memcpy (ptr, File->BufPtr + File->BufPos, r);
          File->BufPos += r;
          ((unsigned char *)ptr) += r;
          result += r;
        }
      if (result < size)
        {
          _p_read_buffer (File);
          if (File->BufPos >= File->BufSize)
            {
              set_EOF (File);
              set_EOLN (File);
              break;
            }
        }
    }
  if (presult)
    *presult = result;
  else
    if (!_p_inoutres && result != size)
      IOERROR_FILE (465, File,); /* cannot read all the data from %s */
}

/* Gets ONE BYTE from the file. */
void
_p_getbyte(File)
FDR     File;
{
  int temp;
  int eof_now;

  if (!_p_ok_EOF(File)) return;

  eof_now = tst_EOFOK(File);

  if (tst_TTY(File))
    {
      _p_fflush(TRUE);

      /* First get from the terminal input device
       * This is done to take care of an EOLN test
       * before anything is read in. Otherwise we
       * would have to read in a character to test.
       *
       * @@ Document: If INPUT is RESET, the file buffer
       * is set UNDEFINED and when nothing is read in yet:
       *
       * EOF(input) = False
       *
       *   (This is according to standard, because EOLN must be on
       *    before EOF can be TRUE).
       *
       * EOLN(Input)
       *
       *   If it is TESTED it is TRUE.
       *   If it is NOT TESTED it is FALSE
       */
      if (tst_EMPTY(File) && tst_UND(File) && tst_LGET(File))
        clr_EMPTY(File);
    }

  clr_UND(File);
  clr_LGET(File);
  clr_EOFOK(File);

  m_FILBUF(File) = temp = _p_internal_getc(File);

  while (1)
    if (temp != EOF)
      break;
    else
      {
        /* If we are reading from the options file and this is the end
         * of _p_current_stdin, continue with the original stdin
         * instead of quitting.
         */
        if (_p_current_stdin && m_FILNUM(File) == _p_current_stdin && _p_restore_stdin(File))
          {
            clr_EOF (File);
            m_FILBUF(File) = temp = _p_internal_getc(File);
            continue;
          }

        if (tst_TXT(File) && !eof_now
            && !tst_EOLN(File) && !tst_EMPTY(File))
          {
            /* When reading from TEXT file EOLN is always true
               just before EOF, even if there is no end of line
               at the end of the file */
            set_EOLN(File);
            m_FILBUF(File) = ' ';
          }
        else
          {
            set_EOF(File);
            set_UND(File);
          }
        return;
      }
}

/* Gets m_SIZ bytes (> 1) from the file. */
static void
_p_get_n(File)
     FDR File;
{
  size_t n;
  if (!_p_ok_EOF(File)) return;
  clr_UND(File);
  _p_internal_fread (m_FILBPTR (File), m_SIZ (File), &n, File);
  if (_p_inoutres) return;
  if (n < m_SIZ(File))
    {
      if (n != 0)
        _p_warning ("GET partial record");
      else
        {
          set_EOF(File);
          clr_EOLN(File);
        }
      set_UND (File);
    }
  else
    clr_LGET(File);
}

/* This is the buffer referencing routine, that the compiler
 * should do inline. Nothing is actually done, if tst_LGET(File)
 * is not on. Compiler should dereference the file buffer address
 * to get the value from the buffer.
 */
void
_p_lazytryget(File)
FDR File;
{
  if (_p_inoutres) return;

#if 0
  /* @@ This is called also for "buffer^ := VAL;"
   * So it must not blindly trap the reference
   *
   * Compiler should clear the UND bit for these...
   */
  if (tst_UND (File) && !tst_LGET (File))
    IOERROR_FILE (440, File,); /* reference to buffer variable of %s with undefined value */
#endif  

  /* If the file buffer contents is lazy, validate it */
  if (tst_LGET(File))
    {
      if (!is_READABLE(File) || tst_EOF(File))
        {
          /* Buffer cannot be read in. But perhaps someone only wants to
             write to it, who knows? (This routine doesn't know, and that's
             the problem!)-: . So we zero it and mark it undefined. :-*/
          set_UND(File);
        }
      else
        if (m_SIZ(File) == 1) /* No files are packed yet. */
          {
            _p_getbyte (File);
            if (_p_inoutres) return;
          }
        else
          {
            _p_get_n(File);
            if (_p_inoutres) return;
          }
    }
}

/* This is the buffer referencing routine for read-only access. */
void
_p_lazyget(File)
FDR File;
{
  if (_p_inoutres) return;

  /* If the file buffer contents is lazy, validate it */
  if (tst_LGET(File))
    {
      if (!_p_ok_READ(File)) return;
      if (m_SIZ(File) == 1) /* No files are packed yet. */
        {
          _p_getbyte (File);
          if (_p_inoutres) return;
        }
      else
        {
          _p_get_n(File);
          if (_p_inoutres) return;
        }
    }
}

/* Empty a file buffer before writing to it */
void
_p_lazyunget(File)
FDR File;
{
  if (_p_inoutres) return;
  /* If the file buffer content is filled, clear it and seek back */
  if (!tst_LGET(File))
    {
      _p_seek (File, -1, SEEK_CUR, 0);
      clr_EOF(File);
      clr_EOLN(File);
      set_LGET(File);
      set_UND(File);
    }
}

void
_p_page(File)
FDR File;
{
  char c = NEWPAGE;
  size_t i;
  if (_p_inoutres || !_p_ok_WRITE(File)) return;
  _p_internal_fwrite (&c, sizeof (c), &i, File);
}

/* PUT
 * pre-assertion: (f0.M = Generation or f0.M = Update) and
 *    (neither f0.L nor f0.R is undefined) and
 *    (f0.R = S() or f is a direct access file type) and
 *    (f0^ is not undefined)
 * post-assertion:(f.M = f0.M) and (f.L = f0.L~S(f0^)) and
 *    (if f0.R = S() then
 *       (f.R = S())
 *    else
 *      (f.R = f0.R.rest)) and
 *      (if (f.R = S()) or (f0.M = Generation) then
 *        (f^ is undefined)
 *      else
 *        (f^ = f.R.first))
 *
 */
void
_p_put(File)
     FDR File;
{
  size_t n;

  if (_p_inoutres || !_p_ok_WRITE(File)) return;

  _p_internal_fwrite (m_FILBPTR (File), m_SIZ (File), &n, File);
  if (_p_inoutres) return;
  if (n == 0)
    IOERROR_FILE (434,File,); /* `Put' failed on %s - nothing written */
  else if (n != m_SIZ(File))
    IOERROR_FILE (435,File,); /* `Put' failed on %s - partial record written */
  
  if (tst_DIRECT (File) || tst_FLUSH(File))
    _p_flush (File);

  /* f^ set undefined if eof or mode is generation */
  if (tst_EOF(File) || !TST_STATUS(File, FiRND))
    set_UND (File);
}

void
_p_close(File)
     FDR File;
{
  if (_p_inoutres) return;

  if (m_STATUS(File) == FiNOP)
    return;

  set_EOF(File);

  if (TST_STATUS(File, FiANY))
    {
      _p_flush (File);
      if (File->CloseProc == DefaultCloseProc)
        {
          if (m_FILNUM(File) != _p_current_stdin &&
              m_FILNUM(File) != stdin &&
              m_FILNUM(File) != stdout &&
              m_FILNUM(File) != stderr)
            fclose(m_FILNUM(File));
          File->PrivateData = m_FILNUM(File) = NULL;
        }
      else if (File->CloseProc)
        File->CloseProc (File->PrivateData);
    }

  _p_fdrchain(File, FALSE); /* Remove from chain */

  if (m_EXTNAM(File))
    {
      if (! m_BINDING (File))
        (void) _p_dispose (m_EXTNAM(File));
      m_EXTNAM (File) = NULL;
    }

  _p_initfdr(File, m_NAM (File), 0,
    (tst_TXT(File)       << fkind_TEXT     |
     tst_PCK(File)       << fkind_PACKED   |
     tst_EXT(File)       << fkind_EXTERN   |
     tst_DIRECT(File)    << fkind_DIRECT   |
     tst_BYTE(File)      << fkind_BYTE     |
     tst_BINDABLE (File) << fkind_BINDABLE |
     1 << fkind_CLOSE));
  m_BNDCHG (File) = 1;
}

void
_p_donefdr(File)
    FDR File;
{
  _p_close (File);
  if (File->DoneProc)
    {
      File->DoneProc (File->PrivateData);
      File->DoneProc = NULL;
    }
}

/* get external file name */
char *
_p_filename(File)
const FDR File;
{
  return m_EXTNAM (File);
}

/* get internal or external file name with a description -- currently used
   for error messages. NOTE: result is only valid until the function gets
   called again */
char *
_p_get_file_name(File)
const FDR File;
{
  static char *buf = NULL;
  if (buf) _p_dispose (buf);
  if (isStdFile (File))
    buf = _p_strdup (m_NAM (File));
  else if (File -> hack_InFunc || (File -> ReadFunc != _p_f_read && File -> ReadFunc != _p_f_read_tty))
    {
      buf = (char *) _p_malloc (26 + _p_strlen (m_NAM(File)));
      if (buf) sprintf (buf, "TFDD file `%s'", m_NAM(File));
    }
  else if (m_BINDING(File) && m_BINDING(File) -> CFile && m_BNDNAM(File)[0] == 0)
    {
      buf = (char *) _p_malloc (36 + _p_strlen (m_NAM(File)));
      if (buf) sprintf (buf, "file `%s' bound to CFile", m_NAM(File));
    }
  else if (tst_EXTB (File))
    {
      buf = (char *) _p_malloc (18 + _p_strlen (m_EXTNAM(File)));
      if (buf) sprintf (buf, "file `%s'", m_EXTNAM(File));
    }
  else
    {
      buf = (char *) _p_malloc (27 + _p_strlen (m_NAM(File)));
      if (buf) sprintf (buf, "internal file `%s'", m_NAM(File));
    }
  if (buf)
    return buf;
  else
    return m_NAM (File);
}

void
_p_erase(File)
FDR File;
{
  if (_p_inoutres) return;
  if (m_BINDING (File) && m_BINDING (File) -> Directory)
    IOERROR_STRING (473, m_BNDNAM (File),); /* `Erase' cannot erase directory `%s' */
  check_binding (File);
  if (_p_inoutres) return;
  if (!tst_EXTB(File))
    IOERROR_FILE (468, File,); /* cannot erase %s */
  if (!m_EXTNAM(File))
    IOERROR_STRING (469, m_NAM(File),); /* `Erase': external file `%s' has no external name */
  if (m_STATUS(File) != FiNOP)
    IOERROR_FILE (470, File,); /* cannot erase opened %s */
  if (unlink (m_EXTNAM(File)) != 0)
    {
      switch (errno)
        {
          case ENOENT:
          case ENOTDIR: IOERROR_FILE (471, File,); /* `Erase': %s does not exist */
          case EACCES:
          case EPERM:
          case EISDIR:  IOERROR_FILE (472, File,); /* permission denied to erase %s */
          default:      IOERROR_FILE (474, File,); /* I/O error when trying to erase %s */
        }
    }
}

void
_p_rename(File, NewName)
FDR File; char *NewName;
{
  if (_p_inoutres) return;
  check_binding (File);
  if (_p_inoutres) return;
  if (!tst_EXTB(File))
    IOERROR_FILE (475, File,); /* cannot rename %s */
  if (!m_EXTNAM(File))
    IOERROR_STRING (476, m_NAM(File),); /* `Rename': external file `%s' has no external name */
  if (m_STATUS(File) != FiNOP)
    IOERROR_FILE (477, File,); /* cannot rename opened %s */
  if (access (NewName, F_OK) == 0)
    IOERROR_STRING (482, NewName,); /* `Rename': cannot overwrite file `%s' */
  if (rename (m_EXTNAM(File), NewName) != 0)
    {
      switch (errno)
        {
          case ENOENT:
          case ENOTDIR: IOERROR_FILE (478, File,); /* `Rename': %s does not exist */
          case EBUSY:
          case EACCES:
          case EPERM:   IOERROR_FILE (479, File,); /* permission denied to rename %s */
          case EISDIR:  IOERROR_STRING (480, NewName,); /* `Rename': cannot overwrite directory `%s' */
          default:      IOERROR_FILE (481, File,); /* I/O error when trying to rename %s */
        }
    }
  _p_dispose (m_EXTNAM (File));
  m_EXTNAM (File) = _p_strdup (NewName);
  if (m_BINDING (File)) m_BNDNAM (File) = m_EXTNAM (File);
}

void
_p_chdir (path)
char *path;
{
  if (_p_inoutres) return;
  if (chdir (path) != 0)
    IOERROR_STRING (483, path,); /* cannot change to directory `%s' */
}

void
_p_mkdir (path)
char *path;
{
  if (_p_inoutres) return;
#if defined (_WIN32) && !defined (CYGWIN32)
  if (mkdir (path) != 0)
#else
  if (mkdir (path, 0777) != 0)
#endif
    IOERROR_STRING (484, path,); /* cannot make directory `%s' */
}

void
_p_rmdir (path)
char *path;
{
  if (_p_inoutres) return;
  if (rmdir (path) != 0)
    IOERROR_STRING (485, path,); /* cannot remove directory `%s' */
}

#ifndef HAVE_REALPATH

#ifndef MAXPATHLEN
#define MAXPATHLEN 2048
#endif

extern char *realpath PROTO ((char *, char []));

extern char _p_dirseparatorvar;

#define ISSLASH(ch) (ch == '/' || ch == _p_dirseparatorvar)
#define DOSDRIVE(name) (ISSLASH('\\') && *name != 0 && name [1] == ':')

char *
realpath (name, resolved_path)
char *name, *resolved_path;
{
  char *dest, *start, *end, *rpath_limit;
  rpath_limit = resolved_path + MAXPATHLEN;
  if (DOSDRIVE (name))
    {
      dest = resolved_path;
      *dest++ = *name++;
      *dest++ = *name++;
      if (*name) *dest++ = '/';
    }
  else if (!ISSLASH (*name) && getcwd (resolved_path, MAXPATHLEN))
    dest = strchr (resolved_path, '\0');
  else
    {
      *resolved_path = '/';
      dest = resolved_path + 1;
    }
  for (start = end = name; *start; start = end)
    {
      while (ISSLASH (*start)) ++start;
      for (end = start; *end && !ISSLASH (*end); ++end);
      if (end == start)
        break;
      else if (strncmp (start, ".", end - start) == 0)
        /* nothing */;
      else if (strncmp (start, "..", end - start) == 0) {
        if (dest > resolved_path + 1)
          while (!ISSLASH ((--dest)[-1]));
      } else {
        if (!ISSLASH (dest[-1])) *dest++ = '/';
        if (dest + (end - start) >= rpath_limit) return NULL;
        memcpy (dest, start, end - start);
        dest += end - start;
      }
    }
  if (dest > resolved_path + 1 + 2 * DOSDRIVE (resolved_path) && ISSLASH (dest[-1])) --dest;
  *dest = '\0';
  return resolved_path;
}
#endif

char *
_p_readdir_c (dir)
DIR *dir;
{
  struct dirent *d = readdir (dir);
  if (d)
    return d -> d_name;
  else
    return NULL;
}

int
_p_closedir (dir)
DIR *dir;
{
#ifdef CLOSEDIR_VOID
  closedir (dir);
  return 0;
#else
  return closedir (dir);
#endif
}

#if (defined(HAVE_UTIME_H) || defined(HAVE_SYS_UTIME_H)) && defined(HAVE_UTIME)
#ifdef HAVE_UTIME_H
#include <utime.h>
#else
#include <sys/utime.h>
#endif
#else
#ifndef time_t
#define time_t int
#endif
struct utimbuf
{
  time_t actime, modtime;
};
extern int utime PROTO ((const char *, struct utimbuf *));
int utime (filename, buf)
const char *filename;
struct utimbuf *buf;
{
  return -1;
}
#endif
void _p_set_file_time (File, Time)
FDR File;
UnixTimeType Time;
{
  struct utimbuf utim;
  if (_p_inoutres) return;
  check_binding (File);
  if (_p_inoutres) return;
  if (!tst_EXTB(File) || !m_EXTNAM(File))
    IOERROR_STRING (486, m_NAM(File),); /* `SetFTime': file `%s' has no external name */
  utim.actime = utim.modtime = (time_t) Time;
  if (utime (m_EXTNAM(File), &utim))
    IOERROR_FILE (487, File,); /* cannot set time for %s */
}

#ifdef HAVE_STATVFS
#include <sys/statvfs.h>
#elif defined(HAVE_STATFS)
#include <sys/vfs.h>
#endif

void
_p_statfs (path, buf)
char *path; statfsbuf *buf;
{
  int result;
  if (_p_inoutres) return;
  {
#ifdef HAVE_STATVFS
    struct statvfs b;
    result = statvfs (path, &b);
    buf -> f_block_size    = (longestint) b.f_frsize;
    buf -> f_blocks_total  = (longestint) b.f_blocks;
    buf -> f_blocks_free   = (longestint) b.f_bavail;
    buf -> f_files_total   = (int) b.f_files;
    buf -> f_files_free    = (int) b.f_favail;
#elif defined(HAVE_STATFS)
    struct statfs b;
    result = statfs (path, &b);
    buf -> f_block_size    = (longestint) b.f_bsize;
    buf -> f_blocks_total  = (longestint) b.f_blocks;
    buf -> f_blocks_free   = (longestint) b.f_bavail;
    buf -> f_files_total   = (int) b.f_files;
    buf -> f_files_free    = (int) b.f_ffree;
#else
    errno = ENOSYS;
    result = -1;
#endif
    if (result != 0)
      {
        buf -> f_block_size = 0;
        buf -> f_blocks_total = 0;
        buf -> f_blocks_free = 0;
        buf -> f_files_total = 0;
        buf -> f_files_free = 0;
        switch (errno)
          {
            case ENOSYS:  IOERROR(489,); /* `StatFS': function not supported */
            default:      IOERROR_STRING(490,path,); /* cannot stat file system `%s' */
          }
      }
  }
}

#if defined(HAVE_FNMATCH_H) && defined(HAVE_FNMATCH)
#include <fnmatch.h>
int _p_have_fnmatch = 1;
int _p_fnmatch (const char *pattern, const char *name)
{
  return fnmatch (pattern, name, FNM_PATHNAME | FNM_PERIOD);
}
#else
int _p_have_fnmatch = 0;
int _p_fnmatch (const char *pattern, const char *name)
{
  return -1;
}
#endif

#if defined(HAVE_GLOB_H) && defined(HAVE_GLOB)
#include <glob.h>
void _p_glob (globbuffer *gbuf, char *pattern)
{
  gbuf->buf = malloc (sizeof (glob_t));
  if (glob (pattern, GLOB_MARK, NULL, (glob_t *) gbuf->buf))
    gbuf->count = 0;
  else
    {
      gbuf->count  = ((glob_t *) gbuf->buf)->gl_pathc;
      gbuf->result = ((glob_t *) gbuf->buf)->gl_pathv;
    }
}

void _p_globfree (globbuffer *gbuf)
{
  globfree ((glob_t *) gbuf->buf);
  free (gbuf->buf);
}
#else
void _p_glob (globbuffer *gbuf, char *pattern)
{
  gbuf->count = 0;
}

void _p_globfree (globbuffer *gbuf)
{
}
#endif

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif
#ifndef WIFEXITED
#define WIFEXITED(S) (((S) & 0xff) == 0)
#endif
#ifndef WEXITSTATUS
#define WEXITSTATUS(S) (((S) & 0xff00) >> 8)
#endif

int _p_execute (char *CmdLine)
{
  int s;
  s = system (CmdLine);
  if (WIFEXITED (s))
    return WEXITSTATUS (s);
  IOERROR (488, 0); /* `Execute': cannot execute program */
}
