/*
 * file - file I/O routines callable by users
 *
 * Copyright (C) 1999-2007,2018,2021-2023  David I. Bell and Landon Curt Noll
 *
 * Primary author:  David I. Bell
 *
 * Calc is open software; you can redistribute it and/or modify it under
 * the terms of the version 2.1 of the GNU Lesser General Public License
 * as published by the Free Software Foundation.
 *
 * Calc 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 Lesser General
 * Public License for more details.
 *
 * A copy of version 2.1 of the GNU Lesser General Public License is
 * distributed with calc under the filename COPYING-LGPL.  You should have
 * received a copy with calc; if not, write to Free Software Foundation, Inc.
 * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *
 * Under source code control:   1991/07/20 00:21:56
 * File existed as early as:    1991
 *
 * chongo <was here> /\oo/\     http://www.isthe.com/chongo/
 * Share and enjoy!  :-)        http://www.isthe.com/chongo/tech/comp/calc/
 */

#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <stdlib.h>
#include "have_unistd.h"
#if defined(HAVE_UNISTD_H)
#  include <unistd.h>
#endif /* HAVE_UNISTD_H */
#include <ctype.h>
#include "calc.h"
#include "alloc.h"
#include "longbits.h"
#include "have_fgetsetpos.h"
#include "have_fpos_pos.h"
#include "fposval.h"
#include "file.h"
#include "strl.h"

#if defined(_WIN32) || defined(_WIN64)
#  include <io.h>
#endif

#include "errtbl.h"
#include "banned.h" /* include after system header <> includes */

#define READSIZE 1024 /* buffer size for reading */

#define MIN(a, b) (((a) <= (b)) ? (a) : (b))

/*
 * external STDIO functions
 */
E_FUNC void math_setfp(FILE *fp);
E_FUNC FILE *f_open(char *name, char *mode);

/*
 * Table of opened files.
 * The first three entries always correspond to stdin, stdout, and stderr,
 * and cannot be closed.  Their file ids are always 0, 1, and 2.
 */
STATIC FILEIO files[MAXFILES] = {{FILEID_STDIN, NULL, (dev_t)0, (ino_t)0, "(stdin)", true, false, false, false, 'r', "r"},
                                 {FILEID_STDOUT, NULL, (dev_t)0, (ino_t)0, "(stdout)", false, true, false, false, 'w', "w"},
                                 {FILEID_STDERR, NULL, (dev_t)0, (ino_t)0, "(stderr)", false, true, false, false, 'w', "w"}};

STATIC int ioindex[MAXFILES] = {0, 1, 2}; /* Indices for FILEIO table */
STATIC FILEID lastid = FILEID_STDERR;     /* Last allocated file id */
STATIC int idnum = 3;                     /* Number of allocated file ids */

/* forward static declarations */
S_FUNC ZVALUE filepos2z(FILEPOS pos);
S_FUNC FILEPOS z2filepos(ZVALUE pos);
S_FUNC int set_open_pos(FILE *fp, ZVALUE zpos);
S_FUNC int get_open_pos(FILE *fp, ZVALUE *res);
S_FUNC ZVALUE off_t2z(off_t siz);
S_FUNC ZVALUE dev2z(dev_t dev);
S_FUNC ZVALUE inode2z(ino_t inode);
S_FUNC void getscanfield(FILE *fp, bool skip, unsigned int width, int scannum, char *scanptr, char **strptr);
S_FUNC void getscanwhite(FILE *fp, bool skip, unsigned int width, int scannum, char **strptr);
S_FUNC int fscanfile(FILE *fp, char *fmt, int count, VALUE **vals);
S_FUNC void freadnum(FILE *fp, VALUE *valptr);
S_FUNC void freadsum(FILE *fp, VALUE *valptr);
S_FUNC void freadprod(FILE *fp, VALUE *valptr);
S_FUNC void fskipnum(FILE *fp);

/*
 * file_init - perform needed initialization work
 *
 * On some systems, one cannot initialize a pointer to a FILE *.
 * This routine, called once at startup is a work-a-round for
 * systems with such bogons.
 *
 * We will also probe for any open files beyond stderr and set them up.
 */
void
file_init(void)
{
    STATIC int done = 0; /* 1 => routine already called */
    struct stat sbuf;    /* file status */
    FILEIO *fiop;
    FILE *fp;
    int i;

    if (!done) {
        /*
         * setup the default set
         */
        files[0].fp = stdin;
        files[1].fp = stdout;
        files[2].fp = stderr;
        for (i = 0; i < 3; ++i) {
            if (fstat(i, &sbuf) >= 0) {
                files[i].dev = sbuf.st_dev;
                files[i].inode = sbuf.st_ino;
            }
        }

        /*
         * note any other files that we can find
         */
        fiop = &files[3];
        for (i = 3; i < MAXFILES; fiop++, ++i) {
            char *tname;

            fiop->name = NULL;
            files[idnum].reading = true;
            files[idnum].writing = true;
            files[idnum].action = 0;
            memset(files[idnum].mode, 0, MODE_LEN + 1);
            /*
             * stat the descriptor to see what we have
             */
            if (fstat(i, &sbuf) >= 0) {
                size_t snprintf_len;          /* malloced snprintf length */
                fp = (FILE *)fdopen(i, "r+"); /*guess mode*/
                if (fp) {
                    strlcpy(files[idnum].mode, "r+", sizeof(files[idnum].mode));
                } else {
                    fp = (FILE *)fdopen(i, "r");
                    if (fp) {
                        strlcpy(files[idnum].mode, "r", sizeof(files[idnum].mode));
                        files[idnum].writing = false;
                    } else {
                        fp = (FILE *)fdopen(i, "w");
                        if (fp) {
                            strlcpy(files[idnum].mode, "w", sizeof(files[idnum].mode));
                            files[idnum].reading = false;
                        } else {
                            continue;
                        }
                    }
                }
                snprintf_len = sizeof("descriptor[12345678901234567890]") + 1;
                tname = (char *)malloc(snprintf_len + 1);
                if (tname == NULL) {
                    math_error("Out of memory for init_file");
                    not_reached();
                }
                snprintf(tname, snprintf_len, "descriptor[%d]", i);
                tname[snprintf_len] = '\0'; /* paranoia */
                files[idnum].name = tname;
                files[idnum].id = idnum;
                files[idnum].fp = fp;
                files[idnum].dev = sbuf.st_dev;
                files[idnum].inode = sbuf.st_ino;
                ioindex[idnum] = idnum;
                idnum++;
                lastid++;
            }
        }

        done = 1;
    }
}

/*
 * init_fileio - initialize a FILEIO structure
 *
 * This function initializes a calc FILEIO structure.  It will optionally
 * malloc the filename string if given an non-NULL associated filename.
 * It will canonicalize the file open mode string.
 *
 * given:
 *      fiop    pointer to FILEIO structure to initialize
 *      name    associated filename (NULL => caller will setup filename)
 *      mode    open mode (one of {r,w,a}{,b}{,+})
 *      sbufp   pointer to stat of open file
 *      id      calc file ID
 *      fp      open file stream
 */
S_FUNC void
init_fileio(FILEIO *fiop, char *name, char *mode, struct stat *sbufp, FILEID id, FILE *fp)
{
    char modestr[MODE_LEN + 1]; /* mode [rwa]b?\+? */
    size_t namelen;             /* length of name */

    /* clear modestr */
    memset(modestr, 0, sizeof(modestr));

    /* allocate filename if requested */
    namelen = 0;
    if (name != NULL) {
        namelen = strlen(name);
        fiop->name = (char *)malloc(namelen + 1);
        if (fiop->name == NULL) {
            math_error("No memory for filename");
            not_reached();
        }
    }

    /* initialize FILEIO structure */
    if (name != NULL) {
        strlcpy(fiop->name, name, namelen + 1);
    }
    fiop->id = id;
    fiop->fp = fp;
    fiop->dev = sbufp->st_dev;
    fiop->inode = sbufp->st_ino;
    fiop->reading = false;
    fiop->writing = false;
    fiop->appending = false;
    fiop->binary = false;
    fiop->action = 0;
    memset(fiop->mode, 0, sizeof(fiop->mode));

    /*
     * determine file open mode
     *
     * While a leading 'r' is for reading and a leading 'w' is
     * for writing, the presence of a '+' in the string means
     * both reading and writing.  A leading 'a' means append
     * which is writing.
     */
    /* canonicalize read modes */
    if (mode[0] == 'r') {

        /* note read mode */
        strlcpy(modestr, "r", sizeof(modestr));
        fiop->reading = true;

        /* note binary mode even though mode is not used / ignored */
        if (strchr(mode, 'b') != NULL) {
            strlcat(modestr, "b", sizeof(modestr));
        }

        /* note if reading and writing */
        if (strchr(mode, '+') != NULL) {
            fiop->writing = true;
            strlcat(modestr, "+", sizeof(modestr));
        }

        /* canonicalize write modes */
    } else if (mode[0] == 'w') {

        /* note write mode */
        strlcpy(modestr, "w", sizeof(modestr));
        fiop->writing = true;

        /* note binary mode even though mode is not used / ignored */
        if (strchr(mode, 'b') != NULL) {
            strlcat(modestr, "b", sizeof(modestr));
        }

        /* note if reading and writing */
        if (strchr(mode, '+') != NULL) {
            fiop->reading = true;
            strlcat(modestr, "+", sizeof(modestr));
        }

        /* canonicalize append modes */
    } else if (mode[0] == 'a') {

        /* note append mode */
        strlcpy(modestr, "a", sizeof(modestr));
        fiop->writing = true;
        fiop->appending = true;

        /* note binary mode even though mode is not used / ignored */
        if (strchr(mode, 'b') != NULL) {
            strlcat(modestr, "b", sizeof(modestr));
        }

        /* note if reading and writing */
        if (strchr(mode, '+') != NULL) {
            fiop->reading = true;
            strlcat(modestr, "+", sizeof(modestr));
        }

        /* canonicalize no I/O modes */
    } else {
        modestr[0] = '\0';
    }
    modestr[MODE_LEN] = '\0'; /* firewall */

    /* record canonical open mode string */
    strlcpy(fiop->mode, modestr, sizeof(fiop->mode));
}

