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