xref: /netbsd-src/external/historical/nawk/dist/lib.c (revision 5b485840a103eaaeaabc5be159a3a1443ee55a4c)
1 /****************************************************************
2 Copyright (C) Lucent Technologies 1997
3 All Rights Reserved
4 
5 Permission to use, copy, modify, and distribute this software and
6 its documentation for any purpose and without fee is hereby
7 granted, provided that the above copyright notice appear in all
8 copies and that both that the copyright notice and this
9 permission notice and warranty disclaimer appear in supporting
10 documentation, and that the name Lucent Technologies or any of
11 its entities not be used in advertising or publicity pertaining
12 to distribution of the software without specific, written prior
13 permission.
14 
15 LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
16 INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
17 IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
18 SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
19 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
20 IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
21 ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
22 THIS SOFTWARE.
23 ****************************************************************/
24 
25 #if HAVE_NBTOOL_CONFIG_H
26 #include "nbtool_config.h"
27 #endif
28 
29 #define DEBUG
30 #include <stdio.h>
31 #include <string.h>
32 #include <strings.h>
33 #include <ctype.h>
34 #include <errno.h>
35 #include <stdlib.h>
36 #include <stdarg.h>
37 #include <limits.h>
38 #include <math.h>
39 #include "awk.h"
40 #include "awkgram.h"
41 
42 extern int u8_nextlen(const char *s);
43 
44 char	EMPTY[] = { '\0' };
45 FILE	*infile	= NULL;
46 bool	innew;		/* true = infile has not been read by readrec */
47 char	*file	= EMPTY;
48 char	*record;
49 int	recsize	= RECSIZE;
50 char	*fields;
51 int	fieldssize = RECSIZE;
52 
53 Cell	**fldtab;	/* pointers to Cells */
54 static size_t	len_inputFS = 0;
55 static char	*inputFS; /* FS at time of input, for field splitting */
56 
57 #define	MAXFLD	2
58 int	nfields	= MAXFLD;	/* last allocated slot for $i */
59 
60 bool	donefld;	/* true = implies rec broken into fields */
61 bool	donerec;	/* true = record is valid (no flds have changed) */
62 
63 int	lastfld	= 0;	/* last used field */
64 int	argno	= 1;	/* current input argument number */
65 extern	Awkfloat *ARGC;
66 
67 static Cell dollar0 = { OCELL, CFLD, NULL, EMPTY, 0.0, REC|STR|DONTFREE, NULL, NULL };
68 static Cell dollar1 = { OCELL, CFLD, NULL, EMPTY, 0.0, FLD|STR|DONTFREE, NULL, NULL };
69 
70 void recinit(unsigned int n)
71 {
72 	if ( (record = (char *) malloc(n)) == NULL
73 	  || (fields = (char *) malloc(n+1)) == NULL
74 	  || (fldtab = (Cell **) calloc(nfields+2, sizeof(*fldtab))) == NULL
75 	  || (fldtab[0] = (Cell *) malloc(sizeof(**fldtab))) == NULL)
76 		FATAL("out of space for $0 and fields");
77 	*record = '\0';
78 	*fldtab[0] = dollar0;
79 	fldtab[0]->sval = record;
80 	fldtab[0]->nval = tostring("0");
81 	makefields(1, nfields);
82 	inputFS = strdup("");
83 }
84 
85 void makefields(int n1, int n2)		/* create $n1..$n2 inclusive */
86 {
87 	char temp[50];
88 	int i;
89 
90 	for (i = n1; i <= n2; i++) {
91 		fldtab[i] = (Cell *) malloc(sizeof(**fldtab));
92 		if (fldtab[i] == NULL)
93 			FATAL("out of space in makefields %d", i);
94 		*fldtab[i] = dollar1;
95 		snprintf(temp, sizeof(temp), "%d", i);
96 		fldtab[i]->nval = tostring(temp);
97 	}
98 }
99 
100 void initgetrec(void)
101 {
102 	int i;
103 	char *p;
104 
105 	for (i = 1; i < *ARGC; i++) {
106 		p = getargv(i); /* find 1st real filename */
107 		if (p == NULL || *p == '\0') {  /* deleted or zapped */
108 			argno++;
109 			continue;
110 		}
111 		if (!isclvar(p)) {
112 			setsval(lookup("FILENAME", symtab), p);
113 			return;
114 		}
115 		setclvar(p);	/* a commandline assignment before filename */
116 		argno++;
117 	}
118 	infile = stdin;		/* no filenames, so use stdin */
119 	innew = true;
120 }
121 
122 /*
123  * POSIX specifies that fields are supposed to be evaluated as if they were
124  * split using the value of FS at the time that the record's value ($0) was
125  * read.
126  *
127  * Since field-splitting is done lazily, we save the current value of FS
128  * whenever a new record is read in (implicitly or via getline), or when
129  * a new value is assigned to $0.
130  */
131 void savefs(void)
132 {
133 	size_t len;
134 	if ((len = strlen(getsval(fsloc))) < len_inputFS) {
135 		strcpy(inputFS, *FS);	/* for subsequent field splitting */
136 		return;
137 	}
138 
139 	len_inputFS = len + 1;
140 	inputFS = (char *) realloc(inputFS, len_inputFS);
141 	if (inputFS == NULL)
142 		FATAL("field separator %.10s... is too long", *FS);
143 	memcpy(inputFS, *FS, len_inputFS);
144 }
145 
146 static bool firsttime = true;
147 
148 int getrec(char **pbuf, int *pbufsize, bool isrecord)	/* get next input record */
149 {			/* note: cares whether buf == record */
150 	int c;
151 	char *buf = *pbuf;
152 	uschar saveb0;
153 	int bufsize = *pbufsize, savebufsize = bufsize;
154 
155 	if (firsttime) {
156 		firsttime = false;
157 		initgetrec();
158 	}
159 	DPRINTF("RS=<%s>, FS=<%s>, ARGC=%g, FILENAME=%s\n",
160 		*RS, *FS, *ARGC, *FILENAME);
161 	saveb0 = buf[0];
162 	buf[0] = 0;
163 	while (argno < *ARGC || infile == stdin) {
164 		DPRINTF("argno=%d, file=|%s|\n", argno, file);
165 		if (infile == NULL) {	/* have to open a new file */
166 			file = getargv(argno);
167 			if (file == NULL || *file == '\0') {	/* deleted or zapped */
168 				argno++;
169 				continue;
170 			}
171 			if (isclvar(file)) {	/* a var=value arg */
172 				setclvar(file);
173 				argno++;
174 				continue;
175 			}
176 			*FILENAME = file;
177 			DPRINTF("opening file %s\n", file);
178 			if (*file == '-' && *(file+1) == '\0')
179 				infile = stdin;
180 			else if ((infile = fopen(file, "r")) == NULL)
181 				FATAL("can't open file %s", file);
182 			innew = true;
183 			setfval(fnrloc, 0.0);
184 		}
185 		c = readrec(&buf, &bufsize, infile, innew);
186 		if (innew)
187 			innew = false;
188 		if (c != 0 || buf[0] != '\0') {	/* normal record */
189 			if (isrecord) {
190 				if (freeable(fldtab[0]))
191 					xfree(fldtab[0]->sval);
192 				fldtab[0]->sval = buf;	/* buf == record */
193 				fldtab[0]->tval = REC | STR | DONTFREE;
194 				check_number(fldtab[0]);
195 				donefld = false;
196 				donerec = true;
197 				savefs();
198 			}
199 			setfval(nrloc, nrloc->fval+1);
200 			setfval(fnrloc, fnrloc->fval+1);
201 			*pbuf = buf;
202 			*pbufsize = bufsize;
203 			return 1;
204 		}
205 		/* EOF arrived on this file; set up next */
206 		if (infile != stdin)
207 			fclose(infile);
208 		infile = NULL;
209 		argno++;
210 	}
211 	buf[0] = saveb0;
212 	*pbuf = buf;
213 	*pbufsize = savebufsize;
214 	return 0;	/* true end of file */
215 }
216 
217 void nextfile(void)
218 {
219 	if (infile != NULL && infile != stdin)
220 		fclose(infile);
221 	infile = NULL;
222 	argno++;
223 }
224 
225 extern int readcsvrec(char **pbuf, int *pbufsize, FILE *inf, bool newflag);
226 
227 int readrec(char **pbuf, int *pbufsize, FILE *inf, bool newflag)	/* read one record into buf */
228 {
229 	int sep, c, isrec; // POTENTIAL BUG? isrec is a macro in awk.h
230 	char *rr = *pbuf, *buf = *pbuf;
231 	int bufsize = *pbufsize;
232 	char *rs = getsval(rsloc);
233 
234 	if (CSV) {
235 		c = readcsvrec(&buf, &bufsize, inf, newflag);
236 		isrec = (c == EOF && rr == buf) ? false : true;
237 	} else if (*rs && rs[1]) {
238 		bool found;
239 
240 		memset(buf, 0, bufsize);
241 		fa *pfa = makedfa(rs, 1);
242 		if (newflag)
243 			found = fnematch(pfa, inf, &buf, &bufsize, recsize);
244 		else {
245 			int tempstat = pfa->initstat;
246 			pfa->initstat = 2;
247 			found = fnematch(pfa, inf, &buf, &bufsize, recsize);
248 			pfa->initstat = tempstat;
249 		}
250 		if (found)
251 			setptr(patbeg, '\0');
252 		isrec = found != 0 || *buf != '\0';
253 
254 	} else {
255 		if ((sep = *rs) == 0) {
256 			sep = '\n';
257 			while ((c=getc(inf)) == '\n' && c != EOF)	/* skip leading \n's */
258 				;
259 			if (c != EOF)
260 				ungetc(c, inf);
261 		}
262 		for (rr = buf; ; ) {
263 			for (; (c=getc(inf)) != sep && c != EOF; ) {
264 				if (rr-buf+1 > bufsize)
265 					if (!adjbuf(&buf, &bufsize, 1+rr-buf,
266 					    recsize, &rr, "readrec 1"))
267 						FATAL("input record `%.30s...' too long", buf);
268 				*rr++ = c;
269 			}
270 			if (*rs == sep || c == EOF)
271 				break;
272 			if ((c = getc(inf)) == '\n' || c == EOF)	/* 2 in a row */
273 				break;
274 			if (!adjbuf(&buf, &bufsize, 2+rr-buf, recsize, &rr,
275 			    "readrec 2"))
276 				FATAL("input record `%.30s...' too long", buf);
277 			*rr++ = '\n';
278 			*rr++ = c;
279 		}
280 		if (!adjbuf(&buf, &bufsize, 1+rr-buf, recsize, &rr, "readrec 3"))
281 			FATAL("input record `%.30s...' too long", buf);
282 		*rr = 0;
283 		isrec = c != EOF || rr != buf;
284 	}
285 	*pbuf = buf;
286 	*pbufsize = bufsize;
287 	DPRINTF("readrec saw <%s>, returns %d\n", buf, isrec);
288 	return isrec;
289 }
290 
291 
292 /*******************
293  * loose ends here:
294  *   \r\n should become \n
295  *   what about bare \r?  Excel uses that for embedded newlines
296  *   can't have "" in unquoted fields, according to RFC 4180
297 */
298 
299 
300 int readcsvrec(char **pbuf, int *pbufsize, FILE *inf, bool newflag) /* csv can have \n's */
301 {			/* so read a complete record that might be multiple lines */
302 	int sep, c;
303 	char *rr = *pbuf, *buf = *pbuf;
304 	int bufsize = *pbufsize;
305 	bool in_quote = false;
306 
307 	sep = '\n'; /* the only separator; have to skip over \n embedded in "..." */
308 	rr = buf;
309 	while ((c = getc(inf)) != EOF) {
310 		if (c == sep) {
311 			if (! in_quote)
312 				break;
313 			if (rr > buf && rr[-1] == '\r')	// remove \r if was \r\n
314 				rr--;
315 		}
316 
317 		if (rr-buf+1 > bufsize)
318 			if (!adjbuf(&buf, &bufsize, 1+rr-buf,
319 			    recsize, &rr, "readcsvrec 1"))
320 				FATAL("input record `%.30s...' too long", buf);
321 		*rr++ = c;
322 		if (c == '"')
323 			in_quote = ! in_quote;
324  	}
325 	if (c == '\n' && rr > buf && rr[-1] == '\r') 	// remove \r if was \r\n
326 		rr--;
327 
328 	if (!adjbuf(&buf, &bufsize, 1+rr-buf, recsize, &rr, "readcsvrec 4"))
329 		FATAL("input record `%.30s...' too long", buf);
330 	*rr = 0;
331 	*pbuf = buf;
332 	*pbufsize = bufsize;
333 	DPRINTF("readcsvrec saw <%s>, returns %d\n", buf, c);
334 	return c;
335 }
336 
337 char *getargv(int n)	/* get ARGV[n] */
338 {
339 	Array *ap;
340 	Cell *x;
341 	char *s, temp[50];
342 	extern Cell *ARGVcell;
343 
344 	ap = (Array *)ARGVcell->sval;
345 	snprintf(temp, sizeof(temp), "%d", n);
346 	if (lookup(temp, ap) == NULL)
347 		return NULL;
348 	x = setsymtab(temp, "", 0.0, STR, ap);
349 	s = getsval(x);
350 	DPRINTF("getargv(%d) returns |%s|\n", n, s);
351 	return s;
352 }
353 
354 void setclvar(char *s)	/* set var=value from s */
355 {
356 	char *e, *p;
357 	Cell *q;
358 
359 /* commit f3d9187d4e0f02294fb1b0e31152070506314e67 broke T.argv test */
360 /* I don't understand why it was changed. */
361 
362 	for (p=s; *p != '='; p++)
363 		;
364 	e = p;
365 	*p++ = 0;
366 	p = qstring(p, '\0');
367 	q = setsymtab(s, p, 0.0, STR, symtab);
368 	setsval(q, p);
369 	check_number(q);
370 	DPRINTF("command line set %s to |%s|\n", s, p);
371 	free(p);
372 	*e = '=';
373 }
374 
375 
376 void fldbld(void)	/* create fields from current record */
377 {
378 	/* this relies on having fields[] the same length as $0 */
379 	/* the fields are all stored in this one array with \0's */
380 	/* possibly with a final trailing \0 not associated with any field */
381 	char *r, *fr, sep;
382 	Cell *p;
383 	int i, j, n;
384 
385 	if (donefld)
386 		return;
387 	if (!isstr(fldtab[0]))
388 		getsval(fldtab[0]);
389 	r = fldtab[0]->sval;
390 	n = strlen(r);
391 	if (n > fieldssize) {
392 		xfree(fields);
393 		if ((fields = (char *) malloc(n+2)) == NULL) /* possibly 2 final \0s */
394 			FATAL("out of space for fields in fldbld %d", n);
395 		fieldssize = n;
396 	}
397 	fr = fields;
398 	i = 0;	/* number of fields accumulated here */
399 	if (inputFS == NULL)	/* make sure we have a copy of FS */
400 		savefs();
401 	if (!CSV && strlen(inputFS) > 1) {	/* it's a regular expression */
402 		i = refldbld(r, inputFS);
403 	} else if (!CSV && (sep = *inputFS) == ' ') {	/* default whitespace */
404 		for (i = 0; ; ) {
405 			while (*r == ' ' || *r == '\t' || *r == '\n')
406 				r++;
407 			if (*r == 0)
408 				break;
409 			i++;
410 			if (i > nfields)
411 				growfldtab(i);
412 			if (freeable(fldtab[i]))
413 				xfree(fldtab[i]->sval);
414 			fldtab[i]->sval = fr;
415 			fldtab[i]->tval = FLD | STR | DONTFREE;
416 			do
417 				*fr++ = *r++;
418 			while (*r != ' ' && *r != '\t' && *r != '\n' && *r != '\0');
419 			*fr++ = 0;
420 		}
421 		*fr = 0;
422 	} else if (CSV) {	/* CSV processing.  no error handling */
423 		if (*r != 0) {
424 			for (;;) {
425 				i++;
426 				if (i > nfields)
427 					growfldtab(i);
428 				if (freeable(fldtab[i]))
429 					xfree(fldtab[i]->sval);
430 				fldtab[i]->sval = fr;
431 				fldtab[i]->tval = FLD | STR | DONTFREE;
432 				if (*r == '"' ) { /* start of "..." */
433 					for (r++ ; *r != '\0'; ) {
434 						if (*r == '"' && r[1] != '\0' && r[1] == '"') {
435 							r += 2; /* doubled quote */
436 							*fr++ = '"';
437 						} else if (*r == '"' && (r[1] == '\0' || r[1] == ',')) {
438 							r++; /* skip over closing quote */
439 							break;
440 						} else {
441 							*fr++ = *r++;
442 						}
443 					}
444 					*fr++ = 0;
445 				} else {	/* unquoted field */
446 					while (*r != ',' && *r != '\0')
447 						*fr++ = *r++;
448 					*fr++ = 0;
449 				}
450 				if (*r++ == 0)
451 					break;
452 
453 			}
454 		}
455 		*fr = 0;
456 	} else if ((sep = *inputFS) == 0) {	/* new: FS="" => 1 char/field */
457 		for (i = 0; *r != '\0'; ) {
458 			char buf[10];
459 			i++;
460 			if (i > nfields)
461 				growfldtab(i);
462 			if (freeable(fldtab[i]))
463 				xfree(fldtab[i]->sval);
464 			n = u8_nextlen(r);
465 			for (j = 0; j < n; j++)
466 				buf[j] = *r++;
467 			buf[j] = '\0';
468 			fldtab[i]->sval = tostring(buf);
469 			fldtab[i]->tval = FLD | STR;
470 		}
471 		*fr = 0;
472 	} else if (*r != 0) {	/* if 0, it's a null field */
473 		/* subtle case: if length(FS) == 1 && length(RS > 0)
474 		 * \n is NOT a field separator (cf awk book 61,84).
475 		 * this variable is tested in the inner while loop.
476 		 */
477 		int rtest = '\n';  /* normal case */
478 		if (strlen(*RS) > 0)
479 			rtest = '\0';
480 		for (;;) {
481 			i++;
482 			if (i > nfields)
483 				growfldtab(i);
484 			if (freeable(fldtab[i]))
485 				xfree(fldtab[i]->sval);
486 			fldtab[i]->sval = fr;
487 			fldtab[i]->tval = FLD | STR | DONTFREE;
488 			while (*r != sep && *r != rtest && *r != '\0')	/* \n is always a separator */
489 				*fr++ = *r++;
490 			*fr++ = 0;
491 			if (*r++ == 0)
492 				break;
493 		}
494 		*fr = 0;
495 	}
496 	if (i > nfields)
497 		FATAL("record `%.30s...' has too many fields; can't happen", r);
498 	cleanfld(i+1, lastfld);	/* clean out junk from previous record */
499 	lastfld = i;
500 	donefld = true;
501 	for (j = 1; j <= lastfld; j++) {
502 		p = fldtab[j];
503 		check_number(p);
504 	}
505 	setfval(nfloc, (Awkfloat) lastfld);
506 	donerec = true; /* restore */
507 	if (dbg) {
508 		for (j = 0; j <= lastfld; j++) {
509 			p = fldtab[j];
510 			printf("field %d (%s): |%s|\n", j, p->nval, p->sval);
511 		}
512 	}
513 }
514 
515 void cleanfld(int n1, int n2)	/* clean out fields n1 .. n2 inclusive */
516 {				/* nvals remain intact */
517 	Cell *p;
518 	int i;
519 
520 	for (i = n1; i <= n2; i++) {
521 		p = fldtab[i];
522 		if (freeable(p))
523 			xfree(p->sval);
524 		p->sval = EMPTY,
525 		p->tval = FLD | STR | DONTFREE;
526 	}
527 }
528 
529 void newfld(int n)	/* add field n after end of existing lastfld */
530 {
531 	if (n > nfields)
532 		growfldtab(n);
533 	cleanfld(lastfld+1, n);
534 	lastfld = n;
535 	setfval(nfloc, (Awkfloat) n);
536 }
537 
538 void setlastfld(int n)	/* set lastfld cleaning fldtab cells if necessary */
539 {
540 	if (n < 0)
541 		FATAL("cannot set NF to a negative value");
542 	if (n > nfields)
543 		growfldtab(n);
544 
545 	if (lastfld < n)
546 	    cleanfld(lastfld+1, n);
547 	else
548 	    cleanfld(n+1, lastfld);
549 
550 	lastfld = n;
551 }
552 
553 Cell *fieldadr(int n)	/* get nth field */
554 {
555 	if (n < 0)
556 		FATAL("trying to access out of range field %d", n);
557 	if (n > nfields)	/* fields after NF are empty */
558 		growfldtab(n);	/* but does not increase NF */
559 	return(fldtab[n]);
560 }
561 
562 void growfldtab(int n)	/* make new fields up to at least $n */
563 {
564 	int nf = 2 * nfields;
565 	size_t s;
566 
567 	if (n > nf)
568 		nf = n;
569 	s = (nf+1) * (sizeof (struct Cell *));  /* freebsd: how much do we need? */
570 	if (s / sizeof(struct Cell *) - 1 == (size_t)nf) /* didn't overflow */
571 		fldtab = realloc(fldtab, s);
572 	else					/* overflow sizeof int */
573 		xfree(fldtab);	/* make it null */
574 	if (fldtab == NULL)
575 		FATAL("out of space creating %d fields", nf);
576 	makefields(nfields+1, nf);
577 	nfields = nf;
578 }
579 
580 int refldbld(const char *rec, const char *fs)	/* build fields from reg expr in FS */
581 {
582 	/* this relies on having fields[] the same length as $0 */
583 	/* the fields are all stored in this one array with \0's */
584 	char *fr;
585 	int i, tempstat, n;
586 	fa *pfa;
587 
588 	n = strlen(rec);
589 	if (n > fieldssize) {
590 		xfree(fields);
591 		if ((fields = (char *) malloc(n+1)) == NULL)
592 			FATAL("out of space for fields in refldbld %d", n);
593 		fieldssize = n;
594 	}
595 	fr = fields;
596 	*fr = '\0';
597 	if (*rec == '\0')
598 		return 0;
599 	pfa = makedfa(fs, 1);
600 	DPRINTF("into refldbld, rec = <%s>, pat = <%s>\n", rec, fs);
601 	tempstat = pfa->initstat;
602 	for (i = 1; ; i++) {
603 		if (i > nfields)
604 			growfldtab(i);
605 		if (freeable(fldtab[i]))
606 			xfree(fldtab[i]->sval);
607 		fldtab[i]->tval = FLD | STR | DONTFREE;
608 		fldtab[i]->sval = fr;
609 		DPRINTF("refldbld: i=%d\n", i);
610 		if (nematch(pfa, rec)) {
611 			pfa->initstat = 2;	/* horrible coupling to b.c */
612 			DPRINTF("match %s (%d chars)\n", patbeg, patlen);
613 			strncpy(fr, rec, patbeg-rec);
614 			fr += patbeg - rec + 1;
615 			*(fr-1) = '\0';
616 			rec = patbeg + patlen;
617 		} else {
618 			DPRINTF("no match %s\n", rec);
619 			strcpy(fr, rec);
620 			pfa->initstat = tempstat;
621 			break;
622 		}
623 	}
624 	return i;
625 }
626 
627 void recbld(void)	/* create $0 from $1..$NF if necessary */
628 {
629 	int i;
630 	char *r, *p;
631 	char *sep = getsval(ofsloc);
632 
633 	if (donerec)
634 		return;
635 	r = record;
636 	for (i = 1; i <= *NF; i++) {
637 		p = getsval(fldtab[i]);
638 		if (!adjbuf(&record, &recsize, 1+strlen(p)+r-record, recsize, &r, "recbld 1"))
639 			FATAL("created $0 `%.30s...' too long", record);
640 		while ((*r = *p++) != 0)
641 			r++;
642 		if (i < *NF) {
643 			if (!adjbuf(&record, &recsize, 2+strlen(sep)+r-record, recsize, &r, "recbld 2"))
644 				FATAL("created $0 `%.30s...' too long", record);
645 			for (p = sep; (*r = *p++) != 0; )
646 				r++;
647 		}
648 	}
649 	if (!adjbuf(&record, &recsize, 2+r-record, recsize, &r, "recbld 3"))
650 		FATAL("built giant record `%.30s...'", record);
651 	*r = '\0';
652 	DPRINTF("in recbld inputFS=%s, fldtab[0]=%p\n", inputFS, (void*)fldtab[0]);
653 
654 	if (freeable(fldtab[0]))
655 		xfree(fldtab[0]->sval);
656 	fldtab[0]->tval = REC | STR | DONTFREE;
657 	fldtab[0]->sval = record;
658 
659 	DPRINTF("in recbld inputFS=%s, fldtab[0]=%p\n", inputFS, (void*)fldtab[0]);
660 	DPRINTF("recbld = |%s|\n", record);
661 	donerec = true;
662 }
663 
664 int	errorflag	= 0;
665 
666 void yyerror(const char *s)
667 {
668 	SYNTAX("%s", s);
669 }
670 
671 void SYNTAX(const char *fmt, ...)
672 {
673 	extern char *cmdname, *curfname;
674 	static int been_here = 0;
675 	va_list varg;
676 
677 	if (been_here++ > 2)
678 		return;
679 	fprintf(stderr, "%s: ", cmdname);
680 	va_start(varg, fmt);
681 	vfprintf(stderr, fmt, varg);
682 	va_end(varg);
683 	fprintf(stderr, " at source line %d", lineno);
684 	if (curfname != NULL)
685 		fprintf(stderr, " in function %s", curfname);
686 	if (compile_time == COMPILING && cursource() != NULL)
687 		fprintf(stderr, " source file %s", cursource());
688 	fprintf(stderr, "\n");
689 	errorflag = 2;
690 	eprint();
691 }
692 
693 extern int bracecnt, brackcnt, parencnt;
694 
695 void bracecheck(void)
696 {
697 	int c;
698 	static int beenhere = 0;
699 
700 	if (beenhere++)
701 		return;
702 	while ((c = input()) != EOF && c != '\0')
703 		bclass(c);
704 	bcheck2(bracecnt, '{', '}');
705 	bcheck2(brackcnt, '[', ']');
706 	bcheck2(parencnt, '(', ')');
707 }
708 
709 void bcheck2(int n, int c1, int c2)
710 {
711 	if (n == 1)
712 		fprintf(stderr, "\tmissing %c\n", c2);
713 	else if (n > 1)
714 		fprintf(stderr, "\t%d missing %c's\n", n, c2);
715 	else if (n == -1)
716 		fprintf(stderr, "\textra %c\n", c2);
717 	else if (n < -1)
718 		fprintf(stderr, "\t%d extra %c's\n", -n, c2);
719 }
720 
721 void FATAL(const char *fmt, ...)
722 {
723 	extern char *cmdname;
724 	va_list varg;
725 
726 	fflush(stdout);
727 	fprintf(stderr, "%s: ", cmdname);
728 	va_start(varg, fmt);
729 	vfprintf(stderr, fmt, varg);
730 	va_end(varg);
731 	error();
732 	if (dbg > 1)		/* core dump if serious debugging on */
733 		abort();
734 	exit(2);
735 }
736 
737 void WARNING(const char *fmt, ...)
738 {
739 	extern char *cmdname;
740 	va_list varg;
741 
742 	fflush(stdout);
743 	fprintf(stderr, "%s: ", cmdname);
744 	va_start(varg, fmt);
745 	vfprintf(stderr, fmt, varg);
746 	va_end(varg);
747 	error();
748 }
749 
750 void error()
751 {
752 	extern Node *curnode;
753 
754 	fprintf(stderr, "\n");
755 	if (compile_time != ERROR_PRINTING) {
756 		if (NR && *NR > 0) {
757 			fprintf(stderr, " input record number %d", (int) (*FNR));
758 			if (strcmp(*FILENAME, "-") != 0)
759 				fprintf(stderr, ", file %s", *FILENAME);
760 			fprintf(stderr, "\n");
761 		}
762 		if (curnode)
763 			fprintf(stderr, " source line number %d", curnode->lineno);
764 		else if (lineno)
765 			fprintf(stderr, " source line number %d", lineno);
766 		if (compile_time == COMPILING && cursource() != NULL)
767 			fprintf(stderr, " source file %s", cursource());
768 		fprintf(stderr, "\n");
769 		eprint();
770 	}
771 }
772 
773 void eprint(void)	/* try to print context around error */
774 {
775 	char *p, *q;
776 	int c;
777 	static int been_here = 0;
778 	extern char ebuf[], *ep;
779 
780 	if (compile_time != COMPILING || been_here++ > 0 || ebuf == ep)
781 		return;
782 	if (ebuf == ep)
783 		return;
784 	p = ep - 1;
785 	if (p > ebuf && *p == '\n')
786 		p--;
787 	for ( ; p > ebuf && *p != '\n' && *p != '\0'; p--)
788 		;
789 	while (*p == '\n')
790 		p++;
791 	fprintf(stderr, " context is\n\t");
792 	for (q=ep-1; q>=p && *q!=' ' && *q!='\t' && *q!='\n'; q--)
793 		;
794 	for ( ; p < q; p++)
795 		if (*p)
796 			putc(*p, stderr);
797 	fprintf(stderr, " >>> ");
798 	for ( ; p < ep; p++)
799 		if (*p)
800 			putc(*p, stderr);
801 	fprintf(stderr, " <<< ");
802 	if (*ep)
803 		while ((c = input()) != '\n' && c != '\0' && c != EOF) {
804 			putc(c, stderr);
805 			bclass(c);
806 		}
807 	putc('\n', stderr);
808 	ep = ebuf;
809 }
810 
811 void bclass(int c)
812 {
813 	switch (c) {
814 	case '{': bracecnt++; break;
815 	case '}': bracecnt--; break;
816 	case '[': brackcnt++; break;
817 	case ']': brackcnt--; break;
818 	case '(': parencnt++; break;
819 	case ')': parencnt--; break;
820 	}
821 }
822 
823 double errcheck(double x, const char *s)
824 {
825 
826 	if (errno == EDOM) {
827 		errno = 0;
828 		WARNING("%s argument out of domain", s);
829 		x = 1;
830 	} else if (errno == ERANGE) {
831 		errno = 0;
832 		WARNING("%s result out of range", s);
833 		x = 1;
834 	}
835 	return x;
836 }
837 
838 int isclvar(const char *s)	/* is s of form var=something ? */
839 {
840 	const char *os = s;
841 
842 	if (!isalpha((unsigned char) *s) && *s != '_')
843 		return 0;
844 	for ( ; *s; s++)
845 		if (!(isalnum((unsigned char) *s) || *s == '_'))
846 			break;
847 	return *s == '=' && s > os;
848 }
849 
850 /* strtod is supposed to be a proper test of what's a valid number */
851 /* appears to be broken in gcc on linux: thinks 0x123 is a valid FP number */
852 /* wrong: violates 4.10.1.4 of ansi C standard */
853 
854 /* well, not quite. As of C99, hex floating point is allowed. so this is
855  * a bit of a mess. We work around the mess by checking for a hexadecimal
856  * value and disallowing it. Similarly, we now follow gawk and allow only
857  * +nan, -nan, +inf, and -inf for NaN and infinity values.
858  */
859 
860 /*
861  * This routine now has a more complicated interface, the main point
862  * being to avoid the double conversion of a string to double, and
863  * also to convey out, if requested, the information that the numeric
864  * value was a leading string or is all of the string. The latter bit
865  * is used in getfval().
866  */
867 
868 bool is_valid_number(const char *s, bool trailing_stuff_ok,
869 			bool *no_trailing, double *result)
870 {
871 	double r;
872 	char *ep;
873 	bool retval = false;
874 	bool is_nan = false;
875 	bool is_inf = false;
876 
877 	if (no_trailing)
878 		*no_trailing = false;
879 
880 	while (isspace((unsigned char) *s))
881 		s++;
882 
883 	/* no hex floating point, sorry */
884 	if (s[0] == '0' && tolower((unsigned char) s[1]) == 'x')
885 		return false;
886 
887 	/* allow +nan, -nan, +inf, -inf, any other letter, no */
888 	if (s[0] == '+' || s[0] == '-') {
889 		is_nan = (strncasecmp(s+1, "nan", 3) == 0);
890 		is_inf = (strncasecmp(s+1, "inf", 3) == 0);
891 		if ((is_nan || is_inf)
892 		    && (isspace((unsigned char) s[4]) || s[4] == '\0'))
893 			goto convert;
894 		else if (! isdigit((unsigned char) s[1]) && s[1] != '.')
895 			return false;
896 	}
897 	else if (! isdigit((unsigned char) s[0]) && s[0] != '.')
898 		return false;
899 
900 convert:
901 	errno = 0;
902 	r = strtod(s, &ep);
903 	if (ep == s || errno == ERANGE)
904 		return false;
905 
906 	if (isnan(r) && s[0] == '-' && signbit(r) == 0)
907 		r = -r;
908 
909 	if (result != NULL)
910 		*result = r;
911 
912 	/*
913 	 * check for trailing stuff
914 	 */
915 	while (isspace((unsigned char) *ep))
916 		ep++;
917 
918 	if (no_trailing != NULL)
919 		*no_trailing = (*ep == '\0');
920 
921         /* return true if found the end, or trailing stuff is allowed */
922 	retval = *ep == '\0' || trailing_stuff_ok;
923 
924 	return retval;
925 }
926 
927 void check_number(Cell *x)
928 {
929 	if (is_valid_number(x->sval, false, NULL, &x->fval))
930 		x->tval |= NUM;
931 }
932