/*
 * openid - open the specified file name for reading or writing
 *
 * given:
 *      name            file name
 *      mode            open mode (one of {r,w,a}{,b}{,+})
 *
 * returns:
 *      >=3 FILEID which can be used to do I/O to the file
 *      <0 if the open failed
 *
 * NOTE: This function will not return 0, 1 or 2 since they are
 *       reserved for stdin, stdout, stderr.  In fact, it must not
 *       return 0, 1, or 2 because it will confuse those who call
 *       the opensearchfile() function
 */
FILEID
openid(char *name, char *mode)
{
    FILEIO *fiop; /* file structure */
    FILEID id;    /* new file id */
    FILE *fp;
    struct stat sbuf; /* file status */
    int i;

    /* find the next open slot in the files array */
    if (idnum >= MAXFILES) {
        return -E_MANYOPEN;
    }
    fiop = &files[3];
    for (i = 3; i < MAXFILES; fiop++, i++) {
        if (fiop->name == NULL) {
            break;
        }
    }
    if (i == MAXFILES) {
        math_error("This should not happen in openid()!!!");
    }

    /* open the file */
    fp = f_open(name, mode);
    if (fp == NULL) {
        return FILEID_NONE;
    }
    if (fstat(fileno(fp), &sbuf) < 0) {
        math_error("bad fstat");
        not_reached();
    }

    /* get a new FILEID */
    id = ++lastid;
    ioindex[idnum++] = i;

    /* initialize FILEIO structure */
    init_fileio(fiop, name, mode, &sbuf, id, fp);

    /* return calc open file ID */
    return id;
}

/*
 * openpathid - open the specified base filename, or
 *              relative filename along a search path
 *
 * given:
 *      name            file name
 *      mode            open mode (one of {r,w,a}{,b}{,+})
 *      pathlist        list of colon separated paths (or NULL)
 *
 * returns:
 *      >=3 FILEID which can be used to do I/O to the file
 *      <0 if the open failed
 *
 * NOTE: This function will not return 0, 1 or 2 since they are
 *       reserved for stdin, stdout, stderr.  In fact, it must not
 *       return 0, 1, or 2 because it will confuse those who call
 *       the opensearchfile() function
 */
FILEID
openpathid(char *name, char *mode, char *pathlist)
{
    FILEIO *fiop; /* file structure */
    FILEID id;    /* new file id */
    FILE *fp;
    struct stat sbuf; /* file status */
    char *openpath;   /* malloc copy of path that was opened */
    int i;

    /* find the next open slot in the files array */
    if (idnum >= MAXFILES) {
        return -E_MANYOPEN;
    }
    fiop = &files[3];
    for (i = 3; i < MAXFILES; fiop++, i++) {
        if (fiop->name == NULL) {
            break;
        }
    }
    if (i == MAXFILES) {
        math_error("This should not happen in openpathid()!!!");
    }

    /* open a file - searching along a path */
    openpath = NULL;
    fp = f_pathopen(name, mode, pathlist, &openpath);
    if (fp == NULL) {
        if (openpath != NULL) {
            /* should not happen, but just in case */
            free(openpath);
        }
        return FILEID_NONE;
    }
    if (fstat(fileno(fp), &sbuf) < 0) {
        if (openpath != NULL) {
            free(openpath);
        }
        math_error("bad fstat");
        not_reached();
    }
    if (openpath == NULL) {
        fclose(fp);
        math_error("bad openpath");
        not_reached();
    }

    /* get a new FILEID */
    id = ++lastid;
    ioindex[idnum++] = i;

    /* initialize FILEIO structure */
    init_fileio(fiop, NULL, mode, &sbuf, id, fp);
    fiop->name = openpath; /* already malloced by f_pathopen */

    /* return calc open file ID */
    return id;
}

/*
 * reopenid - reopen a FILEID
 *
 * given:
 *      id      FILEID to reopen
 *      mode    new mode to open as
 *      mode    new mode to open as (one of "r", "w", "a", "r+", "w+", "a+")
 *      name    name of new file
 *
 * returns:
 *      FILEID which can be used to do I/O to the file
 *      <0 if the open failed
 */
FILEID
reopenid(FILEID id, char *mode, char *name)
{
    FILEIO *fiop; /* file structure */
    FILE *fp;
    struct stat sbuf;
    int i;

    /* firewall */
    if ((id == FILEID_STDIN) || (id == FILEID_STDOUT) || (id == FILEID_STDERR)) {
        math_error("Cannot freopen stdin, stdout, or stderr");
        not_reached();
    }

    /* reopen the file */
    fiop = NULL;
    for (i = 3; i < idnum; i++) {
        fiop = &files[ioindex[i]];
        if (fiop->id == id) {
            break;
        }
    }
    if (i == idnum) {
        if (name == NULL) {
            fprintf(stderr, "File not open, need file name\n");
            return FILEID_NONE;
        }
        if (idnum >= MAXFILES) {
            fprintf(stderr, "Too many open files\n");
            return FILEID_NONE;
        }
        for (fiop = &files[3], i = 3; i < MAXFILES; fiop++, i++) {
            if (fiop->name == NULL) {
                break;
            }
        }
        if (i >= MAXFILES) {
            math_error("This should not happen in reopenid");
            not_reached();
        }
        fp = f_open(name, mode);
        if (fp == NULL) {
            fprintf(stderr, "Cannot open file\n");
            return FILEID_NONE;
        }
        ioindex[idnum++] = i;
        fiop->id = id;
    } else {
        (void) fclose(fiop->fp);
        if (name == NULL) {
            fp = f_open(fiop->name, mode);
        } else {
            fp = f_open(name, mode);
        }
        if (fp == NULL) {
            free(fiop->name);
            fiop->name = NULL;
            idnum--;
            for (; i < idnum; i++) {
                ioindex[i] = ioindex[i + 1];
            }
            return FILEID_NONE;
        }
    }
    if (fstat(fileno(fp), &sbuf) < 0) {
        math_error("bad fstat");
        not_reached();
    }

    /* initialize FILEIO structure */
    if (name == NULL) {
        if (fiop->name == NULL) {
            math_error("old and new reopen filenames are NULL");
        }
    } else if (fiop->name != NULL) {
        free(fiop->name);
        fiop->name = NULL;
    }
    init_fileio(fiop, name, mode, &sbuf, id, fp);

    /* return calc open file ID */
    return id;
}

/*
 * Find the file I/O structure for the specified file id, and verifies that
 * it is opened in the required manner (0 for reading or 1 for writing).
 * If writable is -1, then no open checks are made at all and NULL is then
 * returned if the id represents a closed file.
 */
FILEIO *
findid(FILEID id, int writable)
{
    FILEIO *fiop; /* file structure */
    int i;

    fiop = NULL;

    if ((id < 0) || (id > lastid)) {
        return NULL;
    }

    for (i = 0; i < idnum; i++) {
        fiop = &files[ioindex[i]];
        if (fiop->id == id) {
            break;
        }
    }

    if (i == idnum) {
        return NULL;
    }

    if (writable >= 0) {
        if ((writable && !fiop->writing) || (!writable && !fiop->reading)) {
            return NULL;
        }
    }
    return fiop;
}

/*
 * Return whether or not a file id is valid.  This is used for if tests.
 */
bool
validid(FILEID id)
{
    return (findid(id, -1) != NULL);
}

/*
 * Return the file with id = index if this is the id of a file that has been
 * opened (it may have since been closed).  Otherwise returns FILEID_NONE.
 */
FILEID
indexid(long index)
{
    FILEID id;

    id = (FILEID)index;

    if ((index < 0) || (id > lastid)) {
        return FILEID_NONE;
    }
    return id;
}

/*
 * Close the specified file id.  Returns true if there was an error.
 * Closing of stdin, stdout, or stderr is illegal, but closing of already
 * closed files is allowed.
 */
int
closeid(FILEID id)
{
    FILEIO *fiop; /* file structure */
    int i;
    int err;

    fiop = NULL;

    /* firewall */
    if ((id == FILEID_STDIN) || (id == FILEID_STDOUT) || (id == FILEID_STDERR)) {
        math_error("Cannot close stdin, stdout, or stderr");
        not_reached();
    }

    /* get file structure */
    for (i = 3; i < idnum; i++) {
        fiop = &files[ioindex[i]];
        if (fiop->id == id) {
            break;
        }
    }
    if (i == idnum) {
        return 1; /* File not open */
    }
    idnum--;
    for (; i < idnum; i++) {
        ioindex[i] = ioindex[i + 1];
    }

    free(fiop->name);
    fiop->name = NULL;

    /* close file and note error state */
    err = ferror(fiop->fp);
    err |= fclose(fiop->fp);
    fiop->fp = NULL;

    /* return success or failure */
    return (err ? EOF : 0);
}

int
closeall(void)
{
    FILEIO *fiop;
    int i;
    int err;

    err = 0;
    for (i = 3; i < idnum; i++) {
        fiop = &files[ioindex[i]];
        if (fiop->fp) {
            free(fiop->name);
            fiop->name = NULL;
            err |= fclose(fiop->fp);
        }
    }
    idnum = 3;
    return err;
}

/*
 * Return whether or not an error occurred to a file.
 */
bool
errorid(FILEID id)
{
    FILEIO *fiop; /* file structure */

    fiop = findid(id, -1);
    if (fiop == NULL) {
        return EOF;
    }
    return (ferror(fiop->fp) != 0);
}

/*
 * Return whether or not end of file occurred to a file.
 */
bool
eofid(FILEID id)
{
    FILEIO *fiop; /* file structure */

    fiop = findid(id, -1);
    if (fiop == NULL) {
        return EOF;
    }
    return (feof(fiop->fp) != 0);
}

/*
 * Flush output to an opened file.
 */
int
flushid(FILEID id)
{
    FILEIO *fiop; /* file structure */

    fiop = findid(id, -1);
    if (fiop == NULL) {
        return 0;
    }
    if (!fiop->writing || fiop->action == 'r') {
        return 0;
    }
    return fflush(fiop->fp);
}

#if !defined(_WIN32) && !defined(_WIN64)
int
flushall(void)
{
    FILEIO *fiop;
    int i;
    int err;

    err = 0;
    for (i = 3; i < idnum; i++) {
        fiop = &files[ioindex[i]];
        if (fiop->writing && fiop->action != 'r') {
            err |= fflush(fiop->fp);
        }
    }
    return err;
}
#endif /* Windows free systems */

/*
 * Read the next line, string or word from an opened file.
 * Returns a pointer to an allocated string holding a null-terminated
 * or newline terminated string.  Where reading stops is controlled by
 * flags:
 *
 *      bit 0:  at newline
 *      bit 1:  at null character
 *      bit 2:  at white space (also skips leading white space)
 *
 * If neither '\n' nor '\0' is encountered reading continues until EOF.
 * If bit 3 is set the stop character is removed.
 *
 * given:
 *      id              file to read from
 *      flags           read flags (see above)
 *      retstr          returned pointer to string
 */
int
readid(FILEID id, int flags, STRING **retstr)
{
    FILEIO *fiop; /* file structure */
    FILE *fp;
    char *str;            /* current string */
    unsigned long n;      /* current number characters read into buf */
    unsigned long totlen; /* total length of string copied from buf */
    char buf[READSIZE];   /* temporary buffer */
    char *b;
    int c;
    bool nlstop, nullstop, wsstop, rmstop, done;
    FILEPOS fpos;
    STRING *newstr;

    totlen = 0;
    str = NULL;

    fiop = findid(id, false);
    if (fiop == NULL) {
        return 1;
    }
    nlstop = (flags & 1);
    nullstop = (flags & 2);
    wsstop = (flags & 4);
    rmstop = (flags & 8);

    fp = fiop->fp;

    if (fiop->action == 'w') {
        f_tell(fp, &fpos);
        fflush(fp);
        if (f_seek_set(fp, &fpos) < 0) {
            return 3;
        }
    }
    fiop->action = 'r';

    if (wsstop) {
        while (isspace(c = fgetc(fp)))
            ;
        ungetc(c, fp);
    }

    for (;;) {
        b = buf;
        n = 0;
        do {
            c = fgetc(fp);
            if (c == EOF) {
                break;
            }
            n++;
            if (nlstop && c == '\n') {
                break;
            }
            if (nullstop && c == '\0') {
                break;
            }
            if (wsstop && isspace(c)) {
                break;
            }
            *b++ = c;
        } while (n < READSIZE);
        done = ((nlstop && c == '\n') || (nullstop && c == '\0') || (wsstop && isspace(c)) || c == EOF);
        if (done && rmstop && c != EOF) {
            n--;
        }
        if (totlen) {
            str = (char *)realloc(str, totlen + n + 1);
        } else {
            str = (char *)malloc(n + 1);
        }
        if (str == NULL) {
            math_error("Out of memory for readid");
            not_reached();
        }
        if (n > 0) {
            memcpy(&str[totlen], buf, n);
        }
        totlen += n;
        if (done) {
            break;
        }
    }
    if (totlen == 0 && c == EOF) {
        free(str);
        return EOF;
    }
    if ((nlstop && c == '\n') && !rmstop) {
        str[totlen - 1] = '\n';
    }
    if ((nullstop && c == '\0') && !rmstop) {
        str[totlen - 1] = '\0';
    }
    str[totlen] = '\0';
    newstr = stralloc();
    newstr->s_len = totlen;
    newstr->s_str = str;
    *retstr = newstr;
    return 0;
}

/*
 * Return the next character from an opened file.
 * Returns EOF if there was an error or end of file.
 */
int
getcharid(FILEID id)
{
    FILEIO *fiop;
    FILEPOS fpos;

    fiop = findid(id, false);
    if (fiop == NULL) {
        return -2;
    }
    if (fiop->action == 'w') {
        f_tell(fiop->fp, &fpos);
        fflush(fiop->fp);
        if (f_seek_set(fiop->fp, &fpos) < 0) {
            return -3;
        }
    }
    fiop->action = 'r';

    return fgetc(fiop->fp);
}

/*
 * Print out the name of an opened file.
 * If the file has been closed, a null name is printed.
 * If flags contain PRINT_UNAMBIG then extra information is printed
 * identifying the output as a file and some data about it.
 */
int
printid(FILEID id, int flags)
{
    FILEIO *fiop; /* file structure */
    FILE *fp;
    ZVALUE pos; /* file position */

    /*
     * filewall - file is closed
     */
    fiop = findid(id, -1);
    if (fiop == NULL) {
        if (flags & PRINT_UNAMBIG) {
            math_fmt("FILE %ld closed", id);
        } else {
            math_str("\"\"");
        }
        return 1;
    }

    /*
     * print quoted filename and mode
     */
    if ((flags & PRINT_UNAMBIG) == 0) {
        math_chr('"');
        math_str(fiop->name);
        math_chr('"');
        return 0;
    }
    math_fmt("FILE %ld \"%s\" (%s", id, fiop->name, fiop->mode);

    /*
     * print file position
     */

    fp = fiop->fp;

    if (get_open_pos(fp, &pos) < 0) {
        if (fileno(fp) > 2) {
            math_str("Error while determining file position!");
        }
        math_chr(')');
        return 0;
    }

    math_str(", pos ");
    zprintval(pos, 0, 0);
    zfree(pos);

    /*
     * report special status
     */
    if (ferror(fp)) {
        math_str(", error");
    }
    if (feof(fp)) {
        math_str(", eof");
    }
    math_chr(')');

    printf(" fileno: %d ", fileno(fp));
    return 0;
}

/*
 * Print a formatted string similar to printf.  Various formats of output
 * are possible, depending on the format string AND the actual types of the
 * values.  Mismatches do not cause errors, instead something reasonable is
 * printed instead.  The output goes to the file with the specified id.
 *
 * given:
 *      id              file id to print to
 *      count           print count
 *      fmt             standard format string
 *      vals            table of values to print
 */
