c_cpp/etc/calc/file.c

   1 /*
   2  * file - file I/O routines callable by users
   3  *
   4  * Copyright (C) 1999-2007  David I. Bell and Landon Curt Noll
   5  *
   6  * Primary author:  David I. Bell
   7  *
   8  * Calc is open software; you can redistribute it and/or modify it under
   9  * the terms of the version 2.1 of the GNU Lesser General Public License
  10  * as published by the Free Software Foundation.
  11  *
  12  * Calc is distributed in the hope that it will be useful, but WITHOUT
  13  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  14  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
  15  * Public License for more details.
  16  *
  17  * A copy of version 2.1 of the GNU Lesser General Public License is
  18  * distributed with calc under the filename COPYING-LGPL.  You should have
  19  * received a copy with calc; if not, write to Free Software Foundation, Inc.
  20  * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  21  *
  22  * @(#) $Revision: 30.3 $
  23  * @(#) $Id: file.c,v 30.3 2013/08/11 08:41:38 chongo Exp $
  24  * @(#) $Source: /usr/local/src/bin/calc/RCS/file.c,v $
  25  *
  26  * Under source code control:   1991/07/20 00:21:56
  27  * File existed as early as:    1991
  28  *
  29  * chongo <was here> /\oo/\     http://www.isthe.com/chongo/
  30  * Share and enjoy!  :-)        http://www.isthe.com/chongo/tech/comp/calc/
  31  */
  32
  33
  34 #include <stdio.h>
  35 #include <sys/types.h>
  36 #include <sys/stat.h>
  37 #include <stdlib.h>
  38 #include "have_unistd.h"
  39 #if defined(HAVE_UNISTD_H)
  40 # include <unistd.h>
  41 #endif /* HAVE_UNISTD_H */
  42 #include <ctype.h>
  43 #include "calc.h"
  44 #include "longbits.h"
  45 #include "have_fpos.h"
  46 #include "have_fpos_pos.h"
  47 #include "fposval.h"
  48 #include "file.h"
  49 #include "calcerr.h"
  50
  51 #if defined(_WIN32)
  52 # include <io.h>
  53 #endif
  54
  55 #define READSIZE        1024    /* buffer size for reading */
  56
  57 /*
  58  * external STDIO functions
  59  */
  60 E_FUNC void math_setfp(FILE *fp);
  61 E_FUNC FILE *f_open(char *name, char *mode);
  62
  63
  64 /*
  65  * Table of opened files.
  66  * The first three entries always correspond to stdin, stdout, and stderr,
  67  * and cannot be closed.  Their file ids are always 0, 1, and 2.
  68  */
  69 STATIC FILEIO files[MAXFILES] = {
  70         {FILEID_STDIN,  NULL,  (dev_t)0, (ino_t)0,
  71          "(stdin)",  TRUE, FALSE, FALSE, FALSE, 'r', "r"},
  72         {FILEID_STDOUT, NULL, (dev_t)0, (ino_t)0,
  73          "(stdout)", FALSE,  TRUE, FALSE, FALSE, 'w', "w"},
  74         {FILEID_STDERR, NULL, (dev_t)0, (ino_t)0,
  75          "(stderr)", FALSE,  TRUE, FALSE, FALSE, 'w', "w"}
  76 };
  77
  78
  79 STATIC int ioindex[MAXFILES] = {0,1,2}; /* Indices for FILEIO table */
  80 STATIC FILEID lastid = FILEID_STDERR;   /* Last allocated file id */
  81 STATIC int idnum = 3;                   /* Number of allocated file ids */
  82
  83
  84 /* forward static declarations */
  85 S_FUNC ZVALUE filepos2z(FILEPOS pos);
  86 S_FUNC FILEPOS z2filepos(ZVALUE pos);
  87 S_FUNC int set_open_pos(FILE *fp, ZVALUE zpos);
  88 S_FUNC int get_open_pos(FILE *fp, ZVALUE *res);
  89 S_FUNC ZVALUE off_t2z(off_t siz);
  90 S_FUNC ZVALUE dev2z(dev_t dev);
  91 S_FUNC ZVALUE inode2z(ino_t inode);
  92 S_FUNC void getscanfield(FILE *fp, BOOL skip, unsigned int width,
  93                          int scannum, char *scanptr, char **strptr);
  94 S_FUNC void getscanwhite(FILE *fp, BOOL skip, unsigned int width,
  95                          int scannum, char **strptr);
  96 S_FUNC int fscanfile(FILE *fp, char *fmt, int count, VALUE **vals);
  97 S_FUNC void freadnum(FILE *fp, VALUE *valptr);
  98 S_FUNC void freadsum(FILE *fp, VALUE *valptr);
  99 S_FUNC void freadprod(FILE *fp, VALUE *valptr);
 100 S_FUNC void fskipnum(FILE *fp);
 101
 102
 103 /*
 104  * file_init - perform needed initilization work
 105  *
 106  * On some systems, one cannot initialize a pointer to a FILE *.
 107  * This routine, called once at startup is a work-a-round for
 108  * systems with such bogons.
 109  *
 110  * We will also probe for any open files beyond stderr and set them up.
 111  */
 112 void
 113 file_init(void)
 114 {
 115     STATIC int done = 0;        /* 1 => routine already called */
 116     struct stat sbuf;           /* file status */
 117     FILEIO *fiop;
 118     FILE *fp;
 119     int i;
 120
 121     if (!done) {
 122         /*
 123          * setup the default set
 124          */
 125         files[0].fp = stdin;
 126         files[1].fp = stdout;
 127         files[2].fp = stderr;
 128         for (i = 0; i < 3; ++i) {
 129                 if (fstat(i, &sbuf) >= 0) {
 130                         files[i].dev = sbuf.st_dev;
 131                         files[i].inode = sbuf.st_ino;
 132                 }
 133         }
 134
 135         /*
 136          * note any other files that we can find
 137          */
 138         fiop = &files[3];
 139         for (i = 3; i < MAXFILES; fiop++, ++i) {
 140                 char *tname;
 141
 142                 fiop->name = NULL;
 143                 files[idnum].reading = TRUE;
 144                 files[idnum].writing = TRUE;
 145                 files[idnum].action = 0;
 146                 /*
 147                  * stat the descriptor to see what we have
 148                  */
 149                 if (fstat(i, &sbuf) >= 0) {
 150                         fp = (FILE *) fdopen(i,"r+");   /*guess mode*/
 151                         if (fp) {
 152                                 strcpy(files[idnum].mode, "r+");
 153                         } else {
 154                                 fp = (FILE *) fdopen(i, "r");
 155                                 if (fp) {
 156                                         strcpy(files[idnum].mode, "r");
 157                                         files[idnum].writing = FALSE;
 158                                 } else {
 159                                         fp = (FILE *) fdopen(i, "w");
 160                                         if (fp) {
 161                                                 strcpy(files[idnum].mode, "w");
 162                                                 files[idnum].reading = FALSE;
 163                                         }
 164                                         else
 165                                                 continue;
 166                                 }
 167                         }
 168                         tname = (char *)malloc(sizeof("descriptor[19]"));
 169                         if (tname == NULL) {
 170                                 math_error("Out of memory for init_file");
 171                                 /*NOTREACHED*/
 172                         }
 173                         sprintf(tname, "descriptor[%d]", i);
 174                         files[idnum].name = tname;
 175                         files[idnum].id = idnum;
 176                         files[idnum].fp = fp;
 177                         files[idnum].dev = sbuf.st_dev;
 178                         files[idnum].inode = sbuf.st_ino;
 179                         ioindex[idnum] = idnum;
 180                         idnum++;
 181                         lastid++;
 182                 }
 183         }
 184
 185         done = 1;
 186     }
 187 }
 188
 189
 190 /*
 191  * init_fileio - initialize a FILEIO structure
 192  *
 193  * This function initializes a calc FILEIO structure.  It will optionally
 194  * malloc the filename string if given an non-NULL associated filename.
 195  * It will canonicalize the file open mode string.
 196  *
 197  * given:
 198  *      fiop    pointer to FILEIO structure to initialize
 199  *      name    associated filename (NULL => caller will setup filename)
 200  *      mode    open mode (one of {r,w,a}{,b}{,+})
 201  *      sbufp   pointer to stat of open file
 202  *      id      calc file ID
 203  *      fp      open file stream
 204  */
 205 S_FUNC void
 206 init_fileio(FILEIO *fiop, char *name, char *mode,
 207             struct stat *sbufp, FILEID id, FILE *fp)
 208 {
 209         char modestr[sizeof(fiop->mode)];       /* mode [rwa]b?\+? */
 210         size_t namelen;                         /* length of name */
 211
 212         /* allocate filename if requested */
 213         if (name != NULL) {
 214                 namelen = strlen(name);
 215                 fiop->name = (char *)malloc(namelen + 1);
 216                 if (fiop->name == NULL) {
 217                         math_error("No memory for filename");
 218                         /*NOTREACHED*/
 219                 }
 220         }
 221
 222         /* initialize FILEIO structure */
 223         if (name != NULL) {
 224                 strncpy(fiop->name, name, namelen+1);
 225         }
 226         fiop->id = id;
 227         fiop->fp = fp;
 228         fiop->dev = sbufp->st_dev;
 229         fiop->inode = sbufp->st_ino;
 230         fiop->reading = FALSE;
 231         fiop->writing = FALSE;
 232         fiop->appending = FALSE;
 233         fiop->binary = FALSE;
 234         fiop->action = 0;
 235         fiop->mode[0] = '\0';
 236
 237         /*
 238          * determine file open mode
 239          *
 240          * While a leading 'r' is for reading and a leading 'w' is
 241          * for writing, the presense of a '+' in the string means
 242          * both reading and writing.  A leading 'a' means append
 243          * which is writing.
 244          */
 245         /* canonicalize read modes */
 246         if (mode[0] == 'r') {
 247
 248                 /* note read mode */
 249                 strcpy(modestr, "r");
 250                 fiop->reading = TRUE;
 251
 252                 /* note binary mode even though mode is not used / ignored */
 253                 if (strchr(mode, 'b') != NULL) {
 254                     strcat(modestr, "b");
 255                 }
 256
 257                 /* note if reading and writing */
 258                 if (strchr(mode, '+') != NULL) {
 259                         fiop->writing = TRUE;
 260                         strcat(modestr, "+");
 261                 }
 262
 263         /* canonicalize write modes */
 264         } else if (mode[0] == 'w') {
 265
 266                 /* note write mode */
 267                 strcpy(modestr, "w");
 268                 fiop->writing = TRUE;
 269
 270                 /* note binary mode even though mode is not used / ignored */
 271                 if (strchr(mode, 'b') != NULL) {
 272                     strcat(modestr, "b");
 273                 }
 274
 275                 /* note if reading and writing */
 276                 if (strchr(mode, '+') != NULL) {
 277                         fiop->reading = TRUE;
 278                         strcat(modestr, "+");
 279                 }
 280
 281         /* canonicalize append modes */
 282         } else if (mode[0] == 'a') {
 283
 284                 /* note append mode */
 285                 strcpy(modestr, "a");
 286                 fiop->writing = TRUE;
 287                 fiop->appending = TRUE;
 288
 289                 /* note binary mode even though mode is not used / ignored */
 290                 if (strchr(mode, 'b') != NULL) {
 291                     strcat(modestr, "b");
 292                 }
 293
 294                 /* note if reading and writing */
 295                 if (strchr(mode, '+') != NULL) {
 296                         fiop->reading = TRUE;
 297                         strcat(modestr, "+");
 298                 }
 299
 300         /* canonicalize no I/O modes */
 301         } else {
 302                 modestr[0] = '\0';
 303         }
 304         modestr[sizeof(modestr)-1] = '\0';      /* firewall */
 305
 306         /* record canonical open mode string */
 307         strncpy(fiop->mode, modestr, sizeof(fiop->mode));
 308 }
 309
 310
 311 /*
 312  * openid - open the specified file name for reading or writing
 313  *
 314  * given:
 315  *      name            file name
 316  *      mode            open mode (one of {r,w,a}{,b}{,+})
 317  *
 318  * returns:
 319  *      >=3 FILEID which can be used to do I/O to the file
 320  *      <0 if the open failed
 321  *
 322  * NOTE: This function will not return 0, 1 or 2 since they are
 323  *       reserved for stdin, stdout, stderr.  In fact, it must not
 324  *       return 0, 1, or 2 because it will confuse those who call
 325  *       the opensearchfiile() function
 326  */
 327 FILEID
 328 openid(char *name, char *mode)
 329 {
 330         FILEIO *fiop;           /* file structure */
 331         FILEID id;              /* new file id */
 332         FILE *fp;
 333         struct stat sbuf;       /* file status */
 334         int i;
 335
 336         /* find the next open slot in the files array */
 337         if (idnum >= MAXFILES)
 338                 return -E_MANYOPEN;
 339         fiop = &files[3];
 340         for (i = 3; i < MAXFILES; fiop++,i++) {
 341                 if (fiop->name == NULL)
 342                         break;
 343         }
 344         if (i == MAXFILES)
 345                 math_error("This should not happen in openid()!!!");
 346
 347         /* open the file */
 348         fp = f_open(name, mode);
 349         if (fp == NULL) {
 350                 return FILEID_NONE;
 351         }
 352         if (fstat(fileno(fp), &sbuf) < 0) {
 353                 math_error("bad fstat");
 354                 /*NOTREACHED*/
 355         }
 356
 357         /* get a new FILEID */
 358         id = ++lastid;
 359         ioindex[idnum++] = i;
 360
 361         /* initialize FILEIO structure */
 362         init_fileio(fiop, name, mode, &sbuf, id, fp);
 363
 364         /* return calc open file ID */
 365         return id;
 366 }
 367
 368
 369 /*
 370  * openpathid - open the specified abse filename, or
 371  *              relative filename along a search path
 372  *
 373  * given:
 374  *      name            file name
 375  *      mode            open mode (one of {r,w,a}{,b}{,+})
 376  *      pathlist        list of colon separated paths (or NULL)
 377  *
 378  * returns:
 379  *      >=3 FILEID which can be used to do I/O to the file
 380  *      <0 if the open failed
 381  *
 382  * NOTE: This function will not return 0, 1 or 2 since they are
 383  *       reserved for stdin, stdout, stderr.  In fact, it must not
 384  *       return 0, 1, or 2 because it will confuse those who call
 385  *       the opensearchfiile() function
 386  */
 387 FILEID
 388 openpathid(char *name, char *mode, char *pathlist)
 389 {
 390         FILEIO *fiop;           /* file structure */
 391         FILEID id;              /* new file id */
 392         FILE *fp;
 393         struct stat sbuf;       /* file status */
 394         char *openpath;         /* malloc copy of path that was opened */
 395         int i;
 396
 397         /* find the next open slot in the files array */
 398         if (idnum >= MAXFILES)
 399                 return -E_MANYOPEN;
 400         fiop = &files[3];
 401         for (i = 3; i < MAXFILES; fiop++,i++) {
 402                 if (fiop->name == NULL)
 403                         break;
 404         }
 405         if (i == MAXFILES)
 406                 math_error("This should not happen in openpathid()!!!");
 407
 408         /* open a file - searching along a path */
 409         openpath = NULL;
 410         fp = f_pathopen(name, mode, pathlist, &openpath);
 411         if (fp == NULL) {
 412                 if (openpath != NULL) {
 413                         /* should not happen, but just in case */
 414                         free(openpath);
 415                 }
 416                 return FILEID_NONE;
 417         }
 418         if (fstat(fileno(fp), &sbuf) < 0) {
 419                 if (openpath != NULL) {
 420                         free(openpath);
 421                 }
 422                 math_error("bad fstat");
 423                 /*NOTREACHED*/
 424         }
 425         if (openpath == NULL) {
 426                 fclose(fp);
 427                 math_error("bad openpath");
 428                 /*NOTREACHED*/
 429         }
 430
 431         /* get a new FILEID */
 432         id = ++lastid;
 433         ioindex[idnum++] = i;
 434
 435         /* initialize FILEIO structure */
 436         init_fileio(fiop, NULL, mode, &sbuf, id, fp);
 437         fiop->name = openpath;  /* already malloced by f_pathopen */
 438
 439         /* return calc open file ID */
 440         return id;
 441 }
 442
 443
 444 /*
 445  * reopenid - reopen a FILEID
 446  *
 447  * given:
 448  *      id      FILEID to reopen
 449  *      mode    new mode to open as
 450  *      mode    new mode to open as (one of "r", "w", "a", "r+", "w+", "a+")
 451  *      name    name of new file
 452  *
 453  * returns:
 454  *      FILEID which can be used to do I/O to the file
 455  *      <0 if the open failed
 456  */
 457 FILEID
 458 reopenid(FILEID id, char *mode, char *name)
 459 {
 460         FILEIO *fiop;           /* file structure */
 461         FILE *fp;
 462         struct stat sbuf;
 463         int i;
 464
 465         /* firewall */
 466         if ((id == FILEID_STDIN) || (id == FILEID_STDOUT) ||
 467             (id == FILEID_STDERR)) {
 468                 math_error("Cannot freopen stdin, stdout, or stderr");
 469                 /*NOTREACHED*/
 470         }
 471
 472         /* reopen the file */
 473         fiop = NULL;
 474         for (i = 3; i < idnum; i++) {
 475                 fiop = &files[ioindex[i]];
 476                 if (fiop->id == id)
 477                         break;
 478         }
 479         if (i == idnum) {
 480                 if (name == NULL) {
 481                         fprintf(stderr, "File not open, need file name\n");
 482                         return FILEID_NONE;
 483                 }
 484                 if (idnum >= MAXFILES) {
 485                         fprintf(stderr, "Too many open files\n");
 486                         return FILEID_NONE;
 487                 }
 488                 for (fiop = &files[3], i = 3; i < MAXFILES; fiop++, i++) {
 489                         if (fiop->name == NULL)
 490                                 break;
 491                 }
 492                 if (i >= MAXFILES) {
 493                         math_error("This should not happen in reopenid");
 494                         /*NOTREACHED*/
 495                 }
 496                 fp = f_open(name, mode);
 497                 if (fp == NULL) {
 498                         fprintf(stderr, "Cannot open file\n");
 499                         return FILEID_NONE;
 500                 }
 501                 ioindex[idnum++] = i;
 502                 fiop->id = id;
 503         } else {
 504                 if (name == NULL)
 505                         fp = freopen(fiop->name, mode, fiop->fp);
 506                 else
 507                         fp = freopen(name, mode, fiop->fp);
 508                 if (fp == NULL) {
 509                         free(fiop->name);
 510                         fiop->name = NULL;
 511                         idnum--;
 512                         for (; i < idnum; i++)
 513                                 ioindex[i] = ioindex[i + 1];
 514                         return FILEID_NONE;
 515                 }
 516         }
 517         if (fstat(fileno(fp), &sbuf) < 0) {
 518                 math_error("bad fstat");
 519                 /*NOTREACHED*/
 520         }
 521
 522         /* initialize FILEIO structure */
 523         if (name == NULL) {
 524                 if (fiop->name == NULL) {
 525                         math_error("old and new reopen filenames are NULL");
 526                 }
 527         } else if (fiop->name != NULL) {
 528                 free(fiop->name);
 529                 fiop->name = NULL;
 530         }
 531         init_fileio(fiop, name, mode, &sbuf, id, fp);
 532
 533         /* return calc open file ID */
 534         return id;
 535 }
 536
 537
 538 /*
 539  * Find the file I/O structure for the specified file id, and verifies that
 540  * it is opened in the required manner (0 for reading or 1 for writing).
 541  * If writable is -1, then no open checks are made at all and NULL is then
 542  * returned if the id represents a closed file.
 543  */
 544 FILEIO *
 545 findid(FILEID id, int writable)
 546 {
 547         FILEIO *fiop;           /* file structure */
 548         int i;
 549
 550         fiop = NULL;
 551
 552         if ((id < 0) || (id > lastid))
 553                 return NULL;
 554
 555         for (i = 0; i < idnum; i++) {
 556                 fiop = &files[ioindex[i]];
 557                 if (fiop->id == id)
 558                         break;
 559         }
 560
 561         if (i == idnum)
 562                 return NULL;
 563
 564         if (writable >= 0) {
 565                 if ((writable && !fiop->writing) ||
 566                     (!writable && !fiop->reading)) {
 567                         return NULL;
 568                 }
 569         }
 570         return fiop;
 571 }
 572
 573
 574 /*
 575  * Return whether or not a file id is valid.  This is used for if tests.
 576  */
 577 BOOL
 578 validid(FILEID id)
 579 {
 580         return (findid(id, -1) != NULL);
 581 }
 582
 583
 584 /*
 585  * Return the file with id = index if this is the id of a file that has been
 586  * opened (it may have since been closed).  Otherwise returns FILEID_NONE.
 587  */
 588 FILEID
 589 indexid(long index)
 590 {
 591         FILEID id;
 592
 593         id = (FILEID) index;
 594
 595         if ((index < 0) || (id > lastid))
 596                 return FILEID_NONE;
 597         return id;
 598 }
 599
 600
 601 /*
 602  * Close the specified file id.  Returns TRUE if there was an error.
 603  * Closing of stdin, stdout, or stderr is illegal, but closing of already
 604  * closed files is allowed.
 605  */
 606 int
 607 closeid(FILEID id)
 608 {
 609         FILEIO *fiop;           /* file structure */
 610         int i;
 611         int err;
 612
 613         fiop = NULL;
 614
 615         /* firewall */
 616         if ((id == FILEID_STDIN) || (id == FILEID_STDOUT) ||
 617             (id == FILEID_STDERR)) {
 618                 math_error("Cannot close stdin, stdout, or stderr");
 619                 /*NOTREACHED*/
 620         }
 621
 622         /* get file structure */
 623         for (i = 3; i < idnum; i++) {
 624                 fiop = &files[ioindex[i]];
 625                 if (fiop->id == id)
 626                         break;
 627         }
 628         if (i == idnum)
 629                 return 1;               /* File not open */
 630         idnum--;
 631         for (; i < idnum; i++)
 632                 ioindex[i] = ioindex[i + 1];
 633
 634         free(fiop->name);
 635         fiop->name = NULL;
 636
 637         /* close file and note error state */
 638         err = ferror(fiop->fp);
 639         err |= fclose(fiop->fp);
 640         fiop->fp = NULL;
 641
 642         /* return success or failure */
 643         return (err ? EOF : 0);
 644 }
 645
 646
 647 int
 648 closeall(void)
 649 {
 650         FILEIO *fiop;
 651         int i;
 652         int err;
 653
 654         err = 0;
 655         for (i = 3; i < idnum; i++) {
 656                 fiop = &files[ioindex[i]];
 657                 if (fiop->fp) {
 658                         free(fiop->name);
 659                         fiop->name = NULL;
 660                         err |= fclose(fiop->fp);
 661                 }
 662         }
 663         idnum = 3;
 664         return err;
 665 }
 666
 667
 668 /*
 669  * Return whether or not an error occurred to a file.
 670  */
 671 BOOL
 672 errorid(FILEID id)
 673 {
 674         FILEIO *fiop;           /* file structure */
 675
 676         fiop = findid(id, -1);
 677         if (fiop == NULL)
 678                 return EOF;
 679         return (ferror(fiop->fp) != 0);
 680 }
 681
 682
 683 /*
 684  * Return whether or not end of file occurred to a file.
 685  */
 686 BOOL
 687 eofid(FILEID id)
 688 {
 689         FILEIO *fiop;           /* file structure */
 690
 691         fiop = findid(id, -1);
 692         if (fiop == NULL)
 693                 return EOF;
 694         return (feof(fiop->fp) != 0);
 695 }
 696
 697
 698 /*
 699  * Flush output to an opened file.
 700  */
 701 int
 702 flushid(FILEID id)
 703 {
 704         FILEIO *fiop;           /* file structure */
 705
 706         fiop = findid(id, -1);
 707         if (fiop == NULL)
 708                 return 0;
 709         if (!fiop->writing || fiop->action == 'r')
 710                 return 0;
 711         return fflush(fiop->fp);
 712 }
 713
 714
 715 #if !defined(_WIN32)
 716 int
 717 flushall(void)
 718 {
 719         FILEIO *fiop;
 720         int i;
 721         int err;
 722
 723         err = 0;
 724         for (i = 3; i < idnum; i++) {
 725                 fiop = &files[ioindex[i]];
 726                 if (fiop->writing && fiop->action != 'r')
 727                         err |= fflush(fiop->fp);
 728         }
 729         return err;
 730 }
 731 #endif /* Windoz free systems */
 732
 733
 734 /*
 735  * Read the next line, string or word from an opened file.
 736  * Returns a pointer to an allocated string holding a null-terminated
 737  * or newline terminated string.  Where reading stops is controlled by
 738  * flags:
 739  *
 740  *      bit 0:  at newline
 741  *      bit 1:  at null character
 742  *      bit 2:  at white space (also skips leading white space)
 743  *
 744  * If neither '\n' nor '\0' is encountered reading continues until EOF.
 745  * If bit 3 is set the stop character is removed.
 746  *
 747  * given:
 748  *      id              file to read from
 749  *      flags           read flags (see above)
 750  *      retstr          returned pointer to string
 751  */
 752 int
 753 readid(FILEID id, int flags, STRING **retstr)
 754 {
 755         FILEIO *fiop;           /* file structure */
 756         FILE *fp;
 757         char *str;              /* current string */
 758         unsigned long n;        /* current number characters read into buf */
 759         unsigned long totlen;   /* total length of string copied from buf */
 760         char buf[READSIZE];     /* temporary buffer */
 761         char *b;
 762         int c;
 763         BOOL nlstop, nullstop, wsstop, rmstop, done;
 764         FILEPOS fpos;
 765         STRING *newstr;
 766
 767         totlen = 0;
 768         str = NULL;
 769
 770         fiop = findid(id, FALSE);
 771         if (fiop == NULL)
 772                 return 1;
 773         nlstop = (flags & 1);
 774         nullstop = (flags & 2);
 775         wsstop = (flags & 4);
 776         rmstop = (flags & 8);
 777
 778         fp = fiop->fp;
 779
 780         if (fiop->action == 'w') {
 781                 f_tell(fp, &fpos);
 782                 fflush(fp);
 783                 if (f_seek_set(fp, &fpos) < 0)
 784                         return 3;
 785         }
 786         fiop->action = 'r';
 787
 788         if (wsstop) {
 789                 while (isspace(c = fgetc(fp)));
 790                 ungetc(c, fp);
 791         }
 792
 793         for (;;) {
 794                 b = buf;
 795                 n = 0;
 796                 do {
 797                         c = fgetc(fp);
 798                         if (c == EOF)
 799                                 break;
 800                         n++;
 801                         if (nlstop && c == '\n')
 802                                 break;
 803                         if (nullstop && c == '\0')
 804                                 break;
 805                         if (wsstop && isspace(c))
 806                                 break;
 807                         *b++ = c;
 808                 } while (n < READSIZE);
 809                 done = ((nlstop && c == '\n') || (nullstop && c == '\0') ||
 810                         (wsstop && isspace(c)) || c == EOF);
 811                 if (done && rmstop && c != EOF)
 812                         n--;
 813                 if (totlen)
 814                         str = (char *)realloc(str, totlen + n + 1);
 815                 else
 816                         str = (char *)malloc(n + 1);
 817                 if (str == NULL) {
 818                         math_error("Out of memory for readid");
 819                         /*NOTREACHED*/
 820                 }
 821                 if (n > 0)
 822                         memcpy(&str[totlen], buf, n);
 823                 totlen += n;
 824                 if (done)
 825                         break;
 826         }
 827         if (totlen == 0 && c == EOF) {
 828                 free(str);
 829                 return EOF;
 830         }
 831         if ((nlstop && c == '\n') && !rmstop)
 832                 str[totlen - 1] = '\n';
 833         if ((nullstop && c == '\0') && !rmstop)
 834                 str[totlen - 1] = '\0';
 835         str[totlen] = '\0';
 836         newstr = stralloc();
 837         newstr->s_len = totlen;
 838         newstr->s_str = str;
 839         *retstr = newstr;
 840         return 0;
 841 }
 842
 843
 844 /*
 845  * Return the next character from an opened file.
 846  * Returns EOF if there was an error or end of file.
 847  */
 848 int
 849 getcharid(FILEID id)
 850 {
 851         FILEIO *fiop;
 852         FILEPOS fpos;
 853
 854         fiop = findid(id, FALSE);
 855         if (fiop == NULL)
 856                 return -2;
 857         if (fiop->action == 'w') {
 858                 f_tell(fiop->fp, &fpos);
 859                 fflush(fiop->fp);
 860                 if (f_seek_set(fiop->fp, &fpos) < 0)
 861                         return -3;
 862         }
 863         fiop->action = 'r';
 864
 865         return fgetc(fiop->fp);
 866 }
 867
 868
 869 /*
 870  * Print out the name of an opened file.
 871  * If the file has been closed, a null name is printed.
 872  * If flags contain PRINT_UNAMBIG then extra information is printed
 873  * identifying the output as a file and some data about it.
 874  */
 875 int
 876 printid(FILEID id, int flags)
 877 {
 878         FILEIO *fiop;           /* file structure */
 879         FILE *fp;
 880         ZVALUE pos;             /* file position */
 881
 882         /*
 883          * filewall - file is closed
 884          */
 885         fiop = findid(id, -1);
 886         if (fiop == NULL) {
 887                 if (flags & PRINT_UNAMBIG)
 888                         math_fmt("FILE %ld closed", id);
 889                 else
 890                         math_str("\"\"");
 891                 return 1;
 892         }
 893
 894         /*
 895          * print quoted filename and mode
 896          */
 897         if ((flags & PRINT_UNAMBIG) == 0) {
 898                 math_chr('"');
 899                 math_str(fiop->name);
 900                 math_chr('"');
 901                 return 0;
 902         }
 903         math_fmt("FILE %ld \"%s\" (%s", id, fiop->name,  fiop->mode);
 904
 905         /*
 906          * print file position
 907          */
 908
 909         fp = fiop->fp;
 910
 911         if (get_open_pos(fp, &pos) < 0) {
 912             if (fileno(fp) > 2)
 913                  math_str("Error while determining file position!");
 914             math_chr(')');
 915             return 0;
 916         }
 917
 918         math_str(", pos ");
 919         zprintval(pos, 0, 0);
 920         zfree(pos);
 921
 922         /*
 923          * report special status
 924          */
 925         if (ferror(fp))
 926                 math_str(", error");
 927         if (feof(fp))
 928                 math_str(", eof");
 929         math_chr(')');
 930
 931         printf(" fileno: %d ", fileno(fp));
 932         return 0;
 933 }
 934
 935
 936 /*
 937  * Print a formatted string similar to printf.  Various formats of output
 938  * are possible, depending on the format string AND the actual types of the
 939  * values.  Mismatches do not cause errors, instead something reasonable is
 940  * printed instead.  The output goes to the file with the specified id.
 941  *
 942  * given:
 943  *      id              file id to print to
 944  *      count           print count
 945  *      fmt             standard format string
 946  *      vals            table of values to print
 947  */
 948 int
 949 idprintf(FILEID id, char *fmt, int count, VALUE **vals)
 950 {
 951         FILEIO *fiop;
 952         VALUE *vp;
 953         char *str;
 954         int ch;
 955         size_t len;
 956         int oldmode, newmode;
 957         long olddigits, newdigits;
 958         long width, precision;
 959         BOOL didneg, didprecision;
 960         FILEPOS fpos;
 961         BOOL printstring;
 962         BOOL printchar;
 963
 964         fiop = findid(id, TRUE);
 965         if (fiop == NULL)
 966                 return 1;
 967         if (fiop->action == 'r') {
 968                 f_tell(fiop->fp, &fpos);
 969                 if (f_seek_set(fiop->fp, &fpos) < 0)
 970                         return 3;
 971         }
 972
 973         fiop->action = 'w';
 974
 975         printstring = FALSE;
 976         printchar = FALSE;
 977
 978         math_setfp(fiop->fp);
 979
 980         while ((ch = *fmt++) != '\0') {
 981                 if (ch != '%') {
 982                         math_chr(ch);
 983                         continue;
 984                 }
 985
 986                 /*
 987                  * Here to handle formats.
 988                  */
 989                 didneg = FALSE;
 990                 didprecision = FALSE;
 991                 width = 0;
 992                 precision = 0;
 993
 994                 ch = *fmt++;
 995                 if (ch == '-') {
 996                         didneg = TRUE;
 997                         ch = *fmt++;
 998                 }
 999                 while ((ch >= '0') && (ch <= '9')) {
1000                         width = width * 10 + (ch - '0');
1001                         ch = *fmt++;
1002                 }
1003                 if (ch == '.') {
1004                         didprecision = TRUE;
1005                         ch = *fmt++;
1006                         while ((ch >= '0') && (ch <= '9')) {
1007                                 precision = precision * 10 + (ch - '0');
1008                                 ch = *fmt++;
1009                         }
1010                 }
1011                 if (ch == 'l')
1012                         ch = *fmt++;
1013
1014                 oldmode = conf->outmode;
1015                 newmode = oldmode;
1016                 olddigits = conf->outdigits;
1017                 newdigits = olddigits;
1018                 if (didprecision)
1019                         newdigits = precision;
1020
1021                 switch (ch) {
1022                 case 's':
1023                         printstring = TRUE;
1024                 case 'c':
1025                         printchar = TRUE;
1026                 case 'd':
1027                         break;
1028                 case 'f':
1029                         newmode = MODE_REAL;
1030                         break;
1031                 case 'e':
1032                         newmode = MODE_EXP;
1033                         break;
1034                 case 'r':
1035                         newmode = MODE_FRAC;
1036                         break;
1037                 case 'o':
1038                         newmode = MODE_OCTAL;
1039                         break;
1040                 case 'x':
1041                         newmode = MODE_HEX;
1042                         break;
1043                 case 'b':
1044                         newmode = MODE_BINARY;
1045                         break;
1046                 case 0:
1047                         math_setfp(stdout);
1048                         return 0;
1049                 default:
1050                         math_chr(ch);
1051                         continue;
1052                 }
1053
1054                 if (--count < 0) {
1055                         while (width-- > 0)
1056                                 math_chr(' ');
1057                         continue;
1058                 }
1059                 vp = *vals++;
1060
1061                 math_setdigits(newdigits);
1062                 math_setmode(newmode);
1063
1064                 /*
1065                  * If there is no width specification, or if the type of
1066                  * value requires multiple lines, then just output the
1067                  * value directly.
1068                  */
1069                 if ((width == 0) ||
1070                         (vp->v_type == V_MAT) || (vp->v_type == V_LIST)) {
1071                         switch(vp->v_type) {
1072                         case V_OCTET:
1073                                 if (printstring)
1074                                         math_str((char *)vp->v_octet);
1075                                 else if (printchar)
1076                                         math_chr(*vp->v_octet);
1077                                 else
1078                                         printvalue(vp, PRINT_NORMAL);
1079                                 break;
1080                         case V_BLOCK:
1081                                 if (printstring)
1082                                         math_str((char *)
1083                                                  vp->v_block->data);
1084                                 else if (printchar)
1085                                         math_chr(*vp->v_block->data);
1086                                 else
1087                                         printvalue(vp, PRINT_NORMAL);
1088                                 break;
1089                         case V_NBLOCK:
1090                                 if (printstring) {
1091                                         if (vp->v_nblock->blk->data !=
1092                                             NULL)
1093                                                 math_str((char *)
1094                                                          vp->v_nblock
1095                                                          ->blk->data);
1096                                 } else if (printchar) {
1097                                         if (vp->v_nblock->blk->data !=
1098                                             NULL)
1099                                                 math_chr(*vp->v_nblock->
1100                                                          blk->data);
1101                                 } else {
1102                                         printvalue(vp, PRINT_NORMAL);
1103                                 }
1104                                 break;
1105                         default:
1106                                 printvalue(vp, PRINT_NORMAL);
1107                         }
1108
1109                         math_setmode(oldmode);
1110                         math_setdigits(olddigits);
1111                         continue;
1112                 }
1113
1114
1115                 /*
1116                  * There is a field width.  Collect the output in a string,
1117                  * print it padded appropriately with spaces, and free it.
1118                  * However, if the output contains a newline, then ignore
1119                  * the field width.
1120                  */
1121                 math_divertio();
1122                 switch(vp->v_type) {
1123                 case V_OCTET:
1124                         if (printstring)
1125                                 math_str((char *)vp->v_octet);
1126                         else if (printchar)
1127                                 math_chr(*vp->v_octet);
1128                         else
1129                                 printvalue(vp, PRINT_NORMAL);
1130                         break;
1131                 case V_BLOCK:
1132                         if (printstring)
1133                                 math_str((char *)vp->v_block->data);
1134                         else if (printchar)
1135                                 math_chr(*vp->v_block->data);
1136                         else
1137                                 printvalue(vp, PRINT_NORMAL);
1138                         break;
1139                 case V_NBLOCK:
1140                         if (printstring) {
1141                                 if (vp->v_nblock->blk->data != NULL)
1142                                         math_str((char *)
1143                                                  vp->v_nblock->blk->data);
1144                         }
1145                         else if (printchar) {
1146                                 if (vp->v_nblock->blk->data != NULL)
1147                                         math_chr(*vp->v_nblock->blk->data);
1148                         }
1149                         else
1150                                 printvalue(vp, PRINT_NORMAL);
1151                         break;
1152                 default:
1153                         printvalue(vp, PRINT_NORMAL);
1154                 }
1155                 str = math_getdivertedio();
1156                 if (strchr(str, '\n'))
1157                         width = 0;
1158                 len = strlen(str);
1159                 while (!didneg && ((size_t)width > len)) {
1160                         width--;
1161                         math_chr(' ');
1162                 }
1163                 math_str(str);
1164                 free(str);
1165                 while (didneg && ((size_t)width > len)) {
1166                         width--;
1167                         math_chr(' ');
1168                 }
1169                 math_setmode(oldmode);
1170                 math_setdigits(olddigits);
1171         }
1172         math_setfp(stdout);
1173         return 0;
1174 }
1175
1176
1177 /*
1178  * Write a character to a file.
1179  *
1180  * given:
1181  *      id              file id to print to
1182  *      ch              character to write
1183  */
1184 int
1185 idfputc(FILEID id, int ch)
1186 {
1187         FILEIO *fiop;
1188         FILEPOS fpos;
1189
1190         /* get the file info pointer */
1191         fiop = findid(id, TRUE);
1192         if (fiop == NULL)
1193                 return 1;
1194         if (fiop->action == 'r') {
1195                 f_tell(fiop->fp, &fpos);
1196                 if (f_seek_set(fiop->fp, &fpos) < 0)
1197                         return 2;
1198         }
1199
1200         fiop->action = 'w';
1201
1202         /* set output to file */
1203         math_setfp(fiop->fp);
1204
1205         /* write char */
1206         math_chr(ch);
1207
1208         /* restore output to stdout */
1209         math_setfp(stdout);
1210         return 0;
1211 }
1212
1213
1214 /*
1215  * Unget a character read from a file.
1216  *
1217  * given:
1218  *      id              file id to print to
1219  *      ch              character to write
1220  */
1221 int
1222 idungetc(FILEID id, int ch)
1223 {
1224         FILEIO *fiop;
1225
1226         fiop = findid(id, FALSE);
1227         if (fiop == NULL)
1228                 return -2;
1229         if (fiop->action != 'r')
1230                 return -2;
1231         return ungetc(ch, fiop->fp);
1232 }
1233
1234
1235 /*
1236  * Write a string to a file.
1237  *
1238  * given:
1239  *      id              file id to print to
1240  *      str             string to write
1241  */
1242 int
1243 idfputs(FILEID id, STRING *str)
1244 {
1245         FILEIO *fiop;
1246         FILEPOS fpos;
1247         FILE *fp;
1248         char *c;
1249         long len;
1250
1251         /* get the file info pointer */
1252         fiop = findid(id, TRUE);
1253         if (fiop == NULL)
1254                 return 1;
1255
1256         if (fiop->action == 'r') {
1257                 f_tell(fiop->fp, &fpos);
1258                 if (f_seek_set(fiop->fp, &fpos) < 0)
1259                         return 2;
1260         }
1261
1262         fiop->action = 'w';
1263
1264         fp = fiop->fp;
1265         len = str->s_len;
1266         c = str->s_str;
1267
1268         while (len-- > 0)
1269                 fputc(*c++, fp);
1270
1271         return 0;
1272 }
1273
1274
1275 /*
1276  * Same as idfputs but writes a terminating null character
1277  *
1278  * given:
1279  *      id                      file id to print to
1280  *      str                     string to write
1281  */
1282 int
1283 idfputstr(FILEID id, char *str)
1284 {
1285         FILEIO *fiop;
1286         FILEPOS fpos;
1287
1288         /* get the file info pointer */
1289         fiop = findid(id, TRUE);
1290         if (fiop == NULL)
1291                 return 1;
1292
1293         if (fiop->action == 'r') {
1294                 f_tell(fiop->fp, &fpos);
1295                 if (f_seek_set(fiop->fp, &fpos) < 0)
1296                         return 2;
1297         }
1298
1299         fiop->action = 'w';
1300
1301         /* set output to file */
1302         math_setfp(fiop->fp);
1303
1304         /* write the string */
1305         math_str(str);
1306
1307         math_chr('\0');
1308
1309         /* restore output to stdout */
1310         math_setfp(stdout);
1311         return 0;
1312 }
1313
1314
1315 int
1316 rewindid(FILEID id)
1317 {
1318         FILEIO *fiop;
1319         fiop = findid(id, -1);
1320         if (fiop == NULL)
1321                 return 1;
1322         rewind(fiop->fp);
1323         fiop->action = 0;
1324         return 0;
1325 }
1326
1327
1328 void
1329 rewindall(void)
1330 {
1331         FILEIO *fiop;
1332         int i;
1333
1334         for (i = 3; i < idnum; i++) {
1335                 fiop = &files[ioindex[i]];
1336                 if (fiop != NULL) {
1337                         (void) rewind(fiop->fp);
1338                         fiop->action = 0;
1339                 }
1340         }
1341 }
1342
1343
1344 /*
1345  * filepos2z - convert a positive file position into a ZVALUE
1346  *
1347  * given:
1348  *      pos             file position
1349  *
1350  * returns:
1351  *      file position as a ZVALUE
1352  *
1353  * NOTE: Does not support negative file positions.
1354  */
1355 /*ARGSUSED*/
1356 S_FUNC ZVALUE
1357 filepos2z(FILEPOS pos)
1358 {
1359         ZVALUE ret;             /* ZVALUE file position to return */
1360
1361         /*
1362          * store FILEPOS in a ZVALUE as a positive value
1363          */
1364         ret.len = FILEPOS_BITS/BASEB;
1365         ret.v = alloc(ret.len);
1366         zclearval(ret);
1367         SWAP_HALF_IN_FILEPOS(ret.v, &pos);
1368         ret.sign = 0;
1369         ztrim(&ret);
1370
1371         /*
1372          * return our result
1373          */
1374         return ret;
1375 }
1376
1377
1378 /*
1379  * z2filepos - convert a positive ZVALUE file position to a FILEPOS
1380  *
1381  * given:
1382  *      zpos            file position as a ZVALUE
1383  *
1384  * returns:
1385  *      file position as a FILEPOS
1386  *
1387  * NOTE: Does not support negative file positions.
1388  */
1389 S_FUNC FILEPOS
1390 z2filepos(ZVALUE zpos)
1391 {
1392 #if FILEPOS_BITS > FULL_BITS
1393         FILEPOS tmp;            /* temp file position as a FILEPOS */
1394 #endif
1395         FILEPOS ret;            /* file position as a FILEPOS */
1396 #if FILEPOS_BITS < FULL_BITS
1397         long pos;               /* zpos as a long */
1398 #else
1399         FULL pos;               /* zpos as a FULL */
1400 #endif
1401
1402         /*
1403          * firewall
1404          */
1405         zpos.sign = 0;  /* deal only with the absolue value */
1406
1407         /*
1408          * quick return if the position can fit into a long
1409          */
1410 #if FILEPOS_BITS == FULL_BITS
1411         /* ztofull puts the value into native byte order */
1412         pos = ztofull(zpos);
1413         /* on some hosts, FILEPOS is not a scalar */
1414         memset(&ret, 0, sizeof(FILEPOS));
1415         memcpy((void *)&ret, (void *)&pos, sizeof(FILEPOS));
1416         return ret;
1417 #elif FILEPOS_BITS < FULL_BITS
1418         /* ztofull puts the value into native byte order */
1419         pos = ztolong(zpos);
1420         /* on some hosts, FILEPOS is not a scalar */
1421         memset(&ret, 0, sizeof(FILEPOS));
1422         memcpy((void *)&ret, (void *)&pos, sizeof(pos));
1423         return ret;
1424 #else /* FILEPOS_BITS > FULL_BITS */
1425         if (!zgtmaxfull(zpos)) {
1426                 /* ztofull puts the value into native byte order */
1427                 pos = ztofull(zpos);
1428                 memset(&ret, 0, sizeof(FILEPOS));
1429                 memcpy((void *)&ret, (void *)&pos, sizeof(pos));
1430                 return ret;
1431         }
1432
1433         /*
1434          * copy (and swap if needed) lower part of the ZVALUE as needed
1435          */
1436         if (zpos.len >= FILEPOS_BITS/BASEB) {
1437                 /* copy the lower FILEPOS_BITS of the ZVALUE */
1438                 memcpy(&tmp, zpos.v, sizeof(FILEPOS));
1439         } else {
1440                 /* copy what bits we can into the temp value */
1441                 memset(&tmp, 0, sizeof(FILEPOS));
1442                 memcpy(&tmp, zpos.v, zpos.len*BASEB/8);
1443         }
1444         /* swap into native byte order */
1445         SWAP_HALF_IN_FILEPOS(&ret, &tmp);
1446
1447         /*
1448          * return our result
1449          */
1450         return ret;
1451 #endif /* FILEPOS_BITS <= FULL_BITS */
1452 }
1453
1454
1455 /*
1456  * get_open_pos - get a an open file position
1457  *
1458  * given:
1459  *      fp              open file stream
1460  *      res             where to place the file position (ZVALUE)
1461  *
1462  * returns:
1463  *      0               res points to the file position
1464  *      -1              error
1465  */
1466 S_FUNC int
1467 get_open_pos(FILE *fp, ZVALUE *res)
1468 {
1469         FILEPOS pos;            /* current file position */
1470
1471         /*
1472          * get the file position
1473          */
1474         if (f_tell(fp, &pos) < 0) {
1475             /* cannot get file position, return -1 */
1476             return -1;
1477         }
1478
1479         /*
1480          * update file position and return success
1481          */
1482         *res = filepos2z(pos);
1483         return 0;
1484 }
1485
1486
1487 /*
1488  * getloc - get the current position of the file
1489  *
1490  * given:
1491  *      id      file id of the file
1492  *      loc     pointer to result
1493  *
1494  * returns:
1495  *      0       able to get file position
1496  *      -1      unable to get file position
1497  */
1498 int
1499 getloc(FILEID id, ZVALUE *res)
1500 {
1501         FILEIO *fiop;           /* file structure */
1502         FILE *fp;
1503
1504         /*
1505          * convert id to stream
1506          */
1507         fiop = findid(id, -1);
1508         if (fiop == NULL) {
1509                 /* file not open */
1510                 return -1;
1511         }
1512         fp = fiop->fp;
1513         if (fp == NULL) {
1514                 math_error("Bogus internal file pointer!");
1515                 /*NOTREACHED*/
1516         }
1517
1518         /*
1519          * return result
1520          */
1521         return get_open_pos(fp, res);
1522 }
1523
1524
1525 int
1526 ftellid(FILEID id, ZVALUE *res)
1527 {
1528         FILEIO *fiop;
1529         FILEPOS fpos;           /* current file position */
1530
1531         /* get FILEIO */
1532         fiop = findid(id, -1);
1533         if (fiop == NULL)
1534                 return -2;
1535
1536         /* get the file position */
1537         if (f_tell(fiop->fp, &fpos) < 0)
1538                 return -3;
1539
1540         /* convert file position to ZVALUE */
1541         *res = filepos2z(fpos);
1542         return 0;
1543 }
1544
1545
1546 int
1547 fseekid(FILEID id, ZVALUE offset, int whence)
1548 {
1549         FILEIO *fiop;           /* FILEIO of file */
1550         FILEPOS off;            /* offset as a FILEPOS */
1551         ZVALUE cur, tmp;        /* current or end of file location */
1552         int ret = 0;            /* return code */
1553
1554         /* setup */
1555         fiop = findid(id, -1);
1556         if (fiop == NULL)
1557                 return -2;
1558
1559         /* seek depending on whence */
1560         switch (whence) {
1561         case 0:
1562                 /* construct seek position, off = offset */
1563                 if (zisneg(offset))
1564                         return -3;
1565                 off = z2filepos(offset);
1566
1567                 /* seek there */
1568                 ret = f_seek_set(fiop->fp, &off);
1569                 break;
1570
1571         case 1:
1572                 /* construct seek position, off = cur+offset */
1573                 f_tell(fiop->fp, &off);
1574                 cur = filepos2z(off);
1575                 zadd(cur, offset, &tmp);
1576                 zfree(cur);
1577                 if (zisneg(tmp)) {
1578                         zfree(tmp);
1579                         return -3;
1580                 }
1581                 off = z2filepos(tmp);
1582                 zfree(tmp);
1583
1584                 /* seek there */
1585                 ret = f_seek_set(fiop->fp, &off);
1586                 break;
1587
1588         case 2:
1589                 /* construct seek position, off = len+offset */
1590                 if (get_open_siz(fiop->fp, &cur) < 0)
1591                         return -4;
1592                 zadd(cur, offset, &tmp);
1593                 zfree(cur);
1594                 if (zisneg(tmp)) {
1595                         zfree(tmp);
1596                         return -3;
1597                 }
1598                 off = z2filepos(tmp);
1599                 zfree(tmp);
1600
1601                 /* seek there */
1602                 ret = f_seek_set(fiop->fp, &off);
1603                 break;
1604
1605         default:
1606                 return -5;
1607         }
1608         return ret;
1609 }
1610
1611
1612 /*
1613  * set_open_pos - set a an open file position
1614  *
1615  * given:
1616  *      fp              open file stream
1617  *      zpos            file position (ZVALUE) to set
1618  *
1619  * returns:
1620  *      0               res points to the file position
1621  *      -1              error
1622  *
1623  * NOTE: Due to fsetpos limitation, position is set relative to only
1624  *       the beginning of the file.
1625  */
1626 S_FUNC int
1627 set_open_pos(FILE *fp, ZVALUE zpos)
1628 {
1629         FILEPOS pos;            /* current file position */
1630
1631         /*
1632          * convert ZVALUE to file position
1633          */
1634         pos = z2filepos(zpos);
1635
1636         /*
1637          * set the file position
1638          */
1639         if (f_seek_set(fp, &pos) < 0) {
1640             /* cannot set file position, return -1 */
1641             return -1;
1642         }
1643
1644         /*
1645          * return sucess
1646          */
1647         return 0;
1648 }
1649
1650
1651 /*
1652  * setloc - set the current position of the file
1653  *
1654  * given:
1655  *      id      file id of the file
1656  *      zpos    file position (ZVALUE) to set
1657  *
1658  * returns:
1659  *      0       able to set file position
1660  *      -1      unable to set file position
1661  */
1662 int
1663 setloc(FILEID id, ZVALUE zpos)
1664 {
1665         FILEIO *fiop;           /* file structure */
1666         FILE *fp;
1667
1668         /*
1669          * firewall
1670          */
1671         if ((id == FILEID_STDIN) || (id == FILEID_STDOUT) ||
1672             (id == FILEID_STDERR)) {
1673                 math_error("Cannot fseek stdin, stdout, or stderr");
1674                 /*NOTREACHED*/
1675         }
1676
1677         /*
1678          * convert id to stream
1679          */
1680         fiop = findid(id, -1);
1681         if (fiop == NULL) {
1682                 /* file not open */
1683                 return -1;
1684         }
1685         fp = fiop->fp;
1686         if (fp == NULL) {
1687                 math_error("Bogus internal file pointer!");
1688                 /*NOTREACHED*/
1689         }
1690
1691         fiop->action = 0;
1692
1693         /*
1694          * return result
1695          */
1696         return set_open_pos(fp, zpos);
1697 }
1698
1699
1700 /*
1701  * off_t2z - convert an off_t into a ZVALUE
1702  *
1703  * given:
1704  *      siz             file size
1705  *
1706  * returns:
1707  *      file size as a ZVALUE
1708  */
1709 /*ARGSUSED*/
1710 S_FUNC ZVALUE
1711 off_t2z(off_t siz)
1712 {
1713         ZVALUE ret;             /* ZVALUE file size to return */
1714
1715         /*
1716          * store off_t in a ZVALUE as a positive value
1717          */
1718         ret.len = OFF_T_BITS/BASEB;
1719         ret.v = alloc(ret.len);
1720         zclearval(ret);
1721         SWAP_HALF_IN_OFF_T(ret.v, &siz);
1722         ret.sign = 0;
1723         ztrim(&ret);
1724
1725         /*
1726          * return our result
1727          */
1728         return ret;
1729 }
1730
1731
1732 /*
1733  * dev2z - convert a stat.st_dev into a ZVALUE
1734  *
1735  * given:
1736  *      dev             device
1737  *
1738  * returns:
1739  *      file size as a ZVALUE
1740  */
1741 S_FUNC ZVALUE
1742 dev2z(dev_t dev)
1743 {
1744         ZVALUE ret;             /* ZVALUE file size to return */
1745
1746         /*
1747          * store off_t in a ZVALUE as a positive value
1748          */
1749         ret.len = DEV_BITS/BASEB;
1750         ret.v = alloc(ret.len);
1751         zclearval(ret);
1752         SWAP_HALF_IN_DEV(ret.v, &dev);
1753         ret.sign = 0;
1754         ztrim(&ret);
1755
1756         /*
1757          * return our result
1758          */
1759         return ret;
1760 }
1761
1762
1763 /*
1764  * inode2z - convert a stat.st_ino into a ZVALUE
1765  *
1766  * given:
1767  *      inode           file size
1768  *
1769  * returns:
1770  *      file size as a ZVALUE
1771  */
1772 /*ARGSUSED*/
1773 S_FUNC ZVALUE
1774 inode2z(ino_t inode)
1775 {
1776         ZVALUE ret;             /* ZVALUE file size to return */
1777
1778         /*
1779          * store off_t in a ZVALUE as a positive value
1780          */
1781         ret.len = INODE_BITS/BASEB;
1782         ret.v = alloc(ret.len);
1783         zclearval(ret);
1784         SWAP_HALF_IN_INODE(ret.v, &inode);
1785         ret.sign = 0;
1786         ztrim(&ret);
1787
1788         /*
1789          * return our result
1790          */
1791         return ret;
1792 }
1793
1794
1795 /*
1796  * get_open_siz - get a an open file size
1797  *
1798  * given:
1799  *      fp              open file stream
1800  *      res             where to place the file size (ZVALUE)
1801  *
1802  * returns:
1803  *      0               res points to the file size
1804  *      -1              error
1805  */
1806 int
1807 get_open_siz(FILE *fp, ZVALUE *res)
1808 {
1809         struct stat buf;        /* file status */
1810
1811         /*
1812          * get the file size
1813          */
1814         if (fstat(fileno(fp), &buf) < 0) {
1815                 /* stat error */
1816                 return -1;
1817         }
1818
1819         /*
1820          * update file size and return success
1821          */
1822         *res = off_t2z(buf.st_size);
1823         return 0;
1824 }
1825
1826
1827 /*
1828  * getsize - get the current size of the file
1829  *
1830  * given:
1831  *      id      file id of the file
1832  *      res     pointer to result
1833  *
1834  * returns:
1835  *      0               able to get file size
1836  *      EOF             system error
1837  *      other nonzero   file not open or other problem
1838  */
1839 int
1840 getsize(FILEID id, ZVALUE *res)
1841 {
1842         FILEIO *fiop;           /* file structure */
1843         FILE *fp;
1844
1845         /*
1846          * convert id to stream
1847          */
1848         fiop = findid(id, -1);
1849         if (fiop == NULL) {
1850                 /* file not open */
1851                 return 1;
1852         }
1853         fp = fiop->fp;
1854         if (fp == NULL) {
1855                 return 2;
1856         }
1857
1858         /*
1859          * return result
1860          */
1861         return get_open_siz(fp, res);
1862 }
1863
1864
1865 /*
1866  * getdevice - get the device of the file
1867  *
1868  * given:
1869  *      id      file id of the file
1870  *      dev     pointer to the result
1871  *
1872  * returns:
1873  *      0       able to get device
1874  *      -1      unable to get device
1875  */
1876 int
1877 get_device(FILEID id, ZVALUE *dev)
1878 {
1879         FILEIO *fiop;           /* file structure */
1880
1881         /*
1882          * convert id to stream
1883          */
1884         fiop = findid(id, -1);
1885         if (fiop == NULL) {
1886                 /* file not open */
1887                 return -1;
1888         }
1889
1890         /*
1891          * return result
1892          */
1893         *dev = dev2z(fiop->dev);
1894         return 0;
1895 }
1896
1897
1898 /*
1899  * getinode - get the inode of the file
1900  *
1901  * given:
1902  *      id      file id of the file
1903  *      inode   pointer to the result
1904  *
1905  * returns:
1906  *      0       able to get inode
1907  *      -1      unable to get inode
1908  */
1909 int
1910 get_inode(FILEID id, ZVALUE *inode)
1911 {
1912         FILEIO *fiop;           /* file structure */
1913
1914         /*
1915          * convert id to stream
1916          */
1917         fiop = findid(id, -1);
1918         if (fiop == NULL) {
1919                 /* file not open */
1920                 return -1;
1921         }
1922
1923         /*
1924          * return result
1925          */
1926         *inode = inode2z(fiop->inode);
1927         return 0;
1928 }
1929
1930
1931 S_FUNC off_t
1932 filesize(FILEIO *fiop)
1933 {
1934         struct stat sbuf;
1935
1936         /* return length */
1937         if (fstat(fileno(fiop->fp), &sbuf) < 0) {
1938                 math_error("bad fstat");
1939                 /*NOTREACHED*/
1940         }
1941         return sbuf.st_size;
1942 }
1943
1944
1945 ZVALUE
1946 zfilesize(FILEID id)
1947 {
1948         FILEIO *fiop;
1949         off_t len;              /* file length */
1950         ZVALUE ret;             /* file size as a ZVALUE return value */
1951
1952         /* file FILEIO */
1953         fiop = findid(id, -1);
1954         if (fiop == NULL) {
1955                 /* return neg value for non-file error */
1956                 itoz(-1, &ret);
1957                 return ret;
1958         }
1959
1960         /* get length */
1961         len = filesize(fiop);
1962         ret = off_t2z(len);
1963         return ret;
1964 }
1965
1966
1967 void
1968 showfiles(void)
1969 {
1970         BOOL listed[MAXFILES];
1971         FILEIO *fiop;
1972         FILE *fp;
1973         struct stat sbuf;
1974         ino_t inodes[MAXFILES];
1975         off_t sizes[MAXFILES];
1976         int i, j;
1977
1978         for (i = 0; i < idnum; i++) {
1979                 listed[i] = FALSE;
1980                 fiop = &files[ioindex[i]];
1981                 fp = fiop->fp;
1982                 if (fstat(fileno(fp), &sbuf) < 0) {
1983                         printf("Bad fstat for file %d\n", (int) fiop->id);
1984                         sizes[i] = -1;
1985                 } else {
1986                         inodes[i] = sbuf.st_ino;
1987                         sizes[i] = sbuf.st_size;
1988                 }
1989         }
1990         for (i = 0; i < idnum; i++) {
1991                 if (listed[i])
1992                         continue;
1993                 fiop = &files[ioindex[i]];
1994                 printf("\t");
1995                 printid(fiop->id, PRINT_UNAMBIG);
1996                 if (sizes[i] == -1) {
1997                         math_chr('\n');
1998                         continue;
1999                 }
2000                 printf(" size = %lld\n", (long long int)sizes[i]);
2001                 for (j = i + 1; j < idnum; j++) {
2002                         if (listed[j] || sizes[j] == -1)
2003                                 continue;
2004                         if (inodes[j] == inodes[i]) {
2005                                 listed[j] = TRUE;
2006                                 fiop = &files[ioindex[j]];
2007                                 printf("\t  = ");
2008                                 printid(fiop->id, PRINT_UNAMBIG);
2009                                 printf("\n");
2010                         }
2011                 }
2012         }
2013         printf("\tNumber open = %d\n", idnum);
2014         printf("\tLastid = %d\n", (int) lastid);
2015 }
2016
2017
2018 /*
2019  * getscanfield - scan a field separated by some characters
2020  *
2021  * given:
2022  *      fp              FILEID to scan
2023  *      skip
2024  *      width           max field width
2025  *      scannum         Number of characters in scanset
2026  *      scanptr         string of characters considered separators
2027  *      strptr          pointer to where the new field pointer may be found
2028  */
2029 S_FUNC void
2030 getscanfield(FILE *fp, BOOL skip, unsigned int width, int scannum,
2031              char *scanptr, char **strptr)
2032 {
2033         char *str;              /* current string */
2034         unsigned long len;      /* current length of string */
2035         unsigned long totlen;   /* total length of string */
2036         char buf[READSIZE];     /* temporary buffer */
2037         int c;
2038         char *b;
2039         BOOL comp;              /* Use complement of scanset */
2040         unsigned int chnum;
2041
2042         totlen = 0;
2043         str = NULL;
2044
2045         comp = (scannum < 0);
2046         if (comp)
2047                 scannum = -scannum;
2048
2049         chnum = 0;
2050
2051         for (;;) {
2052                 len = 0;
2053                 b = buf;
2054                 for(;;) {
2055                         c = fgetc(fp);
2056                         if (c == EOF || c == '\0')
2057                                 break;
2058                         chnum++;
2059                         if(scannum &&
2060                            ((memchr(scanptr,c,scannum)==NULL) ^ comp))
2061                                 break;
2062                         if (!skip) {
2063                                 *b++ = c;
2064                                 len++;
2065                                 if (len >= READSIZE)
2066                                         break;
2067                         }
2068                         if (chnum == width)
2069                                 break;
2070                 }
2071                 if (!skip) {
2072                         if (totlen)
2073                                 str = (char *) realloc(str, totlen + len + 1);
2074                         else
2075                                 str = (char *) malloc(len + 1);
2076                         if (str == NULL) {
2077                                 math_error("Out of memory for scanning");
2078                                 /*NOTREACHED*/
2079                         }
2080                         if (len)
2081                                 memcpy(&str[totlen], buf, len);
2082                         totlen += len;
2083                 }
2084                 if (len < READSIZE)
2085                         break;
2086         }
2087
2088         if (!(width && chnum == width) && c != '\0')
2089                 ungetc(c, fp);
2090
2091         if (!skip) {
2092                 str[totlen] = '\0';
2093                 *strptr = str;
2094         }
2095 }
2096
2097
2098 /*
2099  * getscanwhite - scan a field separated by whitespace
2100  *
2101  * given:
2102  *      fp              FILEID to scan
2103  *      skip
2104  *      width           max field width
2105  *      scannum         Number of characters in scanset
2106  *      strptr          pointer to where the new field pointer may be found
2107  */
2108 S_FUNC void
2109 getscanwhite(FILE *fp, BOOL skip, unsigned int width, int scannum,
2110              char **strptr)
2111 {
2112         char *str;              /* current string */
2113         unsigned long len;      /* current length of string */
2114         unsigned long totlen;   /* total length of string */
2115         char buf[READSIZE];     /* temporary buffer */
2116         int c;
2117         char *b;
2118         BOOL comp;              /* Use complement of scanset */
2119         unsigned int chnum;
2120
2121         totlen = 0;
2122         str = NULL;
2123
2124         comp = (scannum < 0);
2125         if (comp)
2126                 scannum = -scannum;
2127
2128         chnum = 0;
2129
2130         for (;;) {
2131                 len = 0;
2132                 b = buf;
2133                 for(;;) {
2134                         c = fgetc(fp);
2135                         if (c == EOF || c == '\0')
2136                                 break;
2137                         chnum++;
2138                         if(scannum && (!isspace(c) ^ comp))
2139                                 break;
2140                         if (!skip) {
2141                                 *b++ = c;
2142                                 len++;
2143                                 if (len >= READSIZE)
2144                                         break;
2145                         }
2146                         if (chnum == width)
2147                                 break;
2148                 }
2149                 if (!skip) {
2150                         if (totlen)
2151                                 str = (char *) realloc(str, totlen + len + 1);
2152                         else
2153                                 str = (char *) malloc(len + 1);
2154                         if (str == NULL) {
2155                                 math_error("Out of memory for scanning");
2156                                 /*NOTREACHED*/
2157                         }
2158                         if (len)
2159                                 memcpy(&str[totlen], buf, len);
2160                         totlen += len;
2161                 }
2162                 if (len < READSIZE)
2163                         break;
2164         }
2165
2166         if (!(width && chnum == width) && c != '\0')
2167                 ungetc(c, fp);
2168
2169         if (!skip) {
2170                 str[totlen] = '\0';
2171                 *strptr = str;
2172         }
2173 }
2174
2175
2176 S_FUNC int
2177 fscanfile(FILE *fp, char *fmt, int count, VALUE **vals)
2178 {
2179         int assnum;     /* Number of assignments made */
2180         int c;          /* Character read from file */
2181         char f;         /* Character read from format string */
2182         int scannum;    /* Number of characters in scanlist */
2183         char *scanptr;  /* Start of scanlist */
2184         char *str;
2185         BOOL comp;      /* True scanset is complementary */
2186         BOOL skip;      /* True if string to be skipped rather than read */
2187         int width;
2188         VALUE *var;     /* lvalue to be assigned to */
2189         unsigned short subtype; /* for var->v_subtype */
2190         FILEPOS cur;    /* current location */
2191
2192         if (feof(fp))
2193                 return EOF;
2194
2195         assnum = 0;
2196
2197         for (;;) {
2198                 for (;;) {
2199                         f = *fmt++;
2200                         if (isspace((int)f)) {
2201                                 getscanwhite(fp,1,0,6,NULL);
2202                                 do {
2203                                         f = *fmt++;
2204                                 } while (isspace((int)f));
2205                         }
2206                         c = fgetc(fp);
2207                         if (c == EOF)
2208                                 return assnum;
2209                         if (f == '%') {
2210                                 f = *fmt++;
2211                                 if (f != '%' && f != '\0')
2212                                         break;
2213                         }
2214                         if (f != c || f == '\0') {
2215                                 ungetc(c, fp);
2216                                 return assnum;
2217                         }
2218                 }
2219                 ungetc(c, fp);
2220                 skip = (f == '*');
2221                 if (!skip && count == 0) {
2222                         return assnum;
2223                 }
2224                 if (skip)
2225                         f = *fmt++;
2226                 width = 0;
2227                 while (f >= '0' && f <= '9') {
2228                         width = 10 * width + f - '0';
2229                         f = *fmt++;
2230                 }
2231                 switch (f) {
2232                 case 'c':
2233                         if (width == 0)
2234                                 width = 1;
2235                         getscanfield(fp,skip,width,0,NULL,&str);
2236                         break;
2237                 case 's':
2238                         getscanwhite(fp,1,0,6,NULL);
2239                         if (feof(fp))
2240                                 return assnum;
2241                         getscanwhite(fp,skip,width,-6,&str);
2242                         break;
2243                 case '[':
2244                         f = *fmt;
2245                         comp = (f == '^');
2246                         if (comp)
2247                                 f = *++fmt;
2248                         scanptr = fmt;
2249                         if (f == '\0')
2250                                 return assnum;
2251                         fmt = strchr((f == ']' ? fmt + 1 : fmt), ']');
2252                         if (fmt == NULL)
2253                                 return assnum;
2254                         scannum = fmt - scanptr;
2255                         if (comp)
2256                                 scannum = -scannum;
2257                         fmt++;
2258                         getscanfield(fp,skip,
2259                                  width,scannum,scanptr,&str);
2260                         break;
2261                 case 'f':
2262                 case 'e':
2263                 case 'r':
2264                 case 'i':
2265                         getscanwhite(fp,1,0,6, NULL);
2266                         if (feof(fp))
2267                                 return assnum;
2268                         if (skip) {
2269                                 fskipnum(fp);
2270                                 continue;
2271                         }
2272                         assnum++;
2273                         var = *vals++;
2274                         if (var->v_type != V_ADDR)
2275                         math_error("This should not happen!!");
2276                         var = var->v_addr;
2277                         subtype = var->v_subtype;
2278                         freevalue(var);
2279                         count--;
2280                         freadsum(fp, var);
2281                         var->v_subtype = subtype;
2282                         continue;
2283                 case 'n':
2284                         assnum++;
2285                         var = *vals++;
2286                         count--;
2287                         if (var->v_type != V_ADDR)
2288                                 math_error("This should not happen!!");
2289                         var = var->v_addr;
2290                         subtype = var->v_subtype;
2291                         freevalue(var);
2292                         var->v_type = V_NUM;
2293                         var->v_num = qalloc();
2294                         f_tell(fp, &cur);
2295                         var->v_num->num = filepos2z(cur);
2296                         var->v_subtype = subtype;
2297                         continue;
2298                 default:
2299                         fprintf(stderr, "Unsupported scan specifier");
2300                         return assnum;
2301                 }
2302                 if (!skip) {
2303                         assnum++;
2304                         var = *vals++;
2305                         count--;
2306                         if (var->v_type != V_ADDR)
2307                                 math_error("Assigning to nonvariable");
2308                         var = var->v_addr;
2309                         subtype = var->v_subtype;
2310                         freevalue(var);
2311                         var->v_type = V_STR;
2312                         var->v_str = makestring(str);
2313                 }
2314         }
2315 }
2316
2317
2318 int
2319 fscanfid(FILEID id, char *fmt, int count, VALUE **vals)
2320 {
2321         FILEIO *fiop;
2322         FILE *fp;
2323         FILEPOS fpos;
2324
2325         fiop = findid(id, FALSE);
2326         if (fiop == NULL)
2327                 return -2;
2328
2329         fp = fiop->fp;
2330
2331         if (fiop->action == 'w') {
2332                 f_tell(fp, &fpos);
2333                 fflush(fp);
2334                 if (f_seek_set(fp, &fpos) < 0)
2335                         return -4;
2336         }
2337         fiop->action = 'r';
2338
2339         return fscanfile(fp, fmt, count, vals);
2340 }
2341
2342
2343 int
2344 scanfstr(char *str, char *fmt, int count, VALUE **vals)
2345 {
2346         FILE *fp;
2347         int i;
2348
2349         fp = tmpfile();
2350         if (fp == NULL)
2351                 return EOF;
2352         fputs(str, fp);
2353         rewind(fp);
2354         i = fscanfile(fp, fmt, count, vals);
2355         fclose(fp);
2356         return i;
2357 }
2358
2359
2360 /*
2361  * Read a number in floating-point format from a file.  The first dot,
2362  * if any, is considered as the decimal point; later dots are ignored.
2363  * For example, -23.45..67. is interpreted as -23.4567
2364  * An optional 'e' or 'E' indicates multiplication by a power or 10,
2365  * e.g. -23.45e-6 has the effect of -23.45 * 10^-6.  The reading
2366  * ceases when a character other than a digit, a leading sign,
2367  * a sign immediately following 'e' or 'E', or a dot is encountered.
2368  * Absence of digits is interpreted as zero.
2369  */
2370 S_FUNC void
2371 freadnum(FILE *fp, VALUE *valptr)
2372 {
2373         ZVALUE num, zden, newnum, newden, div, tmp;
2374         NUMBER *q;
2375         COMPLEX *c;
2376         VALUE val;
2377         char ch;
2378         LEN i;
2379         HALF *a;
2380         FULL f;
2381         long decimals, exp;
2382         BOOL sign, negexp, havedp, imag, exptoobig;
2383
2384         decimals = 0;
2385         exp = 0;
2386         sign = FALSE;
2387         negexp = FALSE;
2388         havedp = FALSE;
2389         imag = FALSE;
2390         exptoobig = FALSE;
2391
2392         ch = fgetc(fp);
2393         if (ch == '+' || ch == '-') {
2394                 if (ch == '-')
2395                         sign = TRUE;
2396                 ch = fgetc(fp);
2397         }
2398         num.v = alloc(1);
2399         *num.v = 0;
2400         num.len = 1;
2401         num.sign = sign;
2402         for (;;) {
2403                 if (ch >= '0' && ch <= '9') {
2404                         f = (FULL) (ch - '0');
2405                         a = num.v;
2406                         i = num.len;
2407                         while (i-- > 0) {
2408                                 f = 10 * (FULL) *a + f;
2409                                 *a++ = (HALF) f;
2410                                 f >>= BASEB;
2411                         }
2412                         if (f) {
2413                                 a = alloc(num.len + 1);
2414                                 memcpy(a, num.v, num.len * sizeof(HALF));
2415                                 a[num.len] = (HALF) f;
2416                                 num.len++;
2417                                 freeh(num.v);
2418                                 num.v = a;
2419                         }
2420                         if (havedp)
2421                                 decimals++;
2422                 }
2423                 else if (ch == '.')
2424                         havedp = TRUE;
2425                 else
2426                         break;
2427                 ch = fgetc(fp);
2428         }
2429         if (ch == 'e' || ch == 'E') {
2430                 ch = fgetc(fp);
2431                 if (ch == '+' || ch == '-') {
2432                         if (ch == '-')
2433                                 negexp = TRUE;
2434                         ch = fgetc(fp);
2435                 }
2436                 while (ch >= '0' && ch <= '9') {
2437                         if (!exptoobig) {
2438                                 exp = (exp * 10) + ch - '0';
2439                                 if (exp > 1000000)
2440                                         exptoobig = TRUE;
2441                         }
2442                         ch = fgetc(fp);
2443                 }
2444         }
2445         if (ch == 'i' || ch == 'I') {
2446                 imag = TRUE;
2447         } else {
2448                 ungetc(ch, fp);
2449         }
2450
2451         if (ziszero(num)) {
2452                 zfree(num);
2453                 val.v_type = V_NUM;
2454                 val.v_subtype = V_NOSUBTYPE;
2455                 val.v_num = qlink(&_qzero_);
2456                 *valptr = val;
2457                 return;
2458         }
2459         if (exptoobig) {
2460                 zfree(num);
2461                 *valptr = error_value(E_BIGEXP);
2462                 return;
2463         }
2464         ztenpow(decimals, &zden);
2465         if (exp) {
2466                 ztenpow(exp, &tmp);
2467                 if (negexp) {
2468                         zmul(zden, tmp, &newden);
2469                         zfree(zden);
2470                         zden = newden;
2471                 } else {
2472                         zmul(num, tmp, &newnum);
2473                         zfree(num);
2474                         num = newnum;
2475                 }
2476                 zfree(tmp);
2477         }
2478         if (!zisunit(num) && !zisunit(zden)) {
2479                 zgcd(num, zden, &div);
2480                 if (!zisunit(div)) {
2481                         zequo(num, div, &newnum);
2482                         zfree(num);
2483                         zequo(zden, div, &newden);
2484                         zfree(zden);
2485                         num = newnum;
2486                         zden = newden;
2487                 }
2488                 zfree(div);
2489         }
2490         q = qalloc();
2491         q->num = num;
2492         q->den = zden;
2493         if (imag) {
2494                 c = comalloc();
2495                 qfree(c->imag);
2496                 c->imag = q;
2497                 val.v_type = V_COM;
2498                 val.v_com = c;
2499         } else {
2500                 val.v_type = V_NUM;
2501                 val.v_num = q;
2502         }
2503         val.v_subtype = V_NOSUBTYPE;
2504         *valptr = val;
2505 }
2506
2507
2508 S_FUNC void
2509 freadsum(FILE *fp, VALUE *valptr)
2510 {
2511         VALUE v1, v2, v3;
2512         char ch;
2513
2514
2515         freadprod(fp, &v1);
2516
2517         ch = fgetc(fp);
2518         while (ch == '+' || ch == '-') {
2519                 freadprod(fp, &v2);
2520                 if (ch == '+')
2521                         addvalue(&v1, &v2, &v3);
2522                 else
2523                         subvalue(&v1, &v2, &v3);
2524                 freevalue(&v1);
2525                 freevalue(&v2);
2526                 v1 = v3;
2527                 ch = fgetc(fp);
2528         }
2529         ungetc(ch, fp);
2530         *valptr = v1;
2531 }
2532
2533
2534 S_FUNC void
2535 freadprod(FILE *fp, VALUE *valptr)
2536 {
2537         VALUE v1, v2, v3;
2538         char ch;
2539
2540         freadnum(fp, &v1);
2541         ch = fgetc(fp);
2542         while (ch == '*' || ch == '/') {
2543                 freadnum(fp, &v2);
2544                 if (ch == '*')
2545                         mulvalue(&v1, &v2, &v3);
2546                 else
2547                         divvalue(&v1, &v2, &v3);
2548                 freevalue(&v1);
2549                 freevalue(&v2);
2550                 v1 = v3;
2551                 ch = fgetc(fp);
2552         }
2553         ungetc(ch, fp);
2554         *valptr = v1;
2555 }
2556
2557
2558 S_FUNC void
2559 fskipnum(FILE *fp)
2560 {
2561         char ch;
2562
2563         do {
2564                 ch = fgetc(fp);
2565                 if (ch == '+' || ch == '-')
2566                         ch = fgetc(fp);
2567                 while ((ch >= '0' && ch <= '9') || ch == '.')
2568                         ch = fgetc(fp);
2569                 if (ch == 'e' || ch == 'E') {
2570                         ch = fgetc(fp);
2571                         if (ch == '+' || ch == '-')
2572                                 ch = fgetc(fp);
2573                         while (ch >= '0' && ch <= '9')
2574                                 ch = fgetc(fp);
2575                 }
2576                 if (ch == 'i' || ch == 'I')
2577                         ch = fgetc(fp);
2578         } while (ch == '/' || ch == '*' || ch == '+' || ch == '-');
2579
2580         ungetc(ch, fp);
2581 }
2582
2583
2584 int
2585 isattyid(FILEID id)
2586 {
2587         FILEIO *fiop;
2588
2589         fiop = findid(id, -1);
2590         if (fiop == NULL)
2591                 return -2;
2592         return isatty(fileno(fiop->fp));
2593 }
2594
2595
2596 /*
2597  * fsearch - search for a string in a file
2598  *
2599  * given:
2600  *      id      FILEID to search
2601  *      str     string to look for
2602  *      pos     file postion to start at (NULL => current position)
2603  *
2604  * returns:
2605  *      EOF if system error
2606  *      other negative integer if file not open, etc.
2607  *      positive integer if string not found
2608  *      zero if string found, position stored at res
2609  *
2610  * XXX - This search is a translation of the original search that did not
2611  *       work with large files.  The search algorithm used is slow and
2612  *       should be spead up much more.
2613  */
2614 int
2615 fsearch(FILEID id, char *str, ZVALUE start, ZVALUE end, ZVALUE *res)
2616 {
2617         FILEIO *fiop;           /* FILEIO of file id */
2618         FILEPOS cur;            /* current file position */
2619         ZVALUE tmp, tmp2;       /* temporary ZVALUEs */
2620         char c;                 /* str comparison character */
2621         int r;                  /* character read from file */
2622         char *s;                /* str comparison pointer */
2623         long k = 0;
2624
2625         /* get FILEIO */
2626         fiop = findid(id, FALSE);
2627         if (fiop == NULL)
2628                 return -2;
2629
2630         /*
2631          * file setup
2632          */
2633         if (fiop->action == 'w')
2634                 fflush(fiop->fp);
2635
2636         zsub(end, start, &tmp2);
2637
2638         if (zisneg(tmp2)) {
2639                 zfree(tmp2);
2640                 return 1;
2641         }
2642
2643         tmp.sign  = 0;
2644         tmp.len = tmp2.len;
2645         tmp.v = alloc(tmp.len);
2646         zcopyval(tmp2, tmp);
2647         zfree(tmp2);
2648
2649         cur = z2filepos(start);
2650
2651         if (f_seek_set(fiop->fp, &cur) < 0) {
2652                 zfree(tmp);
2653                 return EOF;
2654         }
2655
2656         /*
2657          * search setup
2658          */
2659         /* note the first str search character */
2660         c = *str++;
2661
2662         if (c == '\0') {
2663                 zfree(tmp);
2664                 return 2;
2665         }
2666         clearerr(fiop->fp);
2667         while ((r = fgetc(fiop->fp)) != EOF) {
2668                 if ((char)r == c) {
2669                         (void) f_tell(fiop->fp, &cur);
2670                         s = str;
2671                         while (*s) {
2672                                 r = fgetc(fiop->fp);
2673                                 if ((char)r != *s)
2674                                         break;
2675                                 s++;
2676                         }
2677                         if (r == EOF)
2678                                 break;
2679                         if (*s == '\0') {
2680                                 zfree(tmp);
2681                                 tmp = filepos2z(cur);
2682                                 zsub(tmp, _one_, res);
2683                                 zfree(tmp);
2684                                 return 0;
2685                         }
2686                         (void) f_seek_set(fiop->fp, &cur);
2687                 }
2688                 if (*tmp.v) {
2689                         (*tmp.v)--;
2690                 } else {
2691                         if (tmp.len == 1)
2692                                 break;
2693                         k = 0;
2694                         do {
2695                                 tmp.v[k++] = BASE1;
2696                         }
2697                         while (k < tmp.len && tmp.v[k] == 0);
2698                         if (k == tmp.len) {
2699                                 math_error("This should not happen");
2700                                 /*NOTREACHED*/
2701                         }
2702                         tmp.v[k]--;
2703                         if (tmp.v[tmp.len - 1] == 0)
2704                                 tmp.len--;
2705                 }
2706         }
2707         zfree(tmp);
2708         if (ferror(fiop->fp))
2709                 return EOF;
2710         return 1;
2711 }
2712
2713
2714 /*
2715  * frsearch - reverse search for a string in a file
2716  *
2717  * given:
2718  *      id      FILEID to search
2719  *      str     string to look for
2720  *      search starts at pos = first and continues for decreasing
2721  *              pos >= last
2722  *
2723  * returns:
2724  *      EOF if system error
2725  *      other negative integer if file not open, etc.
2726  *      positive integer if string not found
2727  *      zero if string found, position stored at res
2728  *
2729  * XXX - This search is a translation of the original search that did not
2730  *       work with large files.  The search algorithm used is so slow
2731  *       as to be painful to the user and needs to be sped up much more.
2732  */
2733 int
2734 frsearch(FILEID id, char *str, ZVALUE first, ZVALUE last, ZVALUE *res)
2735 {
2736         FILEIO *fiop;           /* FILEIO of file id */
2737         FILEPOS cur;            /* current file position */
2738         ZVALUE pos;             /* current file position as ZVALUE */
2739         ZVALUE tmp;             /* temporary ZVALUEs */
2740         char c;                 /* str comparison character */
2741         int r;                  /* character read from file */
2742         char *s;                /* str comparison pointer */
2743
2744         /* get FILEIO */
2745         fiop = findid(id, FALSE);
2746         if (fiop == NULL)
2747                 return -2;
2748
2749         /*
2750          * file setup
2751          */
2752         if (fiop->action == 'w')
2753                 fflush(fiop->fp);
2754
2755         zcopy(first, &pos);
2756
2757         /*
2758          * search setup
2759          */
2760         /* note the first str search character */
2761         c = *str++;
2762
2763         if (c == '\0') {
2764                 cur = z2filepos(pos);
2765                 if (f_seek_set(fiop->fp, &cur) < 0) {
2766                         zfree(pos);
2767                         return EOF;
2768                 }
2769                 *res = pos;
2770                 return 0;
2771         }
2772
2773         clearerr(fiop->fp);
2774
2775         while(zrel(pos, last) >= 0) {
2776                 cur = z2filepos(pos);
2777                 if (f_seek_set(fiop->fp, &cur) < 0) {
2778                         zfree(pos);
2779                         return EOF;
2780                 }
2781                 r = fgetc(fiop->fp);
2782                 if (r == EOF) {
2783                         zfree(pos);
2784                         return EOF;
2785                 }
2786                 if ((char) r == c) {
2787                         s = str;
2788                         while (*s) {
2789                                 r = fgetc(fiop->fp);
2790                                 if ((char)r != *s)
2791                                         break;
2792                                 s++;
2793                         }
2794                         if (r == EOF) {
2795                                 zfree(pos);
2796                                 return EOF;
2797                         }
2798                         if (*s == '\0') {
2799                                 *res = pos;
2800                                 ungetc(r, fiop->fp);
2801                                 return 0;
2802                         }
2803                 }
2804                 zsub(pos, _one_, &tmp);
2805                 zfree(pos);
2806                 pos = tmp;
2807         }
2808         cur = z2filepos(last);
2809         f_seek_set(fiop->fp, &cur);
2810         zfree(pos);
2811         if (ferror(fiop->fp))
2812                 return EOF;
2813         return 1;
2814 }
2815
2816
2817 char *
2818 findfname(FILEID id)
2819 {
2820         FILEIO *fiop;
2821
2822         fiop = findid(id, -1);
2823
2824         if (fiop == NULL)
2825                 return NULL;
2826
2827         return fiop->name;
2828 }