xref: /titanic_51/usr/src/cmd/awk_xpg4/awk4.c (revision b453864f3587ccc3324d7a3b0438a1e542dcfde7)
1 /*
2  * CDDL HEADER START
3  *
4  * The contents of this file are subject to the terms of the
5  * Common Development and Distribution License, Version 1.0 only
6  * (the "License").  You may not use this file except in compliance
7  * with the License.
8  *
9  * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10  * or http://www.opensolaris.org/os/licensing.
11  * See the License for the specific language governing permissions
12  * and limitations under the License.
13  *
14  * When distributing Covered Code, include this CDDL HEADER in each
15  * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16  * If applicable, add the following below this CDDL HEADER, with the
17  * fields enclosed by brackets "[]" replaced with your own identifying
18  * information: Portions Copyright [yyyy] [name of copyright owner]
19  *
20  * CDDL HEADER END
21  */
22 /*
23  * awk -- functions
24  *
25  * Copyright (c) 1995, 1996 by Sun Microsystems, Inc.
26  * All rights reserved.
27  *
28  * Copyright 1986, 1994 by Mortice Kern Systems Inc.  All rights reserved.
29  *
30  * Based on MKS awk(1) ported to be /usr/xpg4/bin/awk with POSIX/XCU4 changes
31  */
32 
33 #pragma ident	"%Z%%M%	%I%	%E% SMI"
34 
35 #include "awk.h"
36 #include "y.tab.h"
37 #include <time.h>
38 #include <sys/wait.h>
39 
40 static uint	nargs(NODE *np);
41 static NODE	*dosub(NODE *np, int glob);
42 static NODE	*docasetr(NODE *np, int upper);
43 static int	asortcmp(const void *npp1, const void *npp2);
44 
45 static char	nargerr[] = "wrong number of arguments to function \"%s\"";
46 static NODE	*asortfunc;		/* Function call for asort() */
47 static NODE	*asnp1, *asnp2;		/* index1, index2 nodes */
48 static int	asarraylen;		/* strlen(array)+1 for asort */
49 
50 /*
51  * Return the value of exp(x).
52  * Usage:	y = exp(x)
53  *		y = exp()
54  */
55 NODE *
56 f_exp(NODE *np)
57 {
58 	register uint na;
59 
60 	if ((na = nargs(np)) > 1)
61 		awkerr(nargerr, s_exp);
62 	return (realnode(exp(exprreal(na==0 ? field0 : getlist(&np)))));
63 }
64 
65 /*
66  * Return the integer part of the argument.
67  * Usage:	i = int(r)
68  *		i = int()
69  */
70 NODE *
71 f_int(NODE *np)
72 {
73 	register uint na;
74 
75 	if ((na = nargs(np)) > 1)
76 		awkerr(nargerr, s_int);
77 	return (intnode(exprint(na==0 ? field0 : getlist(&np))));
78 }
79 
80 /*
81  * Logarithm function.
82  * Usage:	y = log(x)
83  *		y = log()
84  */
85 NODE *
86 f_log(NODE *np)
87 {
88 	register uint na;
89 
90 	if ((na = nargs(np)) > 1)
91 		awkerr(nargerr, s_log);
92 	return (realnode(log(exprreal(na==0 ? field0 : getlist(&np)))));
93 }
94 
95 /*
96  * Square root function.
97  * Usage:	y = sqrt(x)
98  *		y = sqrt()
99  */
100 NODE *
101 f_sqrt(NODE *np)
102 {
103 	register uint na;
104 
105 	if ((na = nargs(np)) > 1)
106 		awkerr(nargerr, s_sqrt);
107 	return (realnode(sqrt(exprreal(na==0 ? field0 : getlist(&np)))));
108 }
109 
110 /*
111  * Trigonometric sine function.
112  * Usage:	y = sin(x)
113  */
114 NODE *
115 f_sin(NODE *np)
116 {
117 	if (nargs(np) != 1)
118 		awkerr(nargerr, s_sin);
119 	return (realnode(sin(exprreal(getlist(&np)))));
120 }
121 
122 /*
123  * Trigonometric cosine function.
124  * Usage:	y = cos(x)
125  */
126 NODE *
127 f_cos(NODE *np)
128 {
129 	if (nargs(np) != 1)
130 		awkerr(nargerr, s_cos);
131 	return (realnode(cos(exprreal(getlist(&np)))));
132 }
133 
134 /*
135  * Arctangent of y/x.
136  * Usage:	z = atan2(y, x)
137  */
138 NODE *
139 f_atan2(NODE *np)
140 {
141 	double y, x;
142 
143 	if (nargs(np) != 2)
144 		awkerr(nargerr, s_atan2);
145 	y = (double)exprreal(getlist(&np));
146 	x = (double)exprreal(getlist(&np));
147 	return (realnode(atan2(y, x)));
148 }
149 
150 /*
151  * Set the seed for the random number generator function -- rand.
152  * Usage:	srand(x)
153  *		srand()
154  */
155 NODE *
156 f_srand(NODE *np)
157 {
158 	register uint na;
159 	register uint seed;
160 	static uint oldseed = 0;
161 
162 	if ((na = nargs(np)) > 1)
163 		awkerr(nargerr, s_srand);
164 	if (na == 0)
165 		seed = (uint)time((time_t *)0); else
166 		seed = (uint)exprint(getlist(&np));
167 	srand(seed);
168 	na = oldseed;
169 	oldseed = seed;
170 	return (intnode((INT)na));
171 }
172 
173 /*
174  * Generate a random number.
175  * Usage:	x = rand()
176  */
177 NODE *
178 f_rand(NODE *np)
179 {
180 	double result;
181 	int expon;
182 	ushort rint;
183 
184 	if (nargs(np) != 0)
185 		awkerr(nargerr, s_rand);
186 	rint = rand() & SHRT_MAX;
187 	result = frexp((double)rint, &expon);
188 	return (realnode((REAL)ldexp(result, expon-15)));
189 }
190 
191 /*
192  * Substitute function.
193  * Usage:	n = sub(regex, replace, target)
194  *		n = sub(regex, replace)
195  */
196 NODE *
197 f_sub(NODE *np)
198 {
199 	return (dosub(np, 1));
200 }
201 
202 /*
203  * Global substitution function.
204  * Usage:	n = gsub(regex, replace, target)
205  *		n = gsub(regex, replace)
206  */
207 NODE *
208 f_gsub(NODE *np)
209 {
210 	return (dosub(np, 0));
211 }
212 
213 /*
214  * Do actual substitutions.
215  * `glob' is the number to substitute, 0 for all.
216  */
217 static NODE *
218 dosub(NODE *np, int glob)
219 {
220 	wchar_t *text;
221 	register wchar_t *sub;
222 	register uint n;
223 	register uint na;
224 	register REGEXP rp;
225 	NODE *left;
226 	static wchar_t *buf;
227 
228 	if ((na = nargs(np)) != 2 && na != 3)
229 		awkerr(nargerr, glob==0 ? s_gsub : s_sub);
230 	rp = getregexp(getlist(&np));
231 	sub = exprstring(getlist(&np));
232 	if (na == 3) {
233 		left = getlist(&np);
234 		text = exprstring(left);
235 	} else {
236 		left = field0;
237 		text = linebuf;
238 	}
239 	switch (REGWDOSUBA(rp, sub, text, &buf, 256, &glob)) {
240 	case REG_OK:
241 	case REG_NOMATCH:
242 		n = glob;
243 		break;
244 	case REG_ESPACE:
245 		if (buf != NULL)
246 			free(buf);
247 		awkerr(nomem);
248 	default:
249 		awkerr(gettext("regular expression error"));
250 	}
251 	(void)assign(left, stringnode(buf, FNOALLOC, wcslen(buf)));
252 	return (intnode((INT)n));
253 }
254 
255 /*
256  * Match function.  Return position (origin 1) or 0 for regular
257  * expression match in string.  Set new variables RSTART and RLENGTH
258  * as well.
259  * Usage:	pos = match(string, re)
260  */
261 NODE *
262 f_match(NODE *np)
263 {
264 	register wchar_t *text;
265 	register REGEXP rp;
266 	register int pos, length;
267 	REGWMATCH_T match[10];
268 
269 	if (nargs(np) != 2)
270 		awkerr(nargerr, s_match);
271 	text = exprstring(getlist(&np));
272 	rp = getregexp(getlist(&np));
273 	if (REGWEXEC(rp, text, 10, match, 0) == REG_OK) {
274 		pos = match[0].rm_sp-text+1;
275 		length = match[0].rm_ep - match[0].rm_sp;
276 	} else {
277 		pos = 0;
278 		length = -1;
279 	}
280 	constant->n_int = length;
281 	(void)assign(vlook(M_MB_L("RLENGTH")), constant);
282 	return (assign(vlook(M_MB_L("RSTART")), intnode((INT)pos)));
283 }
284 
285 /*
286  * Call shell or command interpreter.
287  * Usage:	status = system(command)
288  */
289 NODE *
290 f_system(NODE *np)
291 {
292 	int retcode;
293 
294 	if (nargs(np) != 1)
295 		awkerr(nargerr, s_system);
296 	(void) fflush(stdout);
297 	retcode = system(mbunconvert(exprstring(getlist(&np))));
298 	return (intnode((INT)WEXITSTATUS(retcode)));
299 }
300 
301 /*
302  * Search for string within string.
303  * Usage:	pos = index(string1, string2)
304  */
305 NODE *
306 f_index(NODE *np)
307 {
308 	register wchar_t *s1, *s2;
309 	register int l1, l2;
310 	register int result;
311 
312 	if (nargs(np) != 2)
313 		awkerr(nargerr, s_index);
314 	s1 = (wchar_t *)exprstring(getlist(&np));
315 	s2 = (wchar_t *)exprstring(getlist(&np));
316 	l1 = wcslen(s1);
317 	l2 = wcslen(s2);
318 	result = 1;
319 	while (l2 <= l1) {
320 		if (memcmp(s1, s2, l2 * sizeof(wchar_t)) == 0)
321 			break;
322 		result++;
323 		s1++;
324 		l1--;
325 	}
326 	if (l2 > l1)
327 		result = 0;
328 	return (intnode((INT)result));
329 }
330 
331 /*
332  * Return length of argument or $0
333  * Usage:	n = length(string)
334  *		n = length()
335  *		n = length
336  */
337 NODE *
338 f_length(NODE *np)
339 {
340 	register uint na;
341 
342 	if ((na = nargs(np)) > 1)
343 		awkerr(nargerr, s_length);
344 	if (na == 0)
345 		na = lbuflen; else
346 		na = wcslen((wchar_t *)exprstring(getlist(&np)));
347 	return (intnode((INT)na));
348 }
349 
350 /*
351  * Split string into fields.
352  * Usage: nfields = split(string, array [, separator]);
353  */
354 NODE *
355 f_split(NODE *np)
356 {
357 	register wchar_t *cp;
358 	wchar_t *ep, *saved = 0;
359 	register NODE *tnp, *snp, *otnp;
360 	register NODE *sep;
361 	REGEXP old_resep = 0;
362 	size_t seplen;
363 	uint n;
364 	wint_t c;
365 	wchar_t savesep[20];
366 	wchar_t  *(*old_awkfield)(wchar_t **) = 0;
367 
368 	if ((n = nargs(np))<2 || n>3)
369 		awkerr(nargerr, s_split);
370 	ep = exprstring(snp = getlist(&np));
371 	tnp = getlist(&np);
372 	if (snp->n_type == INDEX && snp->n_left == tnp)
373 		ep = saved = wsdup(ep);
374 	if (n == 3) {
375 		sep = getlist(&np);
376 	} else
377 		sep = NNULL;
378 	switch (tnp->n_type) {
379 	case ARRAY:
380 		delarray(tnp);
381 		break;
382 
383 	case PARM:
384 		break;
385 
386 	case VAR:
387 		if (isstring(tnp->n_flags) && tnp->n_string==_null)
388 			break;
389 	default:
390 		awkerr(gettext(
391 			"second parameter to \"split\" must be an array"));
392 		/*NOTREACHED*/
393 	}
394 	/*
395 	 * If an argument has been passed in to be used as the
396 	 * field separator check to see if it is a constant regular
397 	 * expression. If so, use it directly otherwise reduce the
398 	 * expression, convert the result into a string and assign it
399 	 * to "FS" (after saving the old value for FS.)
400 	 */
401 	if (sep != NNULL) {
402 		if (sep->n_type == PARM)
403 			sep = sep->n_next;
404 		if (sep->n_type == RE) {
405 			old_resep = resep;
406 			resep = sep->n_regexp;
407 			old_awkfield = awkfield;
408 			awkfield = refield;
409 		} else {
410 			sep = exprreduce(sep);
411 			seplen = wcslen(cp = (wchar_t *)exprstring(varFS));
412 			(void) memcpy(savesep, cp,
413 				(seplen+1) * sizeof(wchar_t));
414 			(void) assign(varFS, sep);
415 		}
416 	}
417 	/*
418 	 * Iterate over the record, extracting each field and assigning it to
419 	 * the corresponding element in the array.
420 	 */
421 	otnp = tnp;	/* save tnp for possible promotion */
422 	tnp = node(INDEX, tnp, constant);
423 	fcount = 0;
424 	for (;;) {
425 		if ((cp = (*awkfield)(&ep)) == NULL) {
426 			if (fcount == 0) {
427 				if (otnp->n_type == PARM)
428 					otnp = otnp->n_next;
429 				promote(otnp);
430 			}
431 			break;
432 		}
433 		c = *ep;
434 		*ep = '\0';
435 		constant->n_int = ++fcount;
436 		(void)assign(tnp, stringnode(cp,FALLOC|FSENSE,(size_t)(ep-cp)));
437 		*ep = c;
438 	}
439 	/*
440 	 * Restore the old record separator/and or regular expression.
441 	 */
442 	if (sep != NNULL) {
443 		if (old_awkfield != 0) {
444 			resep = old_resep;
445 			awkfield = old_awkfield;
446 		} else {
447 			(void)assign(varFS,
448 				stringnode(savesep, FSTATIC, seplen));
449 		}
450 	}
451 	if (saved)
452 		free(saved);
453 	return (intnode((INT)fcount));
454 }
455 
456 /*
457  * Sprintf function.
458  * Usage:	string = sprintf(format, arg, ...)
459  */
460 NODE *
461 f_sprintf(NODE *np)
462 {
463         wchar_t *cp;
464         size_t length;
465 
466         if (nargs(np) == 0)
467                 awkerr(nargerr, s_sprintf);
468         length = xprintf(np, (FILE *)NULL, &cp);
469         np = stringnode(cp, FNOALLOC, length);
470         return (np);
471 }
472 
473 /*
474  * Substring.
475  * newstring = substr(string, start, [length])
476  */
477 NODE *
478 f_substr(NODE *np)
479 {
480 	register STRING str;
481 	register size_t n;
482 	register int start;
483 	register size_t len;
484 
485 	if ((n = nargs(np))<2 || n>3)
486 		awkerr(nargerr, s_substr);
487 	str = exprstring(getlist(&np));
488 	if ((start = (int)exprint(getlist(&np))-1) < 0)
489 		start = 0;
490 	if (n == 3) {
491 		int x;
492 		x = (int)exprint(getlist(&np));
493 		if (x < 0)
494 			len = 0;
495 		else
496 			len = (size_t)x;
497 	} else
498 		len = LARGE;
499 	n = wcslen((wchar_t *)str);
500 	if (start > n)
501 		start = n;
502 	n -= start;
503 	if (len > n)
504 		len = n;
505 	str += start;
506 	n = str[len];
507 	str[len] = '\0';
508 	np = stringnode(str, FALLOC, len);
509 	str[len] = n;
510 	return (np);
511 }
512 
513 /*
514  * Close an output or input file stream.
515  */
516 NODE *
517 f_close(NODE *np)
518 {
519 	register OFILE *op;
520 	register char *name;
521 
522 	if (nargs(np) != 1)
523 		awkerr(nargerr, s_close);
524 	name = mbunconvert(exprstring(getlist(&np)));
525 	for (op = &ofiles[0]; op < &ofiles[NIOSTREAM]; op++)
526 		if (op->f_fp!=FNULL && strcmp(name, op->f_name)==0) {
527 			awkclose(op);
528 			break;
529 		}
530 	if (op >= &ofiles[NIOSTREAM])
531 		return (const1);
532 	return (const0);
533 }
534 
535 /*
536  * Return the integer value of the first character of a string.
537  * Usage:	char = ord(string)
538  */
539 NODE *
540 f_ord(NODE *np)
541 {
542 	if (nargs(np) != 1)
543 		awkerr(nargerr, s_ord);
544 	return (intnode((INT)*exprstring(getlist(&np))));
545 }
546 
547 /*
548  * Return the argument string in lower case:
549  * Usage:
550  *	lower = tolower(upper)
551  */
552 NODE *
553 f_tolower(NODE *np)
554 {
555 	return (docasetr(np, 0));
556 }
557 
558 /*
559  * Return the argument string in upper case:
560  * Usage:
561  *	upper = toupper(lower)
562  */
563 NODE *
564 f_toupper(NODE *np)
565 {
566 	return (docasetr(np, 1));
567 }
568 
569 /*
570  * Sort the array into traversal order by the next "for (i in array)" loop.
571  * Usage:
572  *	asort(array, "cmpfunc")
573  * 	cmpfunc(array, index1, index2)
574  *		returns:
575  *		<0		if 	array[index1] <  array[index2]
576  *		 0		if	array[index1] == array[index2]
577  *		>0		if	array[index1] >  array[index2]
578  */
579 NODE *
580 f_asort(NODE *np)
581 {
582 	NODE *array;
583 	STRING funcname;
584 	register size_t nel;
585 	register NODE *tnp;
586 	register NODE *funcnp;
587 	register NODE **alist, **npp;
588 
589 	if (nargs(np) != 2)
590 		awkerr(nargerr, s_asort);
591 	array = getlist(&np);
592 	if (array->n_type == PARM)
593 		array = array->n_next;
594 	if (array->n_type != ARRAY)
595 		awkerr(gettext("%s function requires an array"),
596 			s_asort);
597 	funcname = exprstring(getlist(&np));
598 	if ((funcnp = vlookup(funcname, 1)) == NNULL
599 	 || funcnp->n_type != UFUNC)
600 		awkerr(gettext("%s: %s is not a function\n"),
601 		    s_asort, funcname);
602 	/*
603 	 * Count size of array, allowing one extra for NULL at end
604 	 */
605 	nel = 1;
606 	for (tnp = array->n_alink; tnp != NNULL; tnp = tnp->n_alink)
607 		++nel;
608 	/*
609 	 * Create UFUNC node that points at the funcnp on left and the
610 	 * list of three variables on right (array, index1, index2)
611 	 *				UFUNC
612 	 *				/    \
613 	 *			   funcnp    COMMA
614 	 *				      /   \
615 	 *				array	  COMMA
616 	 *					  /    \
617 	 *					index1 index2
618 	 */
619 	if (asortfunc == NNULL) {
620 		running = 0;
621 		asortfunc = node(CALLUFUNC, NNULL,
622 				    node(COMMA, NNULL,
623 				    node(COMMA,
624 					asnp1=stringnode(_null, FSTATIC, 0),
625 					asnp2=stringnode(_null, FSTATIC, 0))));
626 		running = 1;
627 	}
628 	asortfunc->n_left = funcnp;
629 	asortfunc->n_right->n_left = array;
630 	asarraylen = wcslen(array->n_name)+1;
631 	alist = (NODE **) emalloc(nel*sizeof(NODE *));
632 	/*
633 	 * Copy array into alist.
634 	 */
635 	npp = alist;
636 	for (tnp = array->n_alink; tnp != NNULL; tnp = tnp->n_alink)
637 		*npp++ = tnp;
638 	*npp = NNULL;
639 	/*
640 	 * Re-order array to this list
641 	 */
642 	qsort((wchar_t *)alist, nel-1, sizeof (NODE *), asortcmp);
643 	tnp = array;
644 	npp = alist;
645 	do {
646 		tnp = tnp->n_alink = *npp;
647 	} while (*npp++ != NNULL);
648 	free((wchar_t *)alist);
649 	return (constundef);
650 }
651 
652 /*
653  * Return the number of arguments of a function.
654  */
655 static uint
656 nargs(NODE *np)
657 {
658 	register int n;
659 
660 	if (np == NNULL)
661 		return (0);
662 	n = 1;
663 	while (np!=NNULL && np->n_type==COMMA) {
664 		np = np->n_right;
665 		n++;
666 	}
667 	return (n);
668 }
669 
670 /*
671  * Do case translation.
672  */
673 static NODE *
674 docasetr(NODE *np, int upper)
675 {
676 	register int c;
677 	register wchar_t *cp;
678 	register wchar_t *str;
679 	register uint na;
680 
681 	if ((na = nargs(np)) > 1)
682 		awkerr(nargerr, upper ? s_toupper : s_tolower);
683 	str = strsave(na==0 ? linebuf : exprstring(getlist(&np)));
684 	cp = str;
685 	if (upper) {
686 		while ((c = *cp++) != '\0')
687 			cp[-1] = towupper(c);
688 	} else {
689 		while ((c = *cp++) != '\0')
690 			cp[-1] = towlower(c);
691 	}
692 	return (stringnode((STRING)str, FNOALLOC, (size_t)(cp-str-1)));
693 }
694 
695 /*
696  * The comparison routine used by qsort inside f_asort()
697  */
698 static int
699 asortcmp(const void *npp1, const void *npp2)
700 {
701 	asnp1->n_strlen =
702 	    wcslen(asnp1->n_string = (*(NODE **)npp1)->n_name+asarraylen);
703 	asnp2->n_strlen =
704 	    wcslen(asnp2->n_string = (*(NODE **)npp2)->n_name+asarraylen);
705 	return ((int)exprint(asortfunc));
706 }
707 
708 #if M_MATHERR
709 #if !defined(__BORLANDC__)&&defined(__TURBOC__)&&__COMPACT__&&__EMULATE__
710 /* So it won't optimize registers our FP is using */
711 #define	flushesbx()	(_BX = 0, _ES = _BX)
712 #else
713 #define	flushesbx()	(0)
714 #endif
715 
716 /*
717  * Math error for awk.
718  */
719 int
720 matherr(struct exception *ep)
721 {
722 	register uint type;
723 	static char msgs[7][256];
724 	static int first_time = 1;
725 
726 	if (first_time) {
727 		msgs[0] = gettext("Unknown FP error"),
728 		msgs[1] = gettext("Domain"),
729 		msgs[2] = gettext("Singularity"),
730 		msgs[3] = gettext("Overflow"),
731 		msgs[4] = gettext("Underflow"),
732 		msgs[5] = gettext("Total loss of precision"),
733 		msgs[6] = gettext("Partial loss of precision")
734 		first_time = 0;
735 	}
736 
737 	if ((type = ep->type) > (uint)PLOSS)
738 		type = 0;
739 	(void)fprintf(stderr, "awk: %s", strmsg(msgs[type]));
740 	(void)fprintf(stderr, gettext(
741 		" error in function %s(%g) at NR=%lld\n"),
742 		((void) flushesbx(), ep->name), ep->arg1, (INT)exprint(varNR));
743 	return (1);
744 }
745 #endif	/*M_MATHERR*/
746