1 /*
2  * builtin.c - Builtin functions and various utility procedures
3  */
4 
5 /*
6  * Copyright (C) 1986, 1988, 1989, 1991-2000 the Free Software Foundation, Inc.
7  *
8  * This file is part of GAWK, the GNU implementation of the
9  * AWK Programming Language.
10  *
11  * GAWK is free software; you can redistribute it and/or modify
12  * it under the terms of the GNU General Public License as published by
13  * the Free Software Foundation; either version 2 of the License, or
14  * (at your option) any later version.
15  *
16  * GAWK is distributed in the hope that it will be useful,
17  * but WITHOUT ANY WARRANTY; without even the implied warranty of
18  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19  * GNU General Public License for more details.
20  *
21  * You should have received a copy of the GNU General Public License
22  * along with this program; if not, write to the Free Software
23  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
24  */
25 /* Multi-byte extension added May, 1993 by t^2 (Takahiro Tanimoto)
26    Last change: Jun 15, 1997 by okabe katsuyuki */
27 
28 /* Modified for Human68k by K.Murakami 1993.06.01
29    Last change: Feb. 3, 1997 by okabe katsuyuki */
30 
31 #include "awk.h"
32 #undef HUGE
33 #undef CHARBITS
34 #undef INTBITS
35 #include <math.h>
36 #include "random.h"
37 
38 #ifdef __human68k__
39 #define system(cmd) ({ int _rc = system((cmd)); _rc < 0 ? 0xff00 : (_rc << 8) & 0xff00 ; })
40 #else
41 #if defined(MSDOS) && !defined(__EMX__)
42 extern int xsystem P((char *));
43 #define system(cmd) xsystem((cmd))
44 #endif
45 #endif
46 
47 /* can declare these, since we always use the random shipped with gawk */
48 extern char *initstate P((unsigned seed, char *state, int n));
49 extern char *setstate P((char *state));
50 extern long random P((void));
51 extern void srandom P((unsigned int seed));
52 
53 extern NODE **fields_arr;
54 extern int output_is_tty;
55 
56 static NODE *sub_common P((NODE *tree, int how_many, int backdigs));
57 NODE *format_tree P((const char *, int, NODE *));
58 
59 #ifdef _CRAY
60 /* Work around a problem in conversion of doubles to exact integers. */
61 #include <float.h>
62 #define Floor(n) floor((n) * (1.0 + DBL_EPSILON))
63 #define Ceil(n) ceil((n) * (1.0 + DBL_EPSILON))
64 
65 /* Force the standard C compiler to use the library math functions. */
66 extern double exp(double);
67 double (*Exp)() = exp;
68 #define exp(x) (*Exp)(x)
69 extern double log(double);
70 double (*Log)() = log;
71 #define log(x) (*Log)(x)
72 #else
73 #define Floor(n) floor(n)
74 #define Ceil(n) ceil(n)
75 #endif
76 
77 #define DEFAULT_G_PRECISION 6
78 
79 #ifdef GFMT_WORKAROUND
80 /* semi-temporary hack, mostly to gracefully handle VMS */
81 static void sgfmt P((char *buf, const char *format, int alt,
82 		     int fwidth, int precision, double value));
83 #endif /* GFMT_WORKAROUND */
84 
85 /*
86  * Since we supply the version of random(), we know what
87  * value to use here.
88  */
89 #define GAWK_RANDOM_MAX 0x7fffffffL
90 
91 static void efwrite P((const void *ptr, size_t size, size_t count, FILE *fp,
92 		       const char *from, struct redirect *rp, int flush));
93 
94 /* efwrite --- like fwrite, but with error checking */
95 
96 static void
efwrite(ptr,size,count,fp,from,rp,flush)97 efwrite(ptr, size, count, fp, from, rp, flush)
98 const void *ptr;
99 size_t size, count;
100 FILE *fp;
101 const char *from;
102 struct redirect *rp;
103 int flush;
104 {
105 	errno = 0;
106 	if (fwrite(ptr, size, count, fp) != count)
107 		goto wrerror;
108 	if (flush
109 	  && ((fp == stdout && output_is_tty)
110 	   || (rp && (rp->flag & RED_NOBUF)))) {
111 		fflush(fp);
112 		if (ferror(fp))
113 			goto wrerror;
114 	}
115 	return;
116 
117 wrerror:
118 	fatal("%s to \"%s\" failed (%s)", from,
119 		rp ? rp->value : "standard output",
120 		errno ? strerror(errno) : "reason unknown");
121 }
122 
123 /* do_exp --- exponential function */
124 
125 NODE *
do_exp(tree)126 do_exp(tree)
127 NODE *tree;
128 {
129 	NODE *tmp;
130 	double d, res;
131 
132 	tmp = tree_eval(tree->lnode);
133 	d = force_number(tmp);
134 	free_temp(tmp);
135 	errno = 0;
136 	res = exp(d);
137 	if (errno == ERANGE)
138 		warning("exp argument %g is out of range", d);
139 	return tmp_number((AWKNUM) res);
140 }
141 
142 /* stdfile --- return fp for a standard file */
143 
144 /*
145  * This function allows `fflush("/dev/stdout")' to work.
146  * The other files will be available via getredirect().
147  * /dev/stdin is not included, since fflush is only for output.
148  */
149 
150 static FILE *
stdfile(name,len)151 stdfile(name, len)
152 char *name;
153 size_t len;
154 {
155 	if (len == 11) {
156 		if (STREQN(name, "/dev/stderr", 11))
157 			return stderr;
158 		else if (STREQN(name, "/dev/stdout", 11))
159 			return stdout;
160 	}
161 
162 	return NULL;
163 }
164 
165 /* do_fflush --- flush output, either named file or pipe or everything */
166 
167 NODE *
do_fflush(tree)168 do_fflush(tree)
169 NODE *tree;
170 {
171 	struct redirect *rp;
172 	NODE *tmp;
173 	FILE *fp;
174 	int status = 0;
175 	char *file;
176 
177 	/* fflush() --- flush stdout */
178 	if (tree == NULL) {
179 		status = fflush(stdout);
180 		return tmp_number((AWKNUM) status);
181 	}
182 
183 	tmp = tree_eval(tree->lnode);
184 	tmp = force_string(tmp);
185 	file = tmp->stptr;
186 
187 	/* fflush("") --- flush all */
188 	if (tmp->stlen == 0) {
189 		status = flush_io();
190 		free_temp(tmp);
191 		return tmp_number((AWKNUM) status);
192 	}
193 
194 	rp = getredirect(tmp->stptr, tmp->stlen);
195 	status = 1;
196 	if (rp != NULL) {
197 		if ((rp->flag & (RED_WRITE|RED_APPEND)) == 0) {
198 			/* if (do_lint) */
199 				warning(
200 		"fflush: cannot flush: %s `%s' opened for reading, not writing",
201 				(rp->flag & RED_PIPE) ? "pipe" : "file",
202 				file);
203 			free_temp(tmp);
204 			return tmp_number((AWKNUM) status);
205 		}
206 		fp = rp->fp;
207 		if (fp != NULL)
208 			status = fflush(fp);
209 	} else if ((fp = stdfile(tmp->stptr, tmp->stlen)) != NULL) {
210 		status = fflush(fp);
211 	} else
212 		warning("fflush: `%s' is not an open file or pipe", file);
213 	free_temp(tmp);
214 	return tmp_number((AWKNUM) status);
215 }
216 
217 /* do_index --- find index of a string */
218 
219 NODE *
do_index(tree)220 do_index(tree)
221 NODE *tree;
222 {
223 	NODE *s1, *s2;
224 	register char *p1, *p2;
225 	register size_t l1, l2;
226 	long ret;
227 	int mbf;
228 	size_t skip;
229 
230 
231 	s1 = tree_eval(tree->lnode);
232 	s2 = tree_eval(tree->rnode->lnode);
233 	force_string(s1);
234 	force_string(s2);
235 	p1 = s1->stptr;
236 	p2 = s2->stptr;
237 	l1 = s1->stlen;
238 	l2 = s2->stlen;
239 	ret = 0;
240 
241 	/* IGNORECASE will already be false if posix */
242 	if (IGNORECASE) {
243 		while (l1 > 0) {
244 			if (l2 > l1)
245 				break;
246 			if (((mbf = ismbchar(*p1)) != 0
247 			     ? *p1 == *p2
248 			     : (casetable[(unsigned char) *p1]
249 				== casetable[(unsigned char) *p2]))
250 			    && (l2 == 1 || mbstrncasecmp(p1, p2, l2) == 0)) {
251 				ret = 1 + s1->stlen - l1;
252 				break;
253 			}
254 			if (mbf) {
255 				skip = mbclen(*p1) - 1;
256 				if (l1 <= skip)
257 					break;
258 				l1 -= skip;
259 				p1 += skip;
260 			}
261 			l1--;
262 			p1++;
263 		}
264 	} else {
265 		while (l1 > 0) {
266 			if (l2 > l1)
267 				break;
268 			if (*p1 == *p2
269 			    && (l2 == 1 || STREQN(p1, p2, l2))) {
270 				ret = 1 + s1->stlen - l1;
271 				break;
272 			}
273 			if (ismbchar(*p1)) {
274 				skip = mbclen(*p1) - 1;
275 				if (l1 <= skip)
276 					break;
277 				l1 -= skip;
278 				p1 += skip;
279 			}
280 			l1--;
281 			p1++;
282 		}
283 	}
284 	free_temp(s1);
285 	free_temp(s2);
286 	return tmp_number((AWKNUM) ret);
287 }
288 
289 /* do_jindex --- find index of a multi-byte string */
290 
291 NODE *
do_jindex(tree)292 do_jindex(tree)
293 NODE *tree;
294 {
295 	NODE *s1, *s2;
296 	register char *p1, *p2;
297 	register size_t l1, l2;
298 	long ret;
299 	int mbf;
300 	size_t skip;
301 
302 	s1 = tree_eval(tree->lnode);
303 	s2 = tree_eval(tree->rnode->lnode);
304 	force_string(s1);
305 	force_string(s2);
306 	p1 = s1->stptr;
307 	p2 = s2->stptr;
308 	l1 = s1->stlen;
309 	l2 = s2->stlen;
310 	ret = 1;
311 	if (IGNORECASE) {
312 		while (l1 > 0) {
313 			if (l2 > l1)
314 				break;
315 			if (((mbf = ismbchar(*p1)) != 0
316 			     ? *p1 == *p2
317 			     : (casetable[(unsigned char) *p1]
318 				== casetable[(unsigned char) *p2]))
319 			    && (l2 == 1 || mbstrncasecmp(p1, p2, l2) == 0)) {
320 				goto found;
321 			}
322 			if (mbf) {
323 				skip = mbclen(*p1) - 1;
324 				if (l1 <= skip)
325 					break;
326 				l1 -= skip;
327 				p1 += skip;
328 			}
329 			l1--;
330 			p1++;
331 			ret++;
332 		}
333 	} else {
334 		while (l1 > 0) {
335 			if (l2 > l1)
336 				break;
337 			if (*p1 == *p2
338 			    && (l2 == 1 || STREQN(p1, p2, l2))) {
339 				goto found;
340 			}
341 			if (ismbchar(*p1)) {
342 				skip = mbclen(*p1) - 1;
343 				if (l1 <= skip)
344 					break;
345 				l1 -= skip;
346 				p1 += skip;
347 			}
348 			l1--;
349 			p1++;
350 			ret++;
351 		}
352 	}
353 	ret = 0;
354 found:
355 	free_temp(s1);
356 	free_temp(s2);
357 	return tmp_number((AWKNUM) ret);
358 }
359 
360 /* double_to_int --- convert double to int, used several places */
361 
362 double
double_to_int(d)363 double_to_int(d)
364 double d;
365 {
366 	if (d >= 0)
367 		d = Floor(d);
368 	else
369 		d = Ceil(d);
370 	return d;
371 }
372 
373 /* do_int --- convert double to int for awk */
374 
375 NODE *
do_int(tree)376 do_int(tree)
377 NODE *tree;
378 {
379 	NODE *tmp;
380 	double d;
381 
382 	tmp = tree_eval(tree->lnode);
383 	d = force_number(tmp);
384 	d = double_to_int(d);
385 	free_temp(tmp);
386 	return tmp_number((AWKNUM) d);
387 }
388 
389 /* do_length --- length of a string or $0 */
390 
391 NODE *
do_length(tree)392 do_length(tree)
393 NODE *tree;
394 {
395 	NODE *tmp;
396 	size_t len;
397 
398 	tmp = tree_eval(tree->lnode);
399 	len = force_string(tmp)->stlen;
400 	free_temp(tmp);
401 	return tmp_number((AWKNUM) len);
402 }
403 
404 /* do_jlength --- length of a multi-byte string or $0 */
405 
406 NODE *
do_jlength(tree)407 do_jlength(tree)
408 NODE *tree;
409 {
410 	NODE *tmp;
411 	size_t len;
412 
413 	tmp = tree_eval(tree->lnode);
414 	(void) force_string(tmp);
415 	len = mblength(tmp->stptr, tmp->stlen);
416 	free_temp(tmp);
417 	return tmp_number((AWKNUM) len);
418 }
419 
420 /* do_log --- the log function */
421 
422 NODE *
do_log(tree)423 do_log(tree)
424 NODE *tree;
425 {
426 	NODE *tmp;
427 	double d, arg;
428 
429 	tmp = tree_eval(tree->lnode);
430 	arg = (double) force_number(tmp);
431 	if (arg < 0.0)
432 		warning("log called with negative argument %g", arg);
433 	d = log(arg);
434 	free_temp(tmp);
435 	return tmp_number((AWKNUM) d);
436 }
437 
438 /*
439  * format_tree() formats nodes of a tree, starting with a left node,
440  * and accordingly to a fmt_string providing a format like in
441  * printf family from C library.  Returns a string node which value
442  * is a formatted string.  Called by  sprintf function.
443  *
444  * It is one of the uglier parts of gawk.  Thanks to Michal Jaegermann
445  * for taming this beast and making it compatible with ANSI C.
446  */
447 
448 NODE *
format_tree(fmt_string,n0,carg)449 format_tree(fmt_string, n0, carg)
450 const char *fmt_string;
451 int n0;
452 register NODE *carg;
453 {
454 #if (defined (_MSC_VER) || defined (__TURBOC__)) && !defined (WIN32)
455 #define allocate_space(minsiz) do { \
456 	size_t nsiz = osiz * 2; \
457 	if (nsiz > INT_MAX) { \
458 		nsiz = INT_MAX; \
459 		if (nsiz - osiz < (minsiz)) \
460 			fatal("format_tree: string too long"); \
461 	} \
462 	erealloc(obuf, char *, nsiz, "format_tree"); \
463 	ofre += nsiz - osiz; \
464 	osiz += nsiz - osiz; \
465 } while (0)
466 #else
467 #define allocate_space(minsiz) do { \
468 	erealloc(obuf, char *, osiz * 2, "format_tree"); \
469 	ofre += osiz; \
470 	osiz *= 2; \
471 } while (0)
472 #endif
473 
474 /* copy 'l' bytes from 's' to 'obufout' checking for space in the process */
475 /* difference of pointers should be of ptrdiff_t type, but let us be kind */
476 #define bchunk(s, l) if (l) { \
477 	while ((l) > ofre) { \
478 		long olen = obufout - obuf; \
479 		allocate_space((l)); \
480 		obufout = obuf + olen; \
481 	} \
482 	memcpy(obufout, s, (size_t) (l)); \
483 	obufout += (l); \
484 	ofre -= (l); \
485 }
486 
487 /* copy one byte from 's' to 'obufout' checking for space in the process */
488 #define bchunk_one(s) { \
489 	if (ofre <= 0) { \
490 		long olen = obufout - obuf; \
491 		allocate_space(1); \
492 		obufout = obuf + olen; \
493 	} \
494 	*obufout++ = *s; \
495 	--ofre; \
496 }
497 
498 /* Is there space for something L big in the buffer? */
499 #define chksize(l)  if ((l) > ofre) { \
500 	long olen = obufout - obuf; \
501 	allocate_space((l)); \
502 	obufout = obuf + olen; \
503 }
504 
505 /*
506  * Get the next arg to be formatted.  If we've run out of args,
507  * return "" (Null string)
508  */
509 #define parse_next_arg() { \
510 	if (carg == NULL) { \
511 		toofew = TRUE; \
512 		break; \
513 	} else { \
514 		arg = tree_eval(carg->lnode); \
515 		carg = carg->rnode; \
516 	} \
517 }
518 
519 	NODE *r;
520 	int toofew = FALSE;
521 	char *obuf, *obufout;
522 	size_t osiz, ofre;
523 	char *chbuf;
524 	const char *s0, *s1;
525 	int cs1;
526 	NODE *arg;
527 	long fw, prec;
528 	int lj, alt, big, bigbig, small, have_prec, need_format;
529 	long *cur = NULL;
530 #ifdef sun386		/* Can't cast unsigned (int/long) from ptr->value */
531 	long tmp_uval;	/* on 386i 4.0.1 C compiler -- it just hangs */
532 #endif
533 	unsigned long uval;
534 	int sgn;
535 	int base = 0;
536 	char cpbuf[30];		/* if we have numbers bigger than 30 */
537 	char *cend = &cpbuf[30];/* chars, we lose, but seems unlikely */
538 	char *cp;
539 	char *fill;
540 	double tmpval;
541 	char signchar = FALSE;
542 	size_t len;
543 	size_t skip;
544 	int zero_flag = FALSE;
545 	static char sp[] = " ";
546 	static char zero_string[] = "0";
547 	static char lchbuf[] = "0123456789abcdef";
548 	static char Uchbuf[] = "0123456789ABCDEF";
549 
550 #define INITIAL_OUT_SIZE	512
551 	emalloc(obuf, char *, INITIAL_OUT_SIZE, "format_tree");
552 	obufout = obuf;
553 	osiz = INITIAL_OUT_SIZE;
554 	ofre = osiz - 1;
555 
556 	need_format = FALSE;
557 
558 	s0 = s1 = fmt_string;
559 	while (n0-- > 0) {
560 #if 1 /* EUC �� Shift-JIS �Ǥ�ɬ�פʤ��Ȼפ���ǰ�Τ���.  */
561 		if (ismbchar(*s1)) {
562 			skip = mbclen(*s1) - 1;
563 			if (n0 < skip)
564 				break;
565 			n0 -= skip;
566 			s1 += skip + 1;
567 			continue;
568 		}
569 #endif
570 		if (*s1 != '%') {
571 			s1++;
572 			continue;
573 		}
574 		need_format = TRUE;
575 		bchunk(s0, s1 - s0);
576 		s0 = s1;
577 		cur = &fw;
578 		fw = 0;
579 		prec = 0;
580 		have_prec = FALSE;
581 		signchar = FALSE;
582 		zero_flag = FALSE;
583 		lj = alt = big = bigbig = small = FALSE;
584 		fill = sp;
585 		cp = cend;
586 		chbuf = lchbuf;
587 		s1++;
588 
589 retry:
590 		if (n0-- <= 0)	/* ran out early! */
591 			break;
592 
593 		switch (cs1 = (unsigned char) *s1++) {
594 		case (-1):	/* dummy case to allow for checking */
595 check_pos:
596 			if (cur != &fw)
597 				break;		/* reject as a valid format */
598 			goto retry;
599 		case '%':
600 			need_format = FALSE;
601 			bchunk_one("%");
602 			s0 = s1;
603 			break;
604 
605 		case '0':
606 			/*
607 			 * Only turn on zero_flag if we haven't seen
608 			 * the field width or precision yet.  Otherwise,
609 			 * screws up floating point formatting.
610 			 */
611 			if (cur == & fw)
612 				zero_flag = TRUE;
613 			if (lj)
614 				goto retry;
615 			/* FALL through */
616 		case '1':
617 		case '2':
618 		case '3':
619 		case '4':
620 		case '5':
621 		case '6':
622 		case '7':
623 		case '8':
624 		case '9':
625 			if (cur == NULL)
626 				break;
627 			if (prec >= 0)
628 				*cur = cs1 - '0';
629 			/*
630 			 * with a negative precision *cur is already set
631 			 * to -1, so it will remain negative, but we have
632 			 * to "eat" precision digits in any case
633 			 */
634 			while (n0 > 0 && *s1 >= '0' && *s1 <= '9') {
635 				--n0;
636 				*cur = *cur * 10 + *s1++ - '0';
637 			}
638 			if (prec < 0) 	/* negative precision is discarded */
639 				have_prec = FALSE;
640 			if (cur == &prec)
641 				cur = NULL;
642 			if (n0 == 0)	/* badly formatted control string */
643 				continue;
644 			goto retry;
645 		case '*':
646 			if (cur == NULL)
647 				break;
648 			parse_next_arg();
649 			*cur = force_number(arg);
650 			free_temp(arg);
651 			if (*cur < 0 && cur == &fw) {
652 				*cur = -*cur;
653 				lj++;
654 			}
655 			if (cur == &prec) {
656 				if (*cur >= 0)
657 					have_prec = TRUE;
658 				else
659 					have_prec = FALSE;
660 				cur = NULL;
661 			}
662 			goto retry;
663 		case ' ':		/* print ' ' or '-' */
664 					/* 'space' flag is ignored */
665 					/* if '+' already present  */
666 			if (signchar != FALSE)
667 				goto check_pos;
668 			/* FALL THROUGH */
669 		case '+':		/* print '+' or '-' */
670 			signchar = cs1;
671 			goto check_pos;
672 		case '-':
673 			if (prec < 0)
674 				break;
675 			if (cur == &prec) {
676 				prec = -1;
677 				goto retry;
678 			}
679 			fill = sp;      /* if left justified then other */
680 			lj++; 		/* filling is ignored */
681 			goto check_pos;
682 		case '.':
683 			if (cur != &fw)
684 				break;
685 			cur = &prec;
686 			have_prec = TRUE;
687 			goto retry;
688 		case '#':
689 			alt = TRUE;
690 			goto check_pos;
691 		case 'l':
692 			if (big)
693 				break;
694 			else {
695 				static int warned = FALSE;
696 
697 				if (do_lint && ! warned) {
698 					warning("`l' is meaningless in awk formats; ignored");
699 					warned = TRUE;
700 				}
701 				if (do_posix)
702 					fatal("'l' is not permitted in POSIX awk formats");
703 			}
704 			big = TRUE;
705 			goto retry;
706 		case 'L':
707 			if (bigbig)
708 				break;
709 			else {
710 				static int warned = FALSE;
711 
712 				if (do_lint && ! warned) {
713 					warning("`L' is meaningless in awk formats; ignored");
714 					warned = TRUE;
715 				}
716 				if (do_posix)
717 					fatal("'L' is not permitted in POSIX awk formats");
718 			}
719 			bigbig = TRUE;
720 			goto retry;
721 		case 'h':
722 			if (small)
723 				break;
724 			else {
725 				static int warned = FALSE;
726 
727 				if (do_lint && ! warned) {
728 					warning("`h' is meaningless in awk formats; ignored");
729 					warned = TRUE;
730 				}
731 				if (do_posix)
732 					fatal("'h' is not permitted in POSIX awk formats");
733 			}
734 			small = TRUE;
735 			goto retry;
736 		case 'c':
737 			need_format = FALSE;
738 			if (zero_flag && ! lj)
739 				fill = zero_string;
740 			parse_next_arg();
741 			/* user input that looks numeric is numeric */
742 			if ((arg->flags & (MAYBE_NUM|NUMBER)) == MAYBE_NUM)
743 				(void) force_number(arg);
744 			if (arg->flags & NUMBER) {
745 #ifdef sun386
746 				tmp_uval = arg->numbr;
747 				uval = (unsigned long) tmp_uval;
748 #else
749 				uval = (unsigned long) arg->numbr;
750 #endif
751 				cpbuf[0] = uval;
752 				prec = 1;
753 				cp = cpbuf;
754 				goto pr_tail;
755 			}
756 			if (have_prec == FALSE)
757 				prec = 1;
758 			else if (prec > arg->stlen)
759 				prec = arg->stlen;
760 			cp = arg->stptr;
761 			goto pr_tail;
762 		case 's':
763 			need_format = FALSE;
764 			if (zero_flag && ! lj)
765 				fill = zero_string;
766 			parse_next_arg();
767 			arg = force_string(arg);
768 			if (! have_prec || prec > arg->stlen)
769 				prec = arg->stlen;
770 			cp = arg->stptr;
771 			goto pr_tail;
772 		case 'd':
773 		case 'i':
774 			need_format = FALSE;
775 			parse_next_arg();
776 			tmpval = force_number(arg);
777 
778 			/*
779 			 * ``The result of converting a zero value with a
780 			 * precision of zero is no characters.''
781 			 */
782 			if (have_prec && prec == 0 && tmpval == 0)
783 				goto pr_tail;
784 
785 			if (tmpval < 0) {
786 				if (tmpval < LONG_MIN)
787 					goto out_of_range;
788 				sgn = TRUE;
789 				uval = - (unsigned long) (long) tmpval;
790 			} else {
791 				/* Use !, so that NaNs are out of range.
792 				   The cast avoids a SunOS 4.1.x cc bug.  */
793 				if (! (tmpval <= (unsigned long) ULONG_MAX))
794 					goto out_of_range;
795 				sgn = FALSE;
796 				uval = (unsigned long) tmpval;
797 			}
798 			do {
799 				*--cp = (char) ('0' + uval % 10);
800 				uval /= 10;
801 			} while (uval > 0);
802 
803 			/* add more output digits to match the precision */
804 			if (have_prec) {
805 				while (cend - cp < prec)
806 					*--cp = '0';
807 			}
808 
809 			if (sgn)
810 				*--cp = '-';
811 			else if (signchar)
812 				*--cp = signchar;
813 			/*
814 			 * When to fill with zeroes is of course not simple.
815 			 * First: No zero fill if left-justifying.
816 			 * Next: There seem to be two cases:
817 			 * 	A '0' without a precision, e.g. %06d
818 			 * 	A precision with no field width, e.g. %.10d
819 			 * Any other case, we don't want to fill with zeroes.
820 			 */
821 			if (! lj
822 			    && ((zero_flag && ! have_prec)
823 				 || (fw == 0 && have_prec)))
824 				fill = zero_string;
825 			if (prec > fw)
826 				fw = prec;
827 			prec = cend - cp;
828 			if (fw > prec && ! lj && fill != sp
829 			    && (*cp == '-' || signchar)) {
830 				bchunk_one(cp);
831 				cp++;
832 				prec--;
833 				fw--;
834 			}
835 			goto pr_tail;
836 		case 'X':
837 			chbuf = Uchbuf;	/* FALL THROUGH */
838 		case 'x':
839 			base += 6;	/* FALL THROUGH */
840 		case 'u':
841 			base += 2;	/* FALL THROUGH */
842 		case 'o':
843 			base += 8;
844 			need_format = FALSE;
845 			parse_next_arg();
846 			tmpval = force_number(arg);
847 
848 			/*
849 			 * ``The result of converting a zero value with a
850 			 * precision of zero is no characters.''
851 			 *
852 			 * If I remember the ANSI C standard, though,
853 			 * it says that for octal conversions
854 			 * the precision is artificially increased
855 			 * to add an extra 0 if # is supplied.
856 			 * Indeed, in C,
857 			 * 	printf("%#.0o\n", 0);
858 			 * prints a single 0.
859 			 */
860 			if (! alt && have_prec && prec == 0 && tmpval == 0)
861 				goto pr_tail;
862 
863 			if (tmpval < 0) {
864 				if (tmpval < LONG_MIN)
865 					goto out_of_range;
866 				uval = (unsigned long) (long) tmpval;
867 			} else {
868 				/* Use !, so that NaNs are out of range.
869 				   The cast avoids a SunOS 4.1.x cc bug.  */
870 				if (! (tmpval <= (unsigned long) ULONG_MAX))
871 					goto out_of_range;
872 				uval = (unsigned long) tmpval;
873 			}
874 			/*
875 			 * When to fill with zeroes is of course not simple.
876 			 * First: No zero fill if left-justifying.
877 			 * Next: There seem to be two cases:
878 			 * 	A '0' without a precision, e.g. %06d
879 			 * 	A precision with no field width, e.g. %.10d
880 			 * Any other case, we don't want to fill with zeroes.
881 			 */
882 			if (! lj
883 			    && ((zero_flag && ! have_prec)
884 				 || (fw == 0 && have_prec)))
885 				fill = zero_string;
886 			do {
887 				*--cp = chbuf[uval % base];
888 				uval /= base;
889 			} while (uval > 0);
890 
891 			/* add more output digits to match the precision */
892 			if (have_prec) {
893 				while (cend - cp < prec)
894 					*--cp = '0';
895 			}
896 
897 			if (alt && tmpval != 0) {
898 				if (base == 16) {
899 					*--cp = cs1;
900 					*--cp = '0';
901 					if (fill != sp) {
902 						bchunk(cp, 2);
903 						cp += 2;
904 						fw -= 2;
905 					}
906 				} else if (base == 8)
907 					*--cp = '0';
908 			}
909 			base = 0;
910 			if (prec > fw)
911 				fw = prec;
912 			prec = cend - cp;
913 	pr_tail:
914 			if (! lj) {
915 				while (fw > prec) {
916 			    		bchunk_one(fill);
917 					fw--;
918 				}
919 			}
920 			bchunk(cp, (int) prec);
921 			while (fw > prec) {
922 				bchunk_one(fill);
923 				fw--;
924 			}
925 			s0 = s1;
926 			free_temp(arg);
927 			break;
928 
929      out_of_range:
930 			/* out of range - emergency use of %g format */
931 			cs1 = 'g';
932 			goto format_float;
933 
934 		case 'g':
935 		case 'G':
936 		case 'e':
937 		case 'f':
938 		case 'E':
939 			need_format = FALSE;
940 			parse_next_arg();
941 			tmpval = force_number(arg);
942      format_float:
943 			free_temp(arg);
944 			if (! have_prec)
945 				prec = DEFAULT_G_PRECISION;
946 			chksize(fw + prec + 9);	/* 9 == slop */
947 
948 			cp = cpbuf;
949 			*cp++ = '%';
950 			if (lj)
951 				*cp++ = '-';
952 			if (signchar)
953 				*cp++ = signchar;
954 			if (alt)
955 				*cp++ = '#';
956 			if (zero_flag)
957 				*cp++ = '0';
958 			strcpy(cp, "*.*");
959 			cp += 3;
960 			*cp++ = cs1;
961 			*cp = '\0';
962 #ifndef GFMT_WORKAROUND
963 			(void) sprintf(obufout, cpbuf,
964 				       (int) fw, (int) prec, (double) tmpval);
965 #else	/* GFMT_WORKAROUND */
966 			if (cs1 == 'g' || cs1 == 'G')
967 				sgfmt(obufout, cpbuf, (int) alt,
968 				       (int) fw, (int) prec, (double) tmpval);
969 			else
970 				(void) sprintf(obufout, cpbuf,
971 				       (int) fw, (int) prec, (double) tmpval);
972 #endif	/* GFMT_WORKAROUND */
973 			len = strlen(obufout);
974 			ofre -= len;
975 			obufout += len;
976 			s0 = s1;
977 			break;
978 		default:
979 #if 1 /* EUC �� Shift-JIS �Ǥ�ɬ�פʤ��Ȼפ���ǰ�Τ���.  */
980 			if (ismbchar(cs1) && n0 >= (skip = mbclen(cs1) - 1)) {
981 				n0 -= skip;
982 				s1 += skip;
983 			}
984 #endif
985 			break;
986 		}
987 		if (toofew)
988 			fatal("%s\n\t`%s'\n\t%*s%s",
989 			"not enough arguments to satisfy format string",
990 			fmt_string, s1 - fmt_string - 2, "",
991 			"^ ran out for this one"
992 			);
993 	}
994 	if (do_lint) {
995 		if (need_format)
996 			warning(
997 			"printf format specifier does not have control letter");
998 		if (carg != NULL)
999 			warning(
1000 			"too many arguments supplied for format string");
1001 	}
1002 	bchunk(s0, s1 - s0);
1003 	r = make_str_node(obuf, obufout - obuf, ALREADY_MALLOCED);
1004 	r->flags |= TEMP;
1005 	return r;
1006 }
1007 
1008 /* do_sprintf --- perform sprintf */
1009 
1010 NODE *
do_sprintf(tree)1011 do_sprintf(tree)
1012 NODE *tree;
1013 {
1014 	NODE *r;
1015 	NODE *sfmt = force_string(tree_eval(tree->lnode));
1016 
1017 	r = format_tree(sfmt->stptr, sfmt->stlen, tree->rnode);
1018 	free_temp(sfmt);
1019 	return r;
1020 }
1021 
1022 /* do_printf --- perform printf, including redirection */
1023 
1024 void
do_printf(tree)1025 do_printf(tree)
1026 register NODE *tree;
1027 {
1028 	struct redirect *rp = NULL;
1029 	register FILE *fp;
1030 
1031 	if (tree->lnode == NULL) {
1032 		if (do_traditional) {
1033 			if (do_lint)
1034 				warning("printf: no arguments");
1035 			return;	/* bwk accepts it silently */
1036 		}
1037 		fatal("printf: no arguments");
1038 	}
1039 
1040 	if (tree->rnode != NULL) {
1041 		int errflg;	/* not used, sigh */
1042 
1043 		rp = redirect(tree->rnode, &errflg);
1044 		if (rp != NULL) {
1045 			fp = rp->fp;
1046 			if (fp == NULL)
1047 				return;
1048 		} else
1049 			return;
1050 	} else
1051 		fp = stdout;
1052 	tree = do_sprintf(tree->lnode);
1053 	efwrite(tree->stptr, sizeof(char), tree->stlen, fp, "printf", rp, TRUE);
1054 	free_temp(tree);
1055 }
1056 
1057 /* do_sqrt --- do the sqrt function */
1058 
1059 NODE *
do_sqrt(tree)1060 do_sqrt(tree)
1061 NODE *tree;
1062 {
1063 	NODE *tmp;
1064 	double arg;
1065 
1066 	tmp = tree_eval(tree->lnode);
1067 	arg = (double) force_number(tmp);
1068 	free_temp(tmp);
1069 	if (arg < 0.0)
1070 		warning("sqrt called with negative argument %g", arg);
1071 	return tmp_number((AWKNUM) sqrt(arg));
1072 }
1073 
1074 /* do_substr --- do the substr function */
1075 
1076 NODE *
do_substr(tree)1077 do_substr(tree)
1078 NODE *tree;
1079 {
1080 	NODE *t1, *t2, *t3;
1081 	NODE *r;
1082 	register size_t indx;
1083 	size_t length;
1084 	double d_index, d_length;
1085 
1086 	t1 = force_string(tree_eval(tree->lnode));
1087 	t2 = tree_eval(tree->rnode->lnode);
1088 	d_index = force_number(t2);
1089 	free_temp(t2);
1090 
1091 	if (d_index < 1.0) {
1092 		if (do_lint)
1093 			warning("substr: start index %g invalid, using 1",
1094 				d_index);
1095 		d_index = 1;
1096 	}
1097 	if (do_lint && double_to_int(d_index) != d_index)
1098 		warning("substr: non-integer start index %g will be truncated",
1099 			d_index);
1100 
1101 	indx = d_index - 1;	/* awk indices are from 1, C's are from 0 */
1102 	if (indx < t1->stlen) {
1103 		indx = mbbyte(t1->stptr, indx);
1104 	}
1105 
1106 	if (tree->rnode->rnode == NULL) {	/* third arg. missing */
1107 		/* use remainder of string */
1108 		length = t1->stlen - indx;
1109 	} else {
1110 		t3 = tree_eval(tree->rnode->rnode->lnode);
1111 		d_length = force_number(t3);
1112 		free_temp(t3);
1113 		if (d_length <= 0.0) {
1114 			if (do_lint)
1115 				warning("substr: length %g is <= 0", d_length);
1116 			free_temp(t1);
1117 			return Nnull_string;
1118 		}
1119 		if (do_lint && double_to_int(d_length) != d_length)
1120 			warning(
1121 		"substr: non-integer length %g will be truncated",
1122 				d_length);
1123 		length = d_length;
1124 	}
1125 
1126 	if (t1->stlen == 0) {
1127 		if (do_lint)
1128 			warning("substr: source string is zero length");
1129 		free_temp(t1);
1130 		return Nnull_string;
1131 	}
1132 	if ((indx + length) > t1->stlen) {
1133 		if (do_lint)
1134 			warning(
1135 	"substr: length %d at position %d exceeds length of first argument (%d)",
1136 			length, indx+1, t1->stlen);
1137 		length = t1->stlen - indx;
1138 	}
1139 	if (indx >= t1->stlen) {
1140 		if (do_lint)
1141 			warning("substr: start index %d is past end of string",
1142 				indx+1);
1143 		free_temp(t1);
1144 		return Nnull_string;
1145 	}
1146 	r = tmp_string(t1->stptr + indx, length);
1147 	free_temp(t1);
1148 	return r;
1149 }
1150 
1151 /* do_jsubstr --- do the jsubstr function */
1152 
1153 NODE *
do_jsubstr(tree)1154 do_jsubstr(tree)
1155 NODE *tree;
1156 {
1157 	NODE *t1, *t2, *t3;
1158 	NODE *r;
1159 	register size_t indx;
1160 	size_t length;
1161 	double d_index, d_length;
1162 	const char *p;
1163 	int past_eos = 0;
1164 	int exceeds_length = 0;
1165 
1166 	t1 = force_string(tree_eval(tree->lnode));
1167 	t2 = tree_eval(tree->rnode->lnode);
1168 	d_index = force_number(t2);
1169 	free_temp(t2);
1170 
1171 	if (d_index < 1.0) {
1172 		if (do_lint)
1173 			warning("jsubstr: start index %g invalid, using 1",
1174 				d_index);
1175 		d_index = 1;
1176 	}
1177 	if (do_lint && double_to_int(d_index) != d_index)
1178 		warning("jsubstr: non-integer start index %g will be truncated",
1179 			d_index);
1180 
1181 	indx = d_index - 1;	/* awk indices are from 1, C's are from 0 */
1182 	for (p = t1->stptr; indx && p < (t1->stptr + t1->stlen); indx--)
1183 		p += mbclen(*p);
1184 	past_eos = indx;
1185 	indx = p - t1->stptr;
1186 
1187 	if (tree->rnode->rnode == NULL) {	/* third arg. missing */
1188 		/* use remainder of string */
1189 		length = t1->stlen - indx;
1190 	} else {
1191 		t3 = tree_eval(tree->rnode->rnode->lnode);
1192 		d_length = force_number(t3);
1193 		free_temp(t3);
1194 		if (d_length <= 0.0) {
1195 			if (do_lint)
1196 				warning("jsubstr: length %g is <= 0", d_length);
1197 			free_temp(t1);
1198 			return Nnull_string;
1199 		}
1200 		if (do_lint && double_to_int(d_length) != d_length)
1201 			warning(
1202 		"jsubstr: non-integer length %g will be truncated",
1203 				d_length);
1204 		for (length = d_length; length && p < (t1->stptr + t1->stlen); length--)
1205 			p += mbclen(*p);
1206 		exceeds_length = length;
1207 		length = p - t1->stptr - indx;
1208 	}
1209 
1210 	if (t1->stlen == 0) {
1211 		if (do_lint)
1212 			warning("jsubstr: source string is zero length");
1213 		free_temp(t1);
1214 		return Nnull_string;
1215 	}
1216 	if (do_lint && exceeds_length)
1217 		warning(
1218 	"jsubstr: length %g at position %g exceeds length of first argument (%d)",
1219 			d_length, d_index, mblength(t1->stptr, t1->stlen));
1220 	if (past_eos) {
1221 		if (do_lint)
1222 			warning("jsubstr: start index %g is past end of string",
1223 				d_index);
1224 		free_temp(t1);
1225 		return Nnull_string;
1226 	}
1227 	r = tmp_string(t1->stptr + indx, length);
1228 	free_temp(t1);
1229 	return r;
1230 }
1231 
1232 /* do_strftime --- format a time stamp */
1233 
1234 NODE *
do_strftime(tree)1235 do_strftime(tree)
1236 NODE *tree;
1237 {
1238 	NODE *t1, *t2, *ret;
1239 	struct tm *tm;
1240 	time_t fclock;
1241 	char *bufp;
1242 	size_t buflen, bufsize;
1243 	char buf[BUFSIZ];
1244 	static char def_format[] = "%a %b %d %H:%M:%S %Z %Y";
1245 	char *format;
1246 	int formatlen;
1247 
1248 	/* set defaults first */
1249 	format = def_format;	/* traditional date format */
1250 	formatlen = strlen(format);
1251 	(void) time(&fclock);	/* current time of day */
1252 
1253 	t1 = t2 = NULL;
1254 	if (tree != NULL) {	/* have args */
1255 		if (tree->lnode != NULL) {
1256 			t1 = force_string(tree_eval(tree->lnode));
1257 			format = t1->stptr;
1258 			formatlen = t1->stlen;
1259 			if (formatlen == 0) {
1260 				if (do_lint)
1261 					warning("strftime called with empty format string");
1262 				free_temp(t1);
1263 				return tmp_string("", 0);
1264 			}
1265 		}
1266 
1267 		if (tree->rnode != NULL) {
1268 			t2 = tree_eval(tree->rnode->lnode);
1269 			fclock = (time_t) force_number(t2);
1270 #if defined(_MSC_VER) && (_MSC_VER == 700)
1271 			fclock += (1UL + 70UL * 365UL + (70 >> 2)) * 24UL * 60UL * 60UL;
1272 #endif
1273 			free_temp(t2);
1274 		}
1275 	}
1276 
1277 	tm = localtime(&fclock);
1278 
1279 	bufp = buf;
1280 	bufsize = sizeof(buf);
1281 	for (;;) {
1282 		*bufp = '\0';
1283 		buflen = strftime(bufp, bufsize, format, tm);
1284 		/*
1285 		 * buflen can be zero EITHER because there's not enough
1286 		 * room in the string, or because the control command
1287 		 * goes to the empty string. Make a reasonable guess that
1288 		 * if the buffer is 1024 times bigger than the length of the
1289 		 * format string, it's not failing for lack of room.
1290 		 * Thanks to Paul Eggert for pointing out this issue.
1291 		 */
1292 		if (buflen > 0 || bufsize >= 1024 * formatlen)
1293 			break;
1294 		bufsize *= 2;
1295 		if (bufp == buf)
1296 			emalloc(bufp, char *, bufsize, "do_strftime");
1297 		else
1298 			erealloc(bufp, char *, bufsize, "do_strftime");
1299 	}
1300 	ret = tmp_string(bufp, buflen);
1301 	if (bufp != buf)
1302 		free(bufp);
1303 	if (t1)
1304 		free_temp(t1);
1305 	return ret;
1306 }
1307 
1308 /* do_systime --- get the time of day */
1309 
1310 NODE *
do_systime(tree)1311 do_systime(tree)
1312 NODE *tree;
1313 {
1314 	time_t lclock;
1315 
1316 	(void) time(&lclock);
1317 #if defined(_MSC_VER) && (_MSC_VER == 700)
1318 	lclock -= (1UL + 70UL * 365UL + (70 >> 2)) * 24UL * 60UL * 60UL;
1319 #endif
1320 	return tmp_number((AWKNUM) lclock);
1321 }
1322 
1323 
1324 
1325 /* do_system --- run an external command */
1326 
1327 NODE *
do_system(tree)1328 do_system(tree)
1329 NODE *tree;
1330 {
1331 	NODE *tmp;
1332 	int ret = 0;
1333 	char *cmd;
1334 	char save;
1335 
1336 	(void) flush_io();     /* so output is synchronous with gawk's */
1337 	tmp = tree_eval(tree->lnode);
1338 	cmd = force_string(tmp)->stptr;
1339 
1340 	if (cmd && *cmd) {
1341 		/* insure arg to system is zero-terminated */
1342 
1343 		/*
1344 		 * From: David Trueman <david@cs.dal.ca>
1345 		 * To: arnold@cc.gatech.edu (Arnold Robbins)
1346 		 * Date: Wed, 3 Nov 1993 12:49:41 -0400
1347 		 *
1348 		 * It may not be necessary to save the character, but
1349 		 * I'm not sure.  It would normally be the field
1350 		 * separator.  If the parse has not yet gone beyond
1351 		 * that, it could mess up (although I doubt it).  If
1352 		 * FIELDWIDTHS is being used, it might be the first
1353 		 * character of the next field.  Unless someone wants
1354 		 * to check it out exhaustively, I suggest saving it
1355 		 * for now...
1356 		 */
1357 		save = cmd[tmp->stlen];
1358 		cmd[tmp->stlen] = '\0';
1359 
1360 		ret = system(cmd);
1361 		ret = (ret >> 8) & 0xff;
1362 
1363 		cmd[tmp->stlen] = save;
1364 	}
1365 	free_temp(tmp);
1366 	return tmp_number((AWKNUM) ret);
1367 }
1368 
1369 extern NODE **fmt_list;  /* declared in eval.c */
1370 
1371 /* do_print --- print items, separated by OFS, terminated with ORS */
1372 
1373 void
do_print(tree)1374 do_print(tree)
1375 register NODE *tree;
1376 {
1377 	register NODE **t;
1378 	struct redirect *rp = NULL;
1379 	register FILE *fp;
1380 	int numnodes, i;
1381 	NODE *save;
1382 	NODE *tval;
1383 
1384 	if (tree->rnode) {
1385 		int errflg;		/* not used, sigh */
1386 
1387 		rp = redirect(tree->rnode, &errflg);
1388 		if (rp != NULL) {
1389 			fp = rp->fp;
1390 			if (fp == NULL)
1391 				return;
1392 		} else
1393 			return;
1394 	} else
1395 		fp = stdout;
1396 
1397 	/*
1398 	 * General idea is to evaluate all the expressions first and
1399 	 * then print them, otherwise you get suprising behavior.
1400 	 * See test/prtoeval.awk for an example program.
1401 	 */
1402 	save = tree = tree->lnode;
1403 	for (numnodes = 0; tree != NULL; tree = tree->rnode)
1404 		numnodes++;
1405 	emalloc(t, NODE **, numnodes * sizeof(NODE *), "do_print");
1406 
1407 	tree = save;
1408 	for (i = 0; tree != NULL; i++, tree = tree->rnode) {
1409 		NODE *n;
1410 
1411 		/* Here lies the wumpus. R.I.P. */
1412 		n = tree_eval(tree->lnode);
1413 		t[i] = dupnode(n);
1414 		free_temp(n);
1415 
1416 		if ((t[i]->flags & (NUMBER|STRING)) == NUMBER) {
1417 			if (OFMTidx == CONVFMTidx)
1418 				(void) force_string(t[i]);
1419 			else {
1420 				tval = tmp_number(t[i]->numbr);
1421 				unref(t[i]);
1422 				t[i] = format_val(OFMT, OFMTidx, tval);
1423 			}
1424 		}
1425 	}
1426 
1427 	for (i = 0; i < numnodes; i++) {
1428 		efwrite(t[i]->stptr, sizeof(char), t[i]->stlen, fp, "print", rp, FALSE);
1429 		unref(t[i]);
1430 
1431 		if (i != numnodes - 1 && OFSlen > 0)
1432 			efwrite(OFS, sizeof(char), (size_t) OFSlen,
1433 				fp, "print", rp, FALSE);
1434 
1435 	}
1436 	if (ORSlen > 0)
1437 		efwrite(ORS, sizeof(char), (size_t) ORSlen, fp, "print", rp, TRUE);
1438 
1439 	free(t);
1440 }
1441 
1442 /* do_tolower --- lower case a string */
1443 
1444 NODE *
do_tolower(tree)1445 do_tolower(tree)
1446 NODE *tree;
1447 {
1448 	NODE *t1, *t2;
1449 	register unsigned char *cp, *cp2;
1450 
1451 	t1 = tree_eval(tree->lnode);
1452 	t1 = force_string(t1);
1453 	t2 = tmp_string(t1->stptr, t1->stlen);
1454 	for (cp = (unsigned char *)t2->stptr,
1455 	     cp2 = (unsigned char *)(t2->stptr + t2->stlen); cp < cp2; cp++)
1456 		if (ismbchar(*cp))
1457 			cp += mbclen(*cp) - 1;
1458 		else if (ISUPPER(*cp))
1459 			*cp = tolower(*cp);
1460 	free_temp(t1);
1461 	return t2;
1462 }
1463 
1464 /* do_toupper --- upper case a string */
1465 
1466 NODE *
do_toupper(tree)1467 do_toupper(tree)
1468 NODE *tree;
1469 {
1470 	NODE *t1, *t2;
1471 	register unsigned char *cp, *cp2;
1472 
1473 	t1 = tree_eval(tree->lnode);
1474 	t1 = force_string(t1);
1475 	t2 = tmp_string(t1->stptr, t1->stlen);
1476 	for (cp = (unsigned char *)t2->stptr,
1477 	     cp2 = (unsigned char *)(t2->stptr + t2->stlen); cp < cp2; cp++)
1478 		if (ismbchar(*cp))
1479 			cp += mbclen(*cp) - 1;
1480 		else if (ISLOWER(*cp))
1481 			*cp = toupper(*cp);
1482 	free_temp(t1);
1483 	return t2;
1484 }
1485 
1486 /* do_atan2 --- do the atan2 function */
1487 
1488 NODE *
do_atan2(tree)1489 do_atan2(tree)
1490 NODE *tree;
1491 {
1492 	NODE *t1, *t2;
1493 	double d1, d2;
1494 
1495 	t1 = tree_eval(tree->lnode);
1496 	t2 = tree_eval(tree->rnode->lnode);
1497 	d1 = force_number(t1);
1498 	d2 = force_number(t2);
1499 	free_temp(t1);
1500 	free_temp(t2);
1501 	return tmp_number((AWKNUM) atan2(d1, d2));
1502 }
1503 
1504 /* do_sin --- do the sin function */
1505 
1506 NODE *
do_sin(tree)1507 do_sin(tree)
1508 NODE *tree;
1509 {
1510 	NODE *tmp;
1511 	double d;
1512 
1513 	tmp = tree_eval(tree->lnode);
1514 	d = sin((double) force_number(tmp));
1515 	free_temp(tmp);
1516 	return tmp_number((AWKNUM) d);
1517 }
1518 
1519 /* do_cos --- do the cos function */
1520 
1521 NODE *
do_cos(tree)1522 do_cos(tree)
1523 NODE *tree;
1524 {
1525 	NODE *tmp;
1526 	double d;
1527 
1528 	tmp = tree_eval(tree->lnode);
1529 	d = cos((double) force_number(tmp));
1530 	free_temp(tmp);
1531 	return tmp_number((AWKNUM) d);
1532 }
1533 
1534 /* do_rand --- do the rand function */
1535 
1536 static int firstrand = TRUE;
1537 static char state[512];
1538 
1539 /* ARGSUSED */
1540 NODE *
do_rand(tree)1541 do_rand(tree)
1542 NODE *tree;
1543 {
1544 	if (firstrand) {
1545 		(void) initstate((unsigned) 1, state, sizeof state);
1546 		srandom(1);
1547 		firstrand = FALSE;
1548 	}
1549 	return tmp_number((AWKNUM) random() / GAWK_RANDOM_MAX);
1550 }
1551 
1552 /* do_srand --- seed the random number generator */
1553 
1554 NODE *
do_srand(tree)1555 do_srand(tree)
1556 NODE *tree;
1557 {
1558 	NODE *tmp;
1559 	static long save_seed = 1;
1560 	long ret = save_seed;	/* SVR4 awk srand returns previous seed */
1561 
1562 	if (firstrand) {
1563 		(void) initstate((unsigned) 1, state, sizeof state);
1564 		/* don't need to srandom(1), we're changing the seed below */
1565 		firstrand = FALSE;
1566 	} else
1567 		(void) setstate(state);
1568 
1569 	if (tree == NULL) {
1570 #if defined(_MSC_VER) && (_MSC_VER == 700)
1571 		save_seed = time((time_t *) 0)
1572 		  - (1UL + 70UL * 365UL + (70 >> 2)) * 24UL * 60 UL * 60UL;
1573 		srandom((int) save_seed);
1574 #else
1575 		srandom((unsigned int) (save_seed = (long) time((time_t *) 0)));
1576 #endif
1577 	} else {
1578 		tmp = tree_eval(tree->lnode);
1579 		srandom((unsigned int) (save_seed = (long) force_number(tmp)));
1580 		free_temp(tmp);
1581 	}
1582 	return tmp_number((AWKNUM) ret);
1583 }
1584 
1585 /* do_match --- match a regexp, set RSTART and RLENGTH */
1586 
1587 NODE *
do_match(tree)1588 do_match(tree)
1589 NODE *tree;
1590 {
1591 	NODE *t1;
1592 	int rstart;
1593 	AWKNUM rlength;
1594 	Regexp *rp;
1595 
1596 	t1 = force_string(tree_eval(tree->lnode));
1597 	tree = tree->rnode->lnode;
1598 	rp = re_update(tree);
1599 	rstart = research(rp, t1->stptr, 0, t1->stlen, TRUE);
1600 	if (rstart >= 0) {	/* match succeded */
1601 		rstart++;	/* 1-based indexing */
1602 		rlength = REEND(rp, t1->stptr) - RESTART(rp, t1->stptr);
1603 	} else {		/* match failed */
1604 		rstart = 0;
1605 		rlength = -1.0;
1606 	}
1607 	free_temp(t1);
1608 	unref(RSTART_node->var_value);
1609 	RSTART_node->var_value = make_number((AWKNUM) rstart);
1610 	unref(RLENGTH_node->var_value);
1611 	RLENGTH_node->var_value = make_number(rlength);
1612 	return tmp_number((AWKNUM) rstart);
1613 }
1614 
1615 /* sub_common --- the common code (does the work) for sub, gsub, and gensub */
1616 
1617 /*
1618  * Gsub can be tricksy; particularly when handling the case of null strings.
1619  * The following awk code was useful in debugging problems.  It is too bad
1620  * that it does not readily translate directly into the C code, below.
1621  *
1622  * #! /usr/local/bin/mawk -f
1623  *
1624  * BEGIN {
1625  * 	TRUE = 1; FALSE = 0
1626  * 	print "--->", mygsub("abc", "b+", "FOO")
1627  * 	print "--->", mygsub("abc", "x*", "X")
1628  * 	print "--->", mygsub("abc", "b*", "X")
1629  * 	print "--->", mygsub("abc", "c", "X")
1630  * 	print "--->", mygsub("abc", "c+", "X")
1631  * 	print "--->", mygsub("abc", "x*$", "X")
1632  * }
1633  *
1634  * function mygsub(str, regex, replace,	origstr, newstr, eosflag, nonzeroflag)
1635  * {
1636  * 	origstr = str;
1637  * 	eosflag = nonzeroflag = FALSE
1638  * 	while (match(str, regex)) {
1639  * 		if (RLENGTH > 0) {	# easy case
1640  * 			nonzeroflag = TRUE
1641  * 			if (RSTART == 1) {	# match at front of string
1642  * 				newstr = newstr replace
1643  * 			} else {
1644  * 				newstr = newstr substr(str, 1, RSTART-1) replace
1645  * 			}
1646  * 			str = substr(str, RSTART+RLENGTH)
1647  * 		} else if (nonzeroflag) {
1648  * 			# last match was non-zero in length, and at the
1649  * 			# current character, we get a zero length match,
1650  * 			# which we don't really want, so skip over it
1651  * 			newstr = newstr substr(str, 1, 1)
1652  * 			str = substr(str, 2)
1653  * 			nonzeroflag = FALSE
1654  * 		} else {
1655  * 			# 0-length match
1656  * 			if (RSTART == 1) {
1657  * 				newstr = newstr replace substr(str, 1, 1)
1658  * 				str = substr(str, 2)
1659  * 			} else {
1660  * 				return newstr str replace
1661  * 			}
1662  * 		}
1663  * 		if (length(str) == 0)
1664  * 			if (eosflag)
1665  * 				break;
1666  * 			else
1667  * 				eosflag = TRUE
1668  * 	}
1669  * 	if (length(str) > 0)
1670  * 		newstr = newstr str	# rest of string
1671  *
1672  * 	return newstr
1673  * }
1674  */
1675 
1676 /*
1677  * NB: `howmany' conflicts with a SunOS macro in <sys/param.h>.
1678  */
1679 
1680 static NODE *
sub_common(tree,how_many,backdigs)1681 sub_common(tree, how_many, backdigs)
1682 NODE *tree;
1683 int how_many, backdigs;
1684 {
1685 	register char *scan;
1686 	register char *bp, *cp;
1687 	char *buf;
1688 	size_t buflen;
1689 	register char *matchend;
1690 	register size_t len;
1691 	char *matchstart;
1692 	char *text;
1693 	size_t textlen;
1694 	char *repl;
1695 	char *replend;
1696 	size_t repllen;
1697 	int sofar;
1698 	int ampersands;
1699 	int matches = 0;
1700 	Regexp *rp;
1701 	NODE *s;		/* subst. pattern */
1702 	NODE *t;		/* string to make sub. in; $0 if none given */
1703 	NODE *tmp;
1704 	NODE **lhs = &tree;	/* value not used -- just different from NULL */
1705 	int priv = FALSE;
1706 	Func_ptr after_assign = NULL;
1707 
1708 	int global = (how_many == -1);
1709 	long current;
1710 	int lastmatchnonzero;
1711 
1712 	tmp = tree->lnode;
1713 	rp = re_update(tmp);
1714 
1715 	tree = tree->rnode;
1716 	s = tree->lnode;
1717 
1718 	tree = tree->rnode;
1719 	tmp = tree->lnode;
1720 	t = force_string(tree_eval(tmp));
1721 
1722 	/* do the search early to avoid work on non-match */
1723 	if (research(rp, t->stptr, 0, t->stlen, TRUE) == -1 ||
1724 	    RESTART(rp, t->stptr) > t->stlen) {
1725 		free_temp(t);
1726 		return tmp_number((AWKNUM) 0.0);
1727 	}
1728 
1729 	if (tmp->type == Node_val)
1730 		lhs = NULL;
1731 	else
1732 		lhs = get_lhs(tmp, &after_assign);
1733 	t->flags |= STRING;
1734 	/*
1735 	 * create a private copy of the string
1736 	 */
1737 	if (t->stref > 1 || (t->flags & (PERM|FIELD)) != 0) {
1738 		unsigned int saveflags;
1739 
1740 		saveflags = t->flags;
1741 		t->flags &= ~MALLOC;
1742 		tmp = dupnode(t);
1743 		t->flags = saveflags;
1744 		t = tmp;
1745 		priv = TRUE;
1746 	}
1747 	text = t->stptr;
1748 	textlen = t->stlen;
1749 	buflen = textlen + 2;
1750 
1751 	s = force_string(tree_eval(s));
1752 	repl = s->stptr;
1753 	replend = repl + s->stlen;
1754 	repllen = replend - repl;
1755 	emalloc(buf, char *, buflen + 2, "sub_common");
1756 	buf[buflen] = '\0';
1757 	buf[buflen + 1] = '\0';
1758 	ampersands = 0;
1759 	for (scan = repl; scan < replend; scan++) {
1760 		if (*scan == '&') {
1761 			repllen--;
1762 			ampersands++;
1763 		} else if (*scan == '\\') {
1764 			if (backdigs) {	/* gensub, behave sanely */
1765 				if (ISDIGIT((unsigned char)scan[1])) {
1766 					ampersands++;
1767 					scan++;
1768 				} else {	/* \q for any q --> q */
1769 					repllen--;
1770 					scan++;
1771 				}
1772 			} else {	/* (proposed) posix '96 mode */
1773 				if (strncmp(scan, "\\\\\\&", 4) == 0) {
1774 					/* \\\& --> \& */
1775 					repllen -= 2;
1776 					scan += 3;
1777 				} else if (strncmp(scan, "\\\\&", 3) == 0) {
1778 					/* \\& --> \<string> */
1779 					ampersands++;
1780 					repllen--;
1781 					scan += 2;
1782 				} else if (scan[1] == '&') {
1783 					/* \& --> & */
1784 					repllen--;
1785 					scan++;
1786 				} /* else
1787 					leave alone, it goes into the output */
1788 			}
1789 		}
1790 		else if (ismbchar(*scan))
1791 			scan += mbclen(*scan) - 1;
1792 	}
1793 
1794 	lastmatchnonzero = FALSE;
1795 	bp = buf;
1796 	for (current = 1;; current++) {
1797 		matches++;
1798 		matchstart = t->stptr + RESTART(rp, t->stptr);
1799 		matchend = t->stptr + REEND(rp, t->stptr);
1800 
1801 		/*
1802 		 * create the result, copying in parts of the original
1803 		 * string
1804 		 */
1805 		len = matchstart - text + repllen
1806 		      + ampersands * (matchend - matchstart);
1807 		sofar = bp - buf;
1808 		while (buflen < (sofar + len + 1)) {
1809 			buflen *= 2;
1810 			erealloc(buf, char *, buflen, "sub_common");
1811 			bp = buf + sofar;
1812 		}
1813 		for (scan = text; scan < matchstart; scan++)
1814 			*bp++ = *scan;
1815 		if (global || current == how_many) {
1816 			/*
1817 			 * If the current match matched the null string,
1818 			 * and the last match didn't and did a replacement,
1819 			 * then skip this one.
1820 			 */
1821 			if (lastmatchnonzero && matchstart == matchend) {
1822 				lastmatchnonzero = FALSE;
1823 				matches--;
1824 				goto empty;
1825 			}
1826 			/*
1827 			 * If replacing all occurrences, or this is the
1828 			 * match we want, copy in the replacement text,
1829 			 * making substitutions as we go.
1830 			 */
1831 			for (scan = repl; scan < replend; scan++)
1832 				if (*scan == '&')
1833 					for (cp = matchstart; cp < matchend; cp++)
1834 						*bp++ = *cp;
1835 				else if (*scan == '\\') {
1836 					if (backdigs) {	/* gensub, behave sanely */
1837 						if (ISDIGIT((unsigned char) scan[1])) {
1838 							int dig = scan[1] - '0';
1839 							char *start, *end;
1840 
1841 							start = t->stptr
1842 							      + SUBPATSTART(rp, t->stptr, dig);
1843 							end = t->stptr
1844 							      + SUBPATEND(rp, t->stptr, dig);
1845 
1846 							for (cp = start; cp < end; cp++)
1847 								*bp++ = *cp;
1848 							scan++;
1849 						} else	/* \q for any q --> q */
1850 							*bp++ = *++scan;
1851 					} else {	/* posix '96 mode, bleah */
1852 						if (strncmp(scan, "\\\\\\&", 4) == 0) {
1853 							/* \\\& --> \& */
1854 							*bp++ = '\\';
1855 							*bp++ = '&';
1856 							scan += 3;
1857 						} else if (strncmp(scan, "\\\\&", 3) == 0) {
1858 							/* \\& --> \<string> */
1859 							*bp++ = '\\';
1860 							for (cp = matchstart; cp < matchend; cp++)
1861 								*bp++ = *cp;
1862 							scan += 2;
1863 						} else if (scan[1] == '&') {
1864 							/* \& --> & */
1865 							*bp++ = '&';
1866 							scan++;
1867 						} else
1868 							*bp++ = *scan;
1869 					}
1870 				} else if (ismbchar(*scan)) {
1871 					size_t n = mbclen(*scan) - 1;
1872 					while (n-- > 0)
1873 						*bp++ = *scan++;
1874 					*bp++ = *scan;
1875 				} else
1876 					*bp++ = *scan;
1877 			if (matchstart != matchend)
1878 				lastmatchnonzero = TRUE;
1879 		} else {
1880 			/*
1881 			 * don't want this match, skip over it by copying
1882 			 * in current text.
1883 			 */
1884 			for (cp = matchstart; cp < matchend; cp++)
1885 				*bp++ = *cp;
1886 		}
1887 	empty:
1888 		/* catch the case of gsub(//, "blah", whatever), i.e. empty regexp */
1889 		if (matchstart == matchend && matchend < text + textlen) {
1890 			size_t n = mbclen(*matchend) - 1;
1891 			while (n-- > 0)
1892 				*bp++ = *matchend++;
1893 			*bp++ = *matchend;
1894 			matchend++;
1895 		}
1896 		textlen = text + textlen - matchend;
1897 		text = matchend;
1898 
1899 		if ((current >= how_many && !global)
1900 		    || ((long) SIGNED_SIZE_T (textlen) <= 0 && matchstart == matchend)
1901 		    || research(rp, t->stptr, text - t->stptr, textlen, TRUE) == -1)
1902 			break;
1903 
1904 	}
1905 	sofar = bp - buf;
1906 	if (buflen - sofar - textlen - 1) {
1907 		buflen = sofar + textlen + 2;
1908 		erealloc(buf, char *, buflen, "sub_common");
1909 		bp = buf + sofar;
1910 	}
1911 	for (scan = matchend; scan < text + textlen; scan++)
1912 		*bp++ = *scan;
1913 	*bp = '\0';
1914 	textlen = bp - buf;
1915 	free(t->stptr);
1916 	t->stptr = buf;
1917 	t->stlen = textlen;
1918 
1919 	free_temp(s);
1920 	if (matches > 0 && lhs) {
1921 		if (priv) {
1922 			unref(*lhs);
1923 			*lhs = t;
1924 		}
1925 		if (after_assign != NULL)
1926 			(*after_assign)();
1927 		t->flags &= ~(NUM|NUMBER);
1928 	}
1929 	return tmp_number((AWKNUM) matches);
1930 }
1931 
1932 /* do_gsub --- global substitution */
1933 
1934 NODE *
do_gsub(tree)1935 do_gsub(tree)
1936 NODE *tree;
1937 {
1938 	return sub_common(tree, -1, FALSE);
1939 }
1940 
1941 /* do_sub --- single substitution */
1942 
1943 NODE *
do_sub(tree)1944 do_sub(tree)
1945 NODE *tree;
1946 {
1947 	return sub_common(tree, 1, FALSE);
1948 }
1949 
1950 /* do_gensub --- fix up the tree for sub_common for the gensub function */
1951 
1952 NODE *
do_gensub(tree)1953 do_gensub(tree)
1954 NODE *tree;
1955 {
1956 	NODE n1, n2, n3, *t, *tmp, *target, *ret;
1957 	long how_many = 1;	/* default is one substitution */
1958 	double d;
1959 
1960 	/*
1961 	 * We have to pull out the value of the global flag, and
1962 	 * build up a tree without the flag in it, turning it into the
1963 	 * kind of tree that sub_common() expects.  It helps to draw
1964 	 * a picture of this ...
1965 	 */
1966 	n1 = *tree;
1967 	n2 = *(tree->rnode);
1968 	n1.rnode = & n2;
1969 
1970 	t = tree_eval(n2.rnode->lnode);	/* value of global flag */
1971 
1972 	tmp = force_string(tree_eval(n2.rnode->rnode->lnode));	/* target */
1973 
1974 	/*
1975 	 * We make copy of the original target string, and pass that
1976 	 * in to sub_common() as the target to make the substitution in.
1977 	 * We will then return the result string as the return value of
1978 	 * this function.
1979 	 */
1980 	target = make_string(tmp->stptr, tmp->stlen);
1981 	free_temp(tmp);
1982 
1983 	n3 = *(n2.rnode->rnode);
1984 	n3.lnode = target;
1985 	n2.rnode = & n3;
1986 
1987 	if ((t->flags & (STR|STRING)) != 0) {
1988 		if (t->stlen > 0 && (t->stptr[0] == 'g' || t->stptr[0] == 'G'))
1989 			how_many = -1;
1990 		else
1991 			how_many = 1;
1992 	} else {
1993 		d = force_number(t);
1994 		if (d > 0)
1995 			how_many = d;
1996 		else
1997 			how_many = 1;
1998 	}
1999 
2000 	free_temp(t);
2001 
2002 	ret = sub_common(&n1, how_many, TRUE);
2003 	free_temp(ret);
2004 
2005 	/*
2006 	 * Note that we don't care what sub_common() returns, since the
2007 	 * easiest thing for the programmer is to return the string, even
2008 	 * if no substitutions were done.
2009 	 */
2010 	target->flags |= TEMP;
2011 	return target;
2012 }
2013 
2014 #ifdef GFMT_WORKAROUND
2015 /*
2016  * printf's %g format [can't rely on gcvt()]
2017  *	caveat: don't use as argument to *printf()!
2018  * 'format' string HAS to be of "<flags>*.*g" kind, or we bomb!
2019  */
2020 static void
sgfmt(buf,format,alt,fwidth,prec,g)2021 sgfmt(buf, format, alt, fwidth, prec, g)
2022 char *buf;	/* return buffer; assumed big enough to hold result */
2023 const char *format;
2024 int alt;	/* use alternate form flag */
2025 int fwidth;	/* field width in a format */
2026 int prec;	/* indicates desired significant digits, not decimal places */
2027 double g;	/* value to format */
2028 {
2029 	char dform[40];
2030 	register char *gpos;
2031 	register char *d, *e, *p;
2032 	int again = FALSE;
2033 
2034 	strncpy(dform, format, sizeof dform - 1);
2035 	dform[sizeof dform - 1] = '\0';
2036 	gpos = strrchr(dform, '.');
2037 
2038 	if (g == 0.0 && ! alt) {	/* easy special case */
2039 		*gpos++ = 'd';
2040 		*gpos = '\0';
2041 		(void) sprintf(buf, dform, fwidth, 0);
2042 		return;
2043 	}
2044 
2045 	/* advance to location of 'g' in the format */
2046 	while (*gpos && *gpos != 'g' && *gpos != 'G')
2047 		gpos++;
2048 
2049 	if (prec <= 0)	      /* negative precision is ignored */
2050 		prec = (prec < 0 ?  DEFAULT_G_PRECISION : 1);
2051 
2052 	if (*gpos == 'G')
2053 		again = TRUE;
2054 	/* start with 'e' format (it'll provide nice exponent) */
2055 	*gpos = 'e';
2056 	prec--;
2057 	(void) sprintf(buf, dform, fwidth, prec, g);
2058 	if ((e = strrchr(buf, 'e')) != NULL) {	/* find exponent  */
2059 		int expn = atoi(e+1);		/* fetch exponent */
2060 		if (expn >= -4 && expn <= prec) {	/* per K&R2, B1.2 */
2061 			/* switch to 'f' format and re-do */
2062 			*gpos = 'f';
2063 			prec -= expn;		/* decimal precision */
2064 			(void) sprintf(buf, dform, fwidth, prec, g);
2065 			e = buf + strlen(buf);
2066 			while (*--e == ' ')
2067 				continue;
2068 			e++;
2069 		}
2070 		else if (again)
2071 			*gpos = 'E';
2072 
2073 		/* if 'alt' in force, then trailing zeros are not removed */
2074 		if (! alt && (d = strrchr(buf, '.')) != NULL) {
2075 			/* throw away an excess of precision */
2076 			for (p = e; p > d && *--p == '0'; )
2077 				prec--;
2078 			if (d == p)
2079 				prec--;
2080 			if (prec < 0)
2081 				prec = 0;
2082 			/* and do that once again */
2083 			again = TRUE;
2084 		}
2085 		if (again)
2086 			(void) sprintf(buf, dform, fwidth, prec, g);
2087 	}
2088 }
2089 #endif	/* GFMT_WORKAROUND */
2090 
2091 #ifdef BITOPS
2092 #define BITS_PER_BYTE	8	/* if not true, you lose. too bad. */
2093 
2094 /* do_lshift --- perform a << operation */
2095 
2096 NODE *
do_lshift(tree)2097 do_lshift(tree)
2098 NODE *tree;
2099 {
2100 	NODE *s1, *s2;
2101 	unsigned long uval, ushift, result;
2102 	AWKNUM val, shift;
2103 
2104 	s1 = tree_eval(tree->lnode);
2105 	s2 = tree_eval(tree->rnode->lnode);
2106 	val = force_number(s1);
2107 	shift = force_number(s2);
2108 	free_temp(s1);
2109 	free_temp(s2);
2110 
2111 	if (do_lint) {
2112 		if (val < 0 || shift < 0)
2113 			warning("lshift(%lf, %lf): negative values will give strange results", val, shift);
2114 		if (double_to_int(val) != val || double_to_int(shift) != shift)
2115 			warning("lshift(%lf, %lf): fractional values will be truncated", val, shift);
2116 		if (shift > (sizeof(unsigned long) * BITS_PER_BYTE))
2117 			warning("lshift(%lf, %lf): too large shift value will give strange results", val, shift);
2118 	}
2119 
2120 	uval = (unsigned long) val;
2121 	ushift = (unsigned long) shift;
2122 
2123 	result = uval << ushift;
2124 	return tmp_number((AWKNUM) result);
2125 }
2126 
2127 /* do_rshift --- perform a >> operation */
2128 
2129 NODE *
do_rshift(tree)2130 do_rshift(tree)
2131 NODE *tree;
2132 {
2133 	NODE *s1, *s2;
2134 	unsigned long uval, ushift, result;
2135 	AWKNUM val, shift;
2136 
2137 	s1 = tree_eval(tree->lnode);
2138 	s2 = tree_eval(tree->rnode->lnode);
2139 	val = force_number(s1);
2140 	shift = force_number(s2);
2141 	free_temp(s1);
2142 	free_temp(s2);
2143 
2144 	if (do_lint) {
2145 		if (val < 0 || shift < 0)
2146 			warning("rshift(%lf, %lf): negative values will give strange results", val, shift);
2147 		if (double_to_int(val) != val || double_to_int(shift) != shift)
2148 			warning("rshift(%lf, %lf): fractional values will be truncated", val, shift);
2149 		if (shift > (sizeof(unsigned long) * BITS_PER_BYTE))
2150 			warning("rshift(%lf, %lf): too large shift value will give strange results", val, shift);
2151 	}
2152 
2153 	uval = (unsigned long) val;
2154 	ushift = (unsigned long) shift;
2155 
2156 	result = uval >> ushift;
2157 	return tmp_number((AWKNUM) result);
2158 }
2159 
2160 /* do_and --- perform an & operation */
2161 
2162 NODE *
do_and(tree)2163 do_and(tree)
2164 NODE *tree;
2165 {
2166 	NODE *s1, *s2;
2167 	unsigned long uleft, uright, result;
2168 	AWKNUM left, right;
2169 
2170 	s1 = tree_eval(tree->lnode);
2171 	s2 = tree_eval(tree->rnode->lnode);
2172 	left = force_number(s1);
2173 	right = force_number(s2);
2174 	free_temp(s1);
2175 	free_temp(s2);
2176 
2177 	if (do_lint) {
2178 		if (left < 0 || right < 0)
2179 			warning("and(%lf, %lf): negative values will give strange results", left, right);
2180 		if (double_to_int(left) != left || double_to_int(right) != right)
2181 			warning("and(%lf, %lf): fractional values will be truncated", left, right);
2182 	}
2183 
2184 	uleft = (unsigned long) left;
2185 	uright = (unsigned long) right;
2186 
2187 	result = uleft & uright;
2188 	return tmp_number((AWKNUM) result);
2189 }
2190 
2191 /* do_or --- perform an | operation */
2192 
2193 NODE *
do_or(tree)2194 do_or(tree)
2195 NODE *tree;
2196 {
2197 	NODE *s1, *s2;
2198 	unsigned long uleft, uright, result;
2199 	AWKNUM left, right;
2200 
2201 	s1 = tree_eval(tree->lnode);
2202 	s2 = tree_eval(tree->rnode->lnode);
2203 	left = force_number(s1);
2204 	right = force_number(s2);
2205 	free_temp(s1);
2206 	free_temp(s2);
2207 
2208 	if (do_lint) {
2209 		if (left < 0 || right < 0)
2210 			warning("or(%lf, %lf): negative values will give strange results", left, right);
2211 		if (double_to_int(left) != left || double_to_int(right) != right)
2212 			warning("or(%lf, %lf): fractional values will be truncated", left, right);
2213 	}
2214 
2215 	uleft = (unsigned long) left;
2216 	uright = (unsigned long) right;
2217 
2218 	result = uleft | uright;
2219 	return tmp_number((AWKNUM) result);
2220 }
2221 
2222 /* do_xor --- perform an ^ operation */
2223 
2224 NODE *
do_xor(tree)2225 do_xor(tree)
2226 NODE *tree;
2227 {
2228 	NODE *s1, *s2;
2229 	unsigned long uleft, uright, result;
2230 	AWKNUM left, right;
2231 
2232 	s1 = tree_eval(tree->lnode);
2233 	s2 = tree_eval(tree->rnode->lnode);
2234 	left = force_number(s1);
2235 	right = force_number(s2);
2236 	free_temp(s1);
2237 	free_temp(s2);
2238 
2239 	if (do_lint) {
2240 		if (left < 0 || right < 0)
2241 			warning("xor(%lf, %lf): negative values will give strange results", left, right);
2242 		if (double_to_int(left) != left || double_to_int(right) != right)
2243 			warning("xor(%lf, %lf): fractional values will be truncated", left, right);
2244 	}
2245 
2246 	uleft = (unsigned long) left;
2247 	uright = (unsigned long) right;
2248 
2249 	result = uleft ^ uright;
2250 	return tmp_number((AWKNUM) result);
2251 }
2252 
2253 /* do_compl --- perform a ~ operation */
2254 
2255 NODE *
do_compl(tree)2256 do_compl(tree)
2257 NODE *tree;
2258 {
2259 	NODE *tmp;
2260 	double d;
2261 	unsigned long uval;
2262 
2263 	tmp = tree_eval(tree->lnode);
2264 	d = force_number(tmp);
2265 	free_temp(tmp);
2266 
2267 	if (do_lint) {
2268 		if (d < 0)
2269 			warning("compl(%lf): negative value will give strange results", d);
2270 		if (double_to_int(d) != d)
2271 			warning("compl(%lf): fractional value will be truncated", d);
2272 	}
2273 
2274 	uval = (unsigned long) d;
2275 	uval = ~ uval;
2276 	return tmp_number((AWKNUM) uval);
2277 }
2278 
2279 /* do_strtonum --- the strtonum function */
2280 
2281 NODE *
do_strtonum(tree)2282 do_strtonum(tree)
2283 NODE *tree;
2284 {
2285 	NODE *tmp;
2286 	double d, arg;
2287 
2288 	tmp = tree_eval(tree->lnode);
2289 
2290 	if ((tmp->flags & (NUM|NUMBER)) != 0)
2291 		d = (double) force_number(tmp);
2292 	else if (isnondecimal(tmp->stptr))
2293 		d = nondec2awknum(tmp->stptr, tmp->stlen);
2294 	else
2295 		d = (double) force_number(tmp);
2296 
2297 	free_temp(tmp);
2298 	return tmp_number((AWKNUM) d);
2299 }
2300 #endif /* BITOPS */
2301 
2302 #if defined(BITOPS) || defined(NONDECDATA)
2303 /* nondec2awknum --- convert octal or hex value to double */
2304 
2305 /*
2306  * Because of awk's concatenation rules and the way awk.y:yylex()
2307  * collects a number, this routine has to be willing to stop on the
2308  * first invalid character.
2309  */
2310 
2311 AWKNUM
nondec2awknum(str,len)2312 nondec2awknum(str, len)
2313 char *str;
2314 size_t len;
2315 {
2316 	AWKNUM retval = 0.0;
2317 	char save;
2318 	short val;
2319 
2320 	if (*str == '0' && (str[1] == 'x' || str[1] == 'X')) {
2321 		assert(len > 2);
2322 
2323 		for (str += 2, len -= 2; len > 0; len--, str++) {
2324 			switch (*str) {
2325 			case '0':
2326 			case '1':
2327 			case '2':
2328 			case '3':
2329 			case '4':
2330 			case '5':
2331 			case '6':
2332 			case '7':
2333 			case '8':
2334 			case '9':
2335 				val = *str - '0';
2336 				break;
2337 			case 'a':
2338 			case 'b':
2339 			case 'c':
2340 			case 'd':
2341 			case 'e':
2342 			case 'f':
2343 				val = *str - 'a' + 10;
2344 				break;
2345 			case 'A':
2346 			case 'B':
2347 			case 'C':
2348 			case 'D':
2349 			case 'E':
2350 			case 'F':
2351 				val = *str - 'A' + 10;
2352 				break;
2353 			default:
2354 				goto done;
2355 			}
2356 			retval = (retval * 16) + val;
2357 		}
2358 	} else if (*str == '0') {
2359 		for (; len > 0; len--) {
2360 			if (! isdigit(*str) || *str == '8' || *str == '9')
2361 				goto decimal;
2362 			retval = (retval * 8) + (*str - '0');
2363 			str++;
2364 		}
2365 	} else {
2366 decimal:
2367 		save = str[len];
2368 		retval = atof(str);
2369 		str[len] = save;
2370 	}
2371 done:
2372 	return retval;
2373 }
2374 #endif /* defined(BITOPS) || defined(NONDECDATA) */
2375