int
idprintf(FILEID id, char *fmt, int count, VALUE **vals)
{
    FILEIO *fiop;
    VALUE *vp;
    char *str;
    int ch;
    size_t len;
    int oldmode, newmode;
    long olddigits, newdigits;
    long width, precision;
    bool didneg, didprecision;
    FILEPOS fpos;
    bool printstring;
    bool printchar;

    fiop = findid(id, true);
    if (fiop == NULL) {
        return 1;
    }
    if (fiop->action == 'r') {
        f_tell(fiop->fp, &fpos);
        if (f_seek_set(fiop->fp, &fpos) < 0) {
            return 3;
        }
    }

    fiop->action = 'w';

    printstring = false;
    printchar = false;

    math_setfp(fiop->fp);

    while ((ch = *fmt++) != '\0') {
        if (ch != '%') {
            math_chr(ch);
            continue;
        }

        /*
         * Here to handle formats.
         */
        didneg = false;
        didprecision = false;
        width = 0;
        precision = 0;

        ch = *fmt++;
        if (ch == '-') {
            didneg = true;
            ch = *fmt++;
        }
        while ((ch >= '0') && (ch <= '9')) {
            width = width * 10 + (ch - '0');
            ch = *fmt++;
        }
        if (ch == '.') {
            didprecision = true;
            ch = *fmt++;
            while ((ch >= '0') && (ch <= '9')) {
                precision = precision * 10 + (ch - '0');
                ch = *fmt++;
            }
        }
        if (ch == 'l') {
            ch = *fmt++;
        }

        oldmode = conf->outmode;
        newmode = oldmode;
        olddigits = conf->outdigits;
        newdigits = olddigits;
        if (didprecision) {
            newdigits = precision;
        }

        switch (ch) {
        case 's':
            printstring = true;
            /*FALLTHRU*/
        case 'c':
            printchar = true;
        case 'd':
            break;
        case 'f':
            newmode = MODE_REAL;
            break;
        case 'e':
            newmode = MODE_EXP;
            break;
        case 'n':
            newmode = MODE_ENG;
            break;
        case 'g':
            newmode = MODE_REAL_AUTO;
            break;
        case 'r':
            newmode = MODE_FRAC;
            break;
        case 'o':
            newmode = MODE_OCTAL;
            break;
        case 'x':
            newmode = MODE_HEX;
            break;
        case 'b':
            newmode = MODE_BINARY;
            break;
        case 0:
            math_setfp(stdout);
            return 0;
        default:
            math_chr(ch);
            continue;
        }

        if (--count < 0) {
            while (width-- > 0) {
                math_chr(' ');
            }
            continue;
        }
        vp = *vals++;

        math_setdigits(newdigits);
        math_setmode(newmode);

        /*
         * If there is no width specification, or if the type of
         * value requires multiple lines, then just output the
         * value directly.
         */
        if ((width == 0) || (vp->v_type == V_MAT) || (vp->v_type == V_LIST)) {
            switch (vp->v_type) {
            case V_OCTET:
                if (printstring) {
                    math_str((char *)vp->v_octet);
                } else if (printchar) {
                    math_chr(*vp->v_octet);
                } else {
                    printvalue(vp, PRINT_NORMAL);
                }
                break;
            case V_BLOCK:
                if (printstring) {
                    math_str((char *)vp->v_block->data);
                } else if (printchar) {
                    math_chr(*vp->v_block->data);
                } else {
                    printvalue(vp, PRINT_NORMAL);
                }
                break;
            case V_NBLOCK:
                if (printstring) {
                    if (vp->v_nblock->blk->data != NULL) {
                        math_str((char *)vp->v_nblock->blk->data);
                    }
                } else if (printchar) {
                    if (vp->v_nblock->blk->data != NULL) {
                        math_chr(*vp->v_nblock->blk->data);
                    }
                } else {
                    printvalue(vp, PRINT_NORMAL);
                }
                break;
            default:
                printvalue(vp, PRINT_NORMAL);
            }

            math_setmode(oldmode);
            math_setdigits(olddigits);
            continue;
        }

        /*
         * There is a field width.  Collect the output in a string,
         * print it padded appropriately with spaces, and free it.
         * However, if the output contains a newline, then ignore
         * the field width.
         */
        math_divertio();
        switch (vp->v_type) {
        case V_OCTET:
            if (printstring) {
                math_str((char *)vp->v_octet);
            } else if (printchar) {
                math_chr(*vp->v_octet);
            } else {
                printvalue(vp, PRINT_NORMAL);
            }
            break;
        case V_BLOCK:
            if (printstring) {
                math_str((char *)vp->v_block->data);
            } else if (printchar) {
                math_chr(*vp->v_block->data);
            } else {
                printvalue(vp, PRINT_NORMAL);
            }
            break;
        case V_NBLOCK:
            if (printstring) {
                if (vp->v_nblock->blk->data != NULL) {
                    math_str((char *)vp->v_nblock->blk->data);
                }
            } else if (printchar) {
                if (vp->v_nblock->blk->data != NULL) {
                    math_chr(*vp->v_nblock->blk->data);
                }
            } else {
                printvalue(vp, PRINT_NORMAL);
            }
            break;
        default:
            printvalue(vp, PRINT_NORMAL);
        }
        str = math_getdivertedio();
        if (strchr(str, '\n')) {
            width = 0;
        }
        len = strlen(str);
        while (!didneg && ((size_t)width > len)) {
            width--;
            math_chr(' ');
        }
        math_str(str);
        free(str);
        while (didneg && ((size_t)width > len)) {
            width--;
            math_chr(' ');
        }
        math_setmode(oldmode);
        math_setdigits(olddigits);
    }
    math_setfp(stdout);
    return 0;
}

/*
 * Write a character to a file.
 *
 * given:
 *      id              file id to print to
 *      ch              character to write
 */
int
idfputc(FILEID id, int ch)
{
    FILEIO *fiop;
    FILEPOS fpos;

    /* get the file info pointer */
    fiop = findid(id, true);
    if (fiop == NULL) {
        return 1;
    }
    if (fiop->action == 'r') {
        f_tell(fiop->fp, &fpos);
        if (f_seek_set(fiop->fp, &fpos) < 0) {
            return 2;
        }
    }

    fiop->action = 'w';

    /* set output to file */
    math_setfp(fiop->fp);

    /* write char */
    math_chr(ch);

    /* restore output to stdout */
    math_setfp(stdout);
    return 0;
}

/*
 * Unget a character read from a file.
 *
 * given:
 *      id              file id to print to
 *      ch              character to write
 */
int
idungetc(FILEID id, int ch)
{
    FILEIO *fiop;

    fiop = findid(id, false);
    if (fiop == NULL) {
        return -2;
    }
    if (fiop->action != 'r') {
        return -2;
    }
    return ungetc(ch, fiop->fp);
}

/*
 * Write a string to a file.
 *
 * given:
 *      id              file id to print to
 *      str             string to write
 */
int
idfputs(FILEID id, STRING *str)
{
    FILEIO *fiop;
    FILEPOS fpos;
    FILE *fp;
    char *c;
    long len;

    /* get the file info pointer */
    fiop = findid(id, true);
    if (fiop == NULL) {
        return 1;
    }

    if (fiop->action == 'r') {
        f_tell(fiop->fp, &fpos);
        if (f_seek_set(fiop->fp, &fpos) < 0) {
            return 2;
        }
    }

    fiop->action = 'w';

    fp = fiop->fp;
    len = str->s_len;
    c = str->s_str;

    while (len-- > 0) {
        fputc(*c++, fp);
    }

    return 0;
}

/*
 * Same as idfputs but writes a terminating null character
 *
 * given:
 *      id                      file id to print to
 *      str                     string to write
 */
int
idfputstr(FILEID id, char *str)
{
    FILEIO *fiop;
    FILEPOS fpos;

    /* get the file info pointer */
    fiop = findid(id, true);
    if (fiop == NULL) {
        return 1;
    }

    if (fiop->action == 'r') {
        f_tell(fiop->fp, &fpos);
        if (f_seek_set(fiop->fp, &fpos) < 0) {
            return 2;
        }
    }

    fiop->action = 'w';

    /* set output to file */
    math_setfp(fiop->fp);

    /* write the string */
    math_str(str);

    math_chr('\0');

    /* restore output to stdout */
    math_setfp(stdout);
    return 0;
}

int
rewindid(FILEID id)
{
    FILEIO *fiop;
    fiop = findid(id, -1);
    if (fiop == NULL) {
        return 1;
    }
    rewind(fiop->fp);
    fiop->action = 0;
    return 0;
}

void
rewindall(void)
{
    FILEIO *fiop;
    int i;

    for (i = 3; i < idnum; i++) {
        fiop = &files[ioindex[i]];
        if (fiop != NULL) {
            (void)rewind(fiop->fp);
            fiop->action = 0;
        }
    }
}

/*
 * filepos2z - convert a positive file position into a ZVALUE
 *
 * given:
 *      pos             file position
 *
 * returns:
 *      file position as a ZVALUE
 *
 * NOTE: Does not support negative file positions.
 */
