file.c

/*
 * 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 {
                if (name == NULL)
                        fp = freopen(fiop->name, mode, fiop->fp);
                else
                        fp = freopen(name, mode, fiop->fp);
                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;
}