/*ARGSUSED*/
S_FUNC ZVALUE
filepos2z(FILEPOS pos)
{
    ZVALUE ret; /* ZVALUE file position to return */

    /*
     * store FILEPOS in a ZVALUE as a positive value
     */
    ret.len = FILEPOS_BITS / BASEB;
    ret.v = alloc(ret.len);
    zclearval(ret);
    SWAP_HALF_IN_FILEPOS(ret.v, (HALF *)&pos);
    ret.sign = 0;
    ztrim(&ret);

    /*
     * return our result
     */
    return ret;
}

/*
 * z2filepos - convert a positive ZVALUE file position to a FILEPOS
 *
 * given:
 *      zpos            file position as a ZVALUE
 *
 * returns:
 *      file position as a FILEPOS
 *
 * NOTE: Does not support negative file positions.
 */
S_FUNC FILEPOS
z2filepos(ZVALUE zpos)
{
#if FILEPOS_BITS > FULL_BITS
    FILEPOS tmp; /* temp file position as a FILEPOS */
#endif
    FILEPOS ret; /* file position as a FILEPOS */
#if FILEPOS_BITS < FULL_BITS
    long pos; /* zpos as a long */
#else
    FULL pos; /* zpos as a FULL */
#endif

    /*
     * firewall
     */
    zpos.sign = 0; /* deal only with the absolute value */

    /*
     * quick return if the position can fit into a long
     */
#if FILEPOS_BITS == FULL_BITS
    /* ztofull puts the value into native byte order */
    pos = ztofull(zpos);
    memset(&ret, 0, sizeof(ret)); /* FILEPOS could be non-scalar */
    memcpy((void *)&ret, (void *)&pos, MIN(sizeof(ret), sizeof(pos)));
    return ret;
#elif FILEPOS_BITS < FULL_BITS
    /* ztofull puts the value into native byte order */
    pos = ztolong(zpos);
    memset(&ret, 0, sizeof(ret)); /* FILEPOS could be non-scalar */
    memcpy((void *)&ret, (void *)&pos, MIN(sizeof(ret), sizeof(pos)));
    return ret;
#else  /* FILEPOS_BITS > FULL_BITS */
    if (!zgtmaxfull(zpos)) {
        /* ztofull puts the value into native byte order */
        pos = ztofull(zpos);
        memset(&ret, 0, sizeof(ret)); /* FILEPOS could be non-scalar */
        memcpy((void *)&ret, (void *)&pos, MIN(sizeof(ret), sizeof(pos)));
        return ret;
    }

    /*
     * copy (and swap if needed) lower part of the ZVALUE as needed
     */
    if (zpos.len >= FILEPOS_BITS / BASEB) {
        /* copy the lower FILEPOS_BITS of the ZVALUE */
        memset(&tmp, 0, sizeof(tmp)); /* FILEPOS could be non-scalar */
        memcpy(&tmp, zpos.v, MIN(sizeof(tmp), FILEPOS_LEN));
    } else {
        /* copy what bits we can into the temp value */
        memset(&tmp, 0, sizeof(tmp)); /* FILEPOS could be non-scalar */
        memcpy(&tmp, zpos.v, MIN(sizeof(tmp), MIN(zpos.len * BASEB / 8, FILEPOS_LEN)));
    }
    /* swap into native byte order */
    SWAP_HALF_IN_FILEPOS(&ret, &tmp);

    /*
     * return our result
     */
    return ret;
#endif /* FILEPOS_BITS <= FULL_BITS */
}

/*
 * get_open_pos - get a an open file position
 *
 * given:
 *      fp              open file stream
 *      res             where to place the file position (ZVALUE)
 *
 * returns:
 *      0               res points to the file position
 *      -1              error
 */
S_FUNC int
get_open_pos(FILE *fp, ZVALUE *res)
{
    FILEPOS pos; /* current file position */

    /*
     * get the file position
     */
    if (f_tell(fp, &pos) < 0) {
        /* cannot get file position, return -1 */
        return -1;
    }

    /*
     * update file position and return success
     */
    *res = filepos2z(pos);
    return 0;
}

/*
 * getloc - get the current position of the file
 *
 * given:
 *      id      file id of the file
 *      loc     pointer to result
 *
 * returns:
 *      0       able to get file position
 *      -1      unable to get file position
 */
int
getloc(FILEID id, ZVALUE *res)
{
    FILEIO *fiop; /* file structure */
    FILE *fp;

    /*
     * convert id to stream
     */
    fiop = findid(id, -1);
    if (fiop == NULL) {
        /* file not open */
        return -1;
    }
    fp = fiop->fp;
    if (fp == NULL) {
        math_error("Bogus internal file pointer!");
        not_reached();
    }

    /*
     * return result
     */
    return get_open_pos(fp, res);
}

int
ftellid(FILEID id, ZVALUE *res)
{
    FILEIO *fiop;
    FILEPOS fpos; /* current file position */

    /* get FILEIO */
    fiop = findid(id, -1);
    if (fiop == NULL) {
        return -2;
    }

    /* get the file position */
    if (f_tell(fiop->fp, &fpos) < 0) {
        return -3;
    }

    /* convert file position to ZVALUE */
    *res = filepos2z(fpos);
    return 0;
}

int
fseekid(FILEID id, ZVALUE offset, int whence)
{
    FILEIO *fiop;    /* FILEIO of file */
    FILEPOS off;     /* offset as a FILEPOS */
    ZVALUE cur, tmp; /* current or end of file location */
    int ret = 0;     /* return code */

    /* setup */
    fiop = findid(id, -1);
    if (fiop == NULL) {
        return -2;
    }

    /* seek depending on whence */
    switch (whence) {
    case 0:
        /* construct seek position, off = offset */
        if (zisneg(offset)) {
            return -3;
        }
        off = z2filepos(offset);

        /* seek there */
        ret = f_seek_set(fiop->fp, &off);
        break;

    case 1:
        /* construct seek position, off = cur+offset */
        f_tell(fiop->fp, &off);
        cur = filepos2z(off);
        zadd(cur, offset, &tmp);
        zfree(cur);
        if (zisneg(tmp)) {
            zfree(tmp);
            return -3;
        }
        off = z2filepos(tmp);
        zfree(tmp);

        /* seek there */
        ret = f_seek_set(fiop->fp, &off);
        break;

    case 2:
        /* construct seek position, off = len+offset */
        if (get_open_siz(fiop->fp, &cur) < 0) {
            return -4;
        }
        zadd(cur, offset, &tmp);
        zfree(cur);
        if (zisneg(tmp)) {
            zfree(tmp);
            return -3;
        }
        off = z2filepos(tmp);
        zfree(tmp);

        /* seek there */
        ret = f_seek_set(fiop->fp, &off);
        break;

    default:
        return -5;
    }
    return ret;
}

/*
 * set_open_pos - set a an open file position
 *
 * given:
 *      fp              open file stream
 *      zpos            file position (ZVALUE) to set
 *
 * returns:
 *      0               res points to the file position
 *      -1              error
 *
 * NOTE: Due to fsetpos limitation, position is set relative to only
 *       the beginning of the file.
 */
S_FUNC int
set_open_pos(FILE *fp, ZVALUE zpos)
{
    FILEPOS pos; /* current file position */

    /*
     * convert ZVALUE to file position
     */
    pos = z2filepos(zpos);

    /*
     * set the file position
     */
    if (f_seek_set(fp, &pos) < 0) {
        /* cannot set file position, return -1 */
        return -1;
    }

    /*
     * return success
     */
    return 0;
}

/*
 * setloc - set the current position of the file
 *
 * given:
 *      id      file id of the file
 *      zpos    file position (ZVALUE) to set
 *
 * returns:
 *      0       able to set file position
 *      -1      unable to set file position
 */
int
setloc(FILEID id, ZVALUE zpos)
{
    FILEIO *fiop; /* file structure */
    FILE *fp;

    /*
     * firewall
     */
    if ((id == FILEID_STDIN) || (id == FILEID_STDOUT) || (id == FILEID_STDERR)) {
        math_error("Cannot fseek stdin, stdout, or stderr");
        not_reached();
    }

    /*
     * convert id to stream
     */
    fiop = findid(id, -1);
    if (fiop == NULL) {
        /* file not open */
        return -1;
    }
    fp = fiop->fp;
    if (fp == NULL) {
        math_error("Bogus internal file pointer!");
        not_reached();
    }

    fiop->action = 0;

    /*
     * return result
     */
    return set_open_pos(fp, zpos);
}

/*
 * off_t2z - convert an off_t into a ZVALUE
 *
 * given:
 *      siz             file size
 *
 * returns:
 *      file size as a ZVALUE
 */
/*ARGSUSED*/
S_FUNC ZVALUE
off_t2z(off_t siz)
{
    ZVALUE ret; /* ZVALUE file size to return */

    /*
     * store off_t in a ZVALUE as a positive value
     */
    ret.len = OFF_T_BITS / BASEB;
    ret.v = alloc(ret.len);
    zclearval(ret);
    SWAP_HALF_IN_OFF_T(ret.v, &siz);
    ret.sign = 0;
    ztrim(&ret);

    /*
     * return our result
     */
    return ret;
}

/*
 * dev2z - convert a stat.st_dev into a ZVALUE
 *
 * given:
 *      dev             device
 *
 * returns:
 *      file size as a ZVALUE
 */
S_FUNC ZVALUE
dev2z(dev_t dev)
{
    ZVALUE ret; /* ZVALUE file size to return */

    /*
     * store off_t in a ZVALUE as a positive value
     */
    ret.len = DEV_BITS / BASEB;
    ret.v = alloc(ret.len);
    zclearval(ret);
    SWAP_HALF_IN_DEV(ret.v, &dev);
    ret.sign = 0;
    ztrim(&ret);

    /*
     * return our result
     */
    return ret;
}

/*
 * inode2z - convert a stat.st_ino into a ZVALUE
 *
 * given:
 *      inode           file size
 *
 * returns:
 *      file size as a ZVALUE
 */
/*ARGSUSED*/
S_FUNC ZVALUE
inode2z(ino_t inode)
{
    ZVALUE ret; /* ZVALUE file size to return */

    /*
     * store off_t in a ZVALUE as a positive value
     */
    ret.len = INODE_BITS / BASEB;
    ret.v = alloc(ret.len);
    zclearval(ret);
    SWAP_HALF_IN_INODE(ret.v, &inode);
    ret.sign = 0;
    ztrim(&ret);

    /*
     * return our result
     */
    return ret;
}

/*
 * get_open_siz - get a an open file size
 *
 * given:
 *      fp              open file stream
 *      res             where to place the file size (ZVALUE)
 *
 * returns:
 *      0               res points to the file size
 *      -1              error
 */
int
get_open_siz(FILE *fp, ZVALUE *res)
{
    struct stat buf; /* file status */

    /*
     * get the file size
     */
    if (fstat(fileno(fp), &buf) < 0) {
        /* stat error */
        return -1;
    }

    /*
     * update file size and return success
     */
    *res = off_t2z(buf.st_size);
    return 0;
}

/*
 * getsize - get the current size of the file
 *
 * given:
 *      id      file id of the file
 *      res     pointer to result
 *
 * returns:
 *      0               able to get file size
 *      EOF             system error
 *      other nonzero   file not open or other problem
 */
int
getsize(FILEID id, ZVALUE *res)
{
    FILEIO *fiop; /* file structure */
    FILE *fp;

    /*
     * convert id to stream
     */
    fiop = findid(id, -1);
    if (fiop == NULL) {
        /* file not open */
        return 1;
    }
    fp = fiop->fp;
    if (fp == NULL) {
        return 2;
    }

    /*
     * return result
     */
    return get_open_siz(fp, res);
}

/*
 * getdevice - get the device of the file
 *
 * given:
 *      id      file id of the file
 *      dev     pointer to the result
 *
 * returns:
 *      0       able to get device
 *      -1      unable to get device
 */
int
get_device(FILEID id, ZVALUE *dev)
{
    FILEIO *fiop; /* file structure */

    /*
     * convert id to stream
     */
    fiop = findid(id, -1);
    if (fiop == NULL) {
        /* file not open */
        return -1;
    }

    /*
     * return result
     */
    *dev = dev2z(fiop->dev);
    return 0;
}

/*
 * getinode - get the inode of the file
 *
 * given:
 *      id      file id of the file
 *      inode   pointer to the result
 *
 * returns:
 *      0       able to get inode
 *      -1      unable to get inode
 */
int
get_inode(FILEID id, ZVALUE *inode)
{
    FILEIO *fiop; /* file structure */

    /*
     * convert id to stream
     */
    fiop = findid(id, -1);
    if (fiop == NULL) {
        /* file not open */
        return -1;
    }

    /*
     * return result
     */
    *inode = inode2z(fiop->inode);
    return 0;
}

S_FUNC off_t
filesize(FILEIO *fiop)
{
    struct stat sbuf;

    /* return length */
    if (fstat(fileno(fiop->fp), &sbuf) < 0) {
        math_error("bad fstat");
        not_reached();
    }
    return sbuf.st_size;
}

ZVALUE
zfilesize(FILEID id)
{
    FILEIO *fiop;
    off_t len;  /* file length */
    ZVALUE ret; /* file size as a ZVALUE return value */

    /* file FILEIO */
    fiop = findid(id, -1);
    if (fiop == NULL) {
        /* return neg value for non-file error */
        itoz(-1, &ret);
        return ret;
    }

    /* get length */
    len = filesize(fiop);
    ret = off_t2z(len);
    return ret;
}

void
showfiles(void)
{
    bool listed[MAXFILES];
    FILEIO *fiop;
    FILE *fp;
    struct stat sbuf;
    ino_t inodes[MAXFILES];
    off_t sizes[MAXFILES];
    int i, j;

    for (i = 0; i < idnum; i++) {
        listed[i] = false;
        fiop = &files[ioindex[i]];
        fp = fiop->fp;
        if (fstat(fileno(fp), &sbuf) < 0) {
            printf("Bad fstat for file %d\n", (int)fiop->id);
            sizes[i] = -1;
        } else {
            inodes[i] = sbuf.st_ino;
            sizes[i] = sbuf.st_size;
        }
    }
    for (i = 0; i < idnum; i++) {
        if (listed[i]) {
            continue;
        }
        fiop = &files[ioindex[i]];
        printf("\t");
        printid(fiop->id, PRINT_UNAMBIG);
        if (sizes[i] == -1) {
            math_chr('\n');
            continue;
        }
        printf(" size = %ld\n", (long int)sizes[i]);
        for (j = i + 1; j < idnum; j++) {
            if (listed[j] || sizes[j] == -1) {
                continue;
            }
            if (inodes[j] == inodes[i]) {
                listed[j] = true;
                fiop = &files[ioindex[j]];
                printf("\t  = ");
                printid(fiop->id, PRINT_UNAMBIG);
                printf("\n");
            }
        }
    }
    printf("\tNumber open = %d\n", idnum);
    printf("\tLastid = %d\n", (int)lastid);
}

/*
 * getscanfield - scan a field separated by some characters
 *
 * given:
 *      fp              FILEID to scan
 *      skip
 *      width           max field width
 *      scannum         Number of characters in scanset
 *      scanptr         string of characters considered separators
 *      strptr          pointer to where the new field pointer may be found
 */
S_FUNC void
getscanfield(FILE *fp, bool skip, unsigned int width, int scannum, char *scanptr, char **strptr)
{
    char *str;            /* current string */
    unsigned long len;    /* current length of string */
    unsigned long totlen; /* total length of string */
    char buf[READSIZE];   /* temporary buffer */
    int c;
    char *b;
    bool comp; /* Use complement of scanset */
    unsigned int chnum;

    totlen = 0;
    str = NULL;

    comp = (scannum < 0);
    if (comp) {
        scannum = -scannum;
    }

    chnum = 0;

    for (;;) {
        len = 0;
        b = buf;
        for (;;) {
            c = fgetc(fp);
            if (c == EOF || c == '\0') {
                break;
            }
            chnum++;
            if (scannum && ((memchr(scanptr, c, scannum) == NULL) ^ comp)) {
                break;
            }
            if (!skip) {
                *b++ = c;
                len++;
                if (len >= READSIZE) {
                    break;
                }
            }
            if (chnum == width) {
                break;
            }
        }
        if (!skip) {
            if (totlen) {
                str = (char *)realloc(str, totlen + len + 1);
            } else {
                str = (char *)malloc(len + 1);
            }
            if (str == NULL) {
                math_error("Out of memory for scanning");
                not_reached();
            }
            if (len) {
                memcpy(&str[totlen], buf, len);
            }
            totlen += len;
        }
        if (len < READSIZE) {
            break;
        }
    }

    if (!(width && chnum == width) && c != '\0') {
        ungetc(c, fp);
    }

    if (!skip) {
        str[totlen] = '\0';
        *strptr = str;
    }
}

/*
 * getscanwhite - scan a field separated by whitespace
 *
 * given:
 *      fp              FILEID to scan
 *      skip
 *      width           max field width
 *      scannum         Number of characters in scanset
 *      strptr          pointer to where the new field pointer may be found
 */
S_FUNC void
getscanwhite(FILE *fp, bool skip, unsigned int width, int scannum, char **strptr)
{
    char *str;            /* current string */
    unsigned long len;    /* current length of string */
    unsigned long totlen; /* total length of string */
    char buf[READSIZE];   /* temporary buffer */
    int c;
    char *b;
    bool comp; /* Use complement of scanset */
    unsigned int chnum;

    totlen = 0;
    str = NULL;

    comp = (scannum < 0);
    if (comp) {
        scannum = -scannum;
    }

    chnum = 0;

    for (;;) {
        len = 0;
        b = buf;
        for (;;) {
            c = fgetc(fp);
            if (c == EOF || c == '\0') {
                break;
            }
            chnum++;
            if (scannum && (!isspace(c) ^ comp)) {
                break;
            }
            if (!skip) {
                *b++ = c;
                len++;
                if (len >= READSIZE) {
                    break;
                }
            }
            if (chnum == width) {
                break;
            }
        }
        if (!skip) {
            if (totlen) {
                str = (char *)realloc(str, totlen + len + 1);
            } else {
                str = (char *)malloc(len + 1);
            }
            if (str == NULL) {
                math_error("Out of memory for scanning");
                not_reached();
            }
            if (len) {
                memcpy(&str[totlen], buf, len);
            }
            totlen += len;
        }
        if (len < READSIZE) {
            break;
        }
    }

    if (!(width && chnum == width) && c != '\0') {
        ungetc(c, fp);
    }

    if (!skip) {
        str[totlen] = '\0';
        *strptr = str;
    }
}

S_FUNC int
fscanfile(FILE *fp, char *fmt, int count, VALUE **vals)
{
    int assnum;    /* Number of assignments made */
    int c;         /* Character read from file */
    char f;        /* Character read from format string */
    int scannum;   /* Number of characters in scanlist */
    char *scanptr; /* Start of scanlist */
    char *str;
    bool comp; /* True scanset is complementary */
    bool skip; /* True if string to be skipped rather than read */
    int width;
    VALUE *var;             /* lvalue to be assigned to */
    unsigned short subtype; /* for var->v_subtype */
    FILEPOS cur;            /* current location */

    if (feof(fp)) {
        return EOF;
    }

    assnum = 0;

    for (;;) {
        for (;;) {
            f = *fmt++;
            if (isspace((int)f)) {
                getscanwhite(fp, 1, 0, 6, NULL);
                do {
                    f = *fmt++;
                } while (isspace((int)f));
            }
            c = fgetc(fp);
            if (c == EOF) {
                return assnum;
            }
            if (f == '%') {
                f = *fmt++;
                if (f != '%' && f != '\0') {
                    break;
                }
            }
            if (f != c || f == '\0') {
                ungetc(c, fp);
                return assnum;
            }
        }
        ungetc(c, fp);
        skip = (f == '*');
        if (!skip && count == 0) {
            return assnum;
        }
        if (skip) {
            f = *fmt++;
        }
        width = 0;
        while (f >= '0' && f <= '9') {
            width = 10 * width + f - '0';
            f = *fmt++;
        }
        switch (f) {
        case 'c':
            if (width == 0) {
                width = 1;
            }
            getscanfield(fp, skip, width, 0, NULL, &str);
            break;
        case 's':
            getscanwhite(fp, 1, 0, 6, NULL);
            if (feof(fp)) {
                return assnum;
            }
            getscanwhite(fp, skip, width, -6, &str);
            break;
        case '[':
            f = *fmt;
            comp = (f == '^');
            if (comp) {
                f = *++fmt;
            }
            scanptr = fmt;
            if (f == '\0') {
                return assnum;
            }
            fmt = strchr((f == ']' ? fmt + 1 : fmt), ']');
            if (fmt == NULL) {
                return assnum;
            }
            scannum = fmt - scanptr;
            if (comp) {
                scannum = -scannum;
            }
            fmt++;
            getscanfield(fp, skip, width, scannum, scanptr, &str);
            break;
        case 'f':
        case 'e':
        case 'r':
        case 'i':
            getscanwhite(fp, 1, 0, 6, NULL);
            if (feof(fp)) {
                return assnum;
            }
            if (skip) {
                fskipnum(fp);
                continue;
            }
            assnum++;
            var = *vals++;
            if (var->v_type != V_ADDR) {
                math_error("This should not happen!!");
            }
            var = var->v_addr;
            subtype = var->v_subtype;
            freevalue(var);
            count--;
            freadsum(fp, var);
            var->v_subtype = subtype;
            continue;
        case 'n':
            assnum++;
            var = *vals++;
            count--;
            if (var->v_type != V_ADDR) {
                math_error("This should not happen!!");
            }
            var = var->v_addr;
            subtype = var->v_subtype;
            freevalue(var);
            var->v_type = V_NUM;
            var->v_num = qalloc();
            f_tell(fp, &cur);
            var->v_num->num = filepos2z(cur);
            var->v_subtype = subtype;
            continue;
        default:
            fprintf(stderr, "Unsupported scan specifier");
            return assnum;
        }
        if (!skip) {
            assnum++;
            var = *vals++;
            count--;
            if (var->v_type != V_ADDR) {
                math_error("Assigning to non-variable");
            }
            var = var->v_addr;
            subtype = var->v_subtype;
            freevalue(var);
            var->v_type = V_STR;
            var->v_str = makestring(str);
        }
    }
}

int
fscanfid(FILEID id, char *fmt, int count, VALUE **vals)
{
    FILEIO *fiop;
    FILE *fp;
    FILEPOS fpos;

    fiop = findid(id, false);
    if (fiop == NULL) {
        return -2;
    }

    fp = fiop->fp;

    if (fiop->action == 'w') {
        f_tell(fp, &fpos);
        fflush(fp);
        if (f_seek_set(fp, &fpos) < 0) {
            return -4;
        }
    }
    fiop->action = 'r';

    return fscanfile(fp, fmt, count, vals);
}

int
scanfstr(char *str, char *fmt, int count, VALUE **vals)
{
    FILE *fp;
    int i;

    fp = tmpfile();
    if (fp == NULL) {
        return EOF;
    }
    fputs(str, fp);
    rewind(fp);
    i = fscanfile(fp, fmt, count, vals);
    fclose(fp);
    return i;
}

/*
 * Read a number in floating-point format from a file.  The first dot,
 * if any, is considered as the decimal point; later dots are ignored.
 * For example, -23.45..67. is interpreted as -23.4567
 * An optional 'e' or 'E' indicates multiplication by a power or 10,
 * e.g. -23.45e-6 has the effect of -23.45 * 10^-6.  The reading
 * ceases when a character other than a digit, a leading sign,
 * a sign immediately following 'e' or 'E', or a dot is encountered.
 * Absence of digits is interpreted as zero.
 */
S_FUNC void
freadnum(FILE *fp, VALUE *valptr)
{
    ZVALUE num, zden, newnum, newden, div, tmp;
    NUMBER *q;
    COMPLEX *c;
    VALUE val;
    char ch;
    LEN i;
    HALF *a;
    FULL f;
    long decimals, exp;
    bool sign, negexp, havedp, imag, exptoobig;

    decimals = 0;
    exp = 0;
    sign = false;
    negexp = false;
    havedp = false;
    imag = false;
    exptoobig = false;

    ch = fgetc(fp);
    if (ch == '+' || ch == '-') {
        if (ch == '-') {
            sign = true;
        }
        ch = fgetc(fp);
    }
    num.v = alloc(1);
    *num.v = 0;
    num.len = 1;
    num.sign = sign;
    for (;;) {
        if (ch >= '0' && ch <= '9') {
            f = (FULL)(ch - '0');
            a = num.v;
            i = num.len;
            while (i-- > 0) {
                f = 10 * (FULL)*a + f;
                *a++ = (HALF)f;
                f >>= BASEB;
            }
            if (f) {
                a = alloc(num.len + 1);
                memcpy(a, num.v, num.len * sizeof(HALF));
                a[num.len] = (HALF)f;
                num.len++;
                freeh(num.v);
                num.v = a;
            }
            if (havedp) {
                decimals++;
            }
        } else if (ch == '.') {
            havedp = true;
        } else {
            break;
        }
        ch = fgetc(fp);
    }
    if (ch == 'e' || ch == 'E') {
        ch = fgetc(fp);
        if (ch == '+' || ch == '-') {
            if (ch == '-') {
                negexp = true;
            }
            ch = fgetc(fp);
        }
        while (ch >= '0' && ch <= '9') {
            if (!exptoobig) {
                exp = (exp * 10) + ch - '0';
                if (exp > 1000000) {
                    exptoobig = true;
                }
            }
            ch = fgetc(fp);
        }
    }
    if (ch == 'i' || ch == 'I') {
        imag = true;
    } else {
        ungetc(ch, fp);
    }

    if (ziszero(num)) {
        zfree(num);
        val.v_type = V_NUM;
        val.v_subtype = V_NOSUBTYPE;
        val.v_num = qlink(&_qzero_);
        *valptr = val;
        return;
    }
    if (exptoobig) {
        zfree(num);
        *valptr = error_value(E_BIGEXP);
        return;
    }
    ztenpow(decimals, &zden);
    if (exp) {
        ztenpow(exp, &tmp);
        if (negexp) {
            zmul(zden, tmp, &newden);
            zfree(zden);
            zden = newden;
        } else {
            zmul(num, tmp, &newnum);
            zfree(num);
            num = newnum;
        }
        zfree(tmp);
    }
    if (!zisunit(num) && !zisunit(zden)) {
        zgcd(num, zden, &div);
        if (!zisunit(div)) {
            zequo(num, div, &newnum);
            zfree(num);
            zequo(zden, div, &newden);
            zfree(zden);
            num = newnum;
            zden = newden;
        }
        zfree(div);
    }
    q = qalloc();
    q->num = num;
    q->den = zden;
    if (imag) {
        c = comalloc();
        qfree(c->imag);
        c->imag = q;
        val.v_type = V_COM;
        val.v_com = c;
    } else {
        val.v_type = V_NUM;
        val.v_num = q;
    }
    val.v_subtype = V_NOSUBTYPE;
    *valptr = val;
}

S_FUNC void
freadsum(FILE *fp, VALUE *valptr)
{
    VALUE v1, v2, v3;
    char ch;

    freadprod(fp, &v1);

    ch = fgetc(fp);
    while (ch == '+' || ch == '-') {
        freadprod(fp, &v2);
        if (ch == '+') {
            addvalue(&v1, &v2, &v3);
        } else {
            subvalue(&v1, &v2, &v3);
        }
        freevalue(&v1);
        freevalue(&v2);
        v1 = v3;
        ch = fgetc(fp);
    }
    ungetc(ch, fp);
    *valptr = v1;
}

S_FUNC void
freadprod(FILE *fp, VALUE *valptr)
{
    VALUE v1, v2, v3;
    char ch;

    freadnum(fp, &v1);
    ch = fgetc(fp);
    while (ch == '*' || ch == '/') {
        freadnum(fp, &v2);
        if (ch == '*') {
            mulvalue(&v1, &v2, &v3);
        } else {
            divvalue(&v1, &v2, &v3);
        }
        freevalue(&v1);
        freevalue(&v2);
        v1 = v3;
        ch = fgetc(fp);
    }
    ungetc(ch, fp);
    *valptr = v1;
}

S_FUNC void
fskipnum(FILE *fp)
{
    char ch;

    do {
        ch = fgetc(fp);
        if (ch == '+' || ch == '-') {
            ch = fgetc(fp);
        }
        while ((ch >= '0' && ch <= '9') || ch == '.') {
            ch = fgetc(fp);
        }
        if (ch == 'e' || ch == 'E') {
            ch = fgetc(fp);
            if (ch == '+' || ch == '-') {
                ch = fgetc(fp);
            }
            while (ch >= '0' && ch <= '9') {
                ch = fgetc(fp);
            }
        }
        if (ch == 'i' || ch == 'I') {
            ch = fgetc(fp);
        }
    } while (ch == '/' || ch == '*' || ch == '+' || ch == '-');

    ungetc(ch, fp);
}

int
isattyid(FILEID id)
{
    FILEIO *fiop;

    fiop = findid(id, -1);
    if (fiop == NULL) {
        return -2;
    }
    return isatty(fileno(fiop->fp));
}

/*
 * fsearch - search for a string in a file
 *
 * given:
 *      id      FILEID to search
 *      str     string to look for
 *      pos     file position to start at (NULL => current position)
 *
 * returns:
 *      EOF if system error
 *      other negative integer if file not open, etc.
 *      positive integer if string not found
 *      zero if string found, position stored at res
 *
 * XXX - This search is a translation of the original search that did not
 *       work with large files.  The search algorithm used is slow and
 *       should be speed up much more.
 */
int
fsearch(FILEID id, char *str, ZVALUE start, ZVALUE end, ZVALUE *res)
{
    FILEIO *fiop;     /* FILEIO of file id */
    FILEPOS cur;      /* current file position */
    ZVALUE tmp, tmp2; /* temporary ZVALUEs */
    char c;           /* str comparison character */
    int r;            /* character read from file */
    char *s;          /* str comparison pointer */
    long k = 0;

    /* get FILEIO */
    fiop = findid(id, false);
    if (fiop == NULL) {
        return -2;
    }

    /*
     * file setup
     */
    if (fiop->action == 'w') {
        fflush(fiop->fp);
    }

    zsub(end, start, &tmp2);

    if (zisneg(tmp2)) {
        zfree(tmp2);
        return 1;
    }

    tmp.sign = 0;
    tmp.len = tmp2.len;
    tmp.v = alloc(tmp.len);
    zcopyval(tmp2, tmp);
    zfree(tmp2);

    cur = z2filepos(start);

    if (f_seek_set(fiop->fp, &cur) < 0) {
        zfree(tmp);
        return EOF;
    }

    /*
     * search setup
     */
    /* note the first str search character */
    c = *str++;

    if (c == '\0') {
        zfree(tmp);
        return 2;
    }
    clearerr(fiop->fp);
    while ((r = fgetc(fiop->fp)) != EOF) {
        if ((char)r == c) {
            (void)f_tell(fiop->fp, &cur);
            s = str;
            while (*s) {
                r = fgetc(fiop->fp);
                if ((char)r != *s) {
                    break;
                }
                s++;
            }
            if (r == EOF) {
                break;
            }
            if (*s == '\0') {
                zfree(tmp);
                tmp = filepos2z(cur);
                zsub(tmp, _one_, res);
                zfree(tmp);
                return 0;
            }
            (void)f_seek_set(fiop->fp, &cur);
        }
        if (*tmp.v) {
            (*tmp.v)--;
        } else {
            if (tmp.len == 1) {
                break;
            }
            k = 0;
            do {
                tmp.v[k++] = BASE1;
            } while (k < tmp.len && tmp.v[k] == 0);
            if (k == tmp.len) {
                math_error("This should not happen");
                not_reached();
            }
            tmp.v[k]--;
            if (tmp.v[tmp.len - 1] == 0) {
                tmp.len--;
            }
        }
    }
    zfree(tmp);
    if (ferror(fiop->fp)) {
        return EOF;
    }
    return 1;
}

/*
 * frsearch - reverse search for a string in a file
 *
 * given:
 *      id      FILEID to search
 *      str     string to look for
 *      search starts at pos = first and continues for decreasing
 *              pos >= last
 *
 * returns:
 *      EOF if system error
 *      other negative integer if file not open, etc.
 *      positive integer if string not found
 *      zero if string found, position stored at res
 *
 * XXX - This search is a translation of the original search that did not
 *       work with large files.  The search algorithm used is so slow
 *       as to be painful to the user and needs to be sped up much more.
 */
int
frsearch(FILEID id, char *str, ZVALUE first, ZVALUE last, ZVALUE *res)
{
    FILEIO *fiop; /* FILEIO of file id */
    FILEPOS cur;  /* current file position */
    ZVALUE pos;   /* current file position as ZVALUE */
    ZVALUE tmp;   /* temporary ZVALUEs */
    char c;       /* str comparison character */
    int r;        /* character read from file */
    char *s;      /* str comparison pointer */

    /* get FILEIO */
    fiop = findid(id, false);
    if (fiop == NULL) {
        return -2;
    }

    /*
     * file setup
     */
    if (fiop->action == 'w') {
        fflush(fiop->fp);
    }

    zcopy(first, &pos);

    /*
     * search setup
     */
    /* note the first str search character */
    c = *str++;

    if (c == '\0') {
        cur = z2filepos(pos);
        if (f_seek_set(fiop->fp, &cur) < 0) {
            zfree(pos);
            return EOF;
        }
        *res = pos;
        return 0;
    }

    clearerr(fiop->fp);

    while (zrel(pos, last) >= 0) {
        cur = z2filepos(pos);
        if (f_seek_set(fiop->fp, &cur) < 0) {
            zfree(pos);
            return EOF;
        }
        r = fgetc(fiop->fp);
        if (r == EOF) {
            zfree(pos);
            return EOF;
        }
        if ((char)r == c) {
            s = str;
            while (*s) {
                r = fgetc(fiop->fp);
                if ((char)r != *s) {
                    break;
                }
                s++;
            }
            if (r == EOF) {
                zfree(pos);
                return EOF;
            }
            if (*s == '\0') {
                *res = pos;
                ungetc(r, fiop->fp);
                return 0;
            }
        }
        zsub(pos, _one_, &tmp);
        zfree(pos);
        pos = tmp;
    }
    cur = z2filepos(last);
    f_seek_set(fiop->fp, &cur);
    zfree(pos);
    if (ferror(fiop->fp)) {
        return EOF;
    }
    return 1;
}

char *
findfname(FILEID id)
{
    FILEIO *fiop;

    fiop = findid(id, -1);

    if (fiop == NULL) {
        return NULL;
    }

    return fiop->name;
}
