diff options
Diffstat (limited to 'contrib/awk/builtin.c')
| -rw-r--r-- | contrib/awk/builtin.c | 2499 |
1 files changed, 0 insertions, 2499 deletions
diff --git a/contrib/awk/builtin.c b/contrib/awk/builtin.c deleted file mode 100644 index dcf3ac3..0000000 --- a/contrib/awk/builtin.c +++ /dev/null @@ -1,2499 +0,0 @@ -/* - * builtin.c - Builtin functions and various utility procedures - */ - -/* - * Copyright (C) 1986, 1988, 1989, 1991-2001 the Free Software Foundation, Inc. - * - * This file is part of GAWK, the GNU implementation of the - * AWK Programming Language. - * - * GAWK is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * GAWK is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA - * - * $FreeBSD$ - */ - - -#include "awk.h" -#if defined(HAVE_FCNTL_H) -#include <fcntl.h> -#endif -#undef HUGE -#undef CHARBITS -#undef INTBITS -#include <math.h> -#ifndef __FreeBSD__ -#include "random.h" - -/* can declare these, since we always use the random shipped with gawk */ -extern char *initstate P((unsigned long seed, char *state, long n)); -extern char *setstate P((char *state)); -extern long random P((void)); -extern void srandom P((unsigned long seed)); -#endif - -extern NODE **fields_arr; -extern int output_is_tty; - -static NODE *sub_common P((NODE *tree, int how_many, int backdigs)); - -#ifdef _CRAY -/* Work around a problem in conversion of doubles to exact integers. */ -#include <float.h> -#define Floor(n) floor((n) * (1.0 + DBL_EPSILON)) -#define Ceil(n) ceil((n) * (1.0 + DBL_EPSILON)) - -/* Force the standard C compiler to use the library math functions. */ -extern double exp(double); -double (*Exp)() = exp; -#define exp(x) (*Exp)(x) -extern double log(double); -double (*Log)() = log; -#define log(x) (*Log)(x) -#else -#define Floor(n) floor(n) -#define Ceil(n) ceil(n) -#endif - -#define DEFAULT_G_PRECISION 6 - -#ifdef GFMT_WORKAROUND -/* semi-temporary hack, mostly to gracefully handle VMS */ -static void sgfmt P((char *buf, const char *format, int alt, - int fwidth, int precision, double value)); -#endif /* GFMT_WORKAROUND */ - -/* - * Since we supply the version of random(), we know what - * value to use here. - */ -#define GAWK_RANDOM_MAX 0x7fffffffL - -static void efwrite P((const void *ptr, size_t size, size_t count, FILE *fp, - const char *from, struct redirect *rp, int flush)); - -/* efwrite --- like fwrite, but with error checking */ - -static void -efwrite(const void *ptr, - size_t size, - size_t count, - FILE *fp, - const char *from, - struct redirect *rp, - int flush) -{ - errno = 0; - if (fwrite(ptr, size, count, fp) != count) - goto wrerror; - if (flush - && ((fp == stdout && output_is_tty) - || (rp != NULL && (rp->flag & RED_NOBUF)))) { - fflush(fp); - if (ferror(fp)) - goto wrerror; - } - return; - -wrerror: - fatal(_("%s to \"%s\" failed (%s)"), from, - rp ? rp->value : _("standard output"), - errno ? strerror(errno) : _("reason unknown")); -} - -/* do_exp --- exponential function */ - -NODE * -do_exp(NODE *tree) -{ - NODE *tmp; - double d, res; - - tmp = tree_eval(tree->lnode); - if (do_lint && (tmp->flags & (NUM|NUMBER)) == 0) - lintwarn(_("exp: received non-numeric argument")); - d = force_number(tmp); - free_temp(tmp); - errno = 0; - res = exp(d); - if (errno == ERANGE) - warning(_("exp: argument %g is out of range"), d); - return tmp_number((AWKNUM) res); -} - -/* stdfile --- return fp for a standard file */ - -/* - * This function allows `fflush("/dev/stdout")' to work. - * The other files will be available via getredirect(). - * /dev/stdin is not included, since fflush is only for output. - */ - -static FILE * -stdfile(char *name, size_t len) -{ - if (len == 11) { - if (STREQN(name, "/dev/stderr", 11)) - return stderr; - else if (STREQN(name, "/dev/stdout", 11)) - return stdout; - } - - return NULL; -} - -/* do_fflush --- flush output, either named file or pipe or everything */ - -NODE * -do_fflush(NODE *tree) -{ - struct redirect *rp; - NODE *tmp; - FILE *fp; - int status = 0; - char *file; - - /* fflush() --- flush stdout */ - if (tree == NULL) { - status = fflush(stdout); - return tmp_number((AWKNUM) status); - } - - tmp = tree_eval(tree->lnode); - tmp = force_string(tmp); - file = tmp->stptr; - - /* fflush("") --- flush all */ - if (tmp->stlen == 0) { - status = flush_io(); - free_temp(tmp); - return tmp_number((AWKNUM) status); - } - - rp = getredirect(tmp->stptr, tmp->stlen); - status = -1; - if (rp != NULL) { - if ((rp->flag & (RED_WRITE|RED_APPEND)) == 0) { - if (rp->flag & RED_PIPE) - warning(_("fflush: cannot flush: pipe `%s' opened for reading, not writing"), - file); - else - warning(_("fflush: cannot flush: file `%s' opened for reading, not writing"), - file); - free_temp(tmp); - return tmp_number((AWKNUM) status); - } - fp = rp->fp; - if (fp != NULL) - status = fflush(fp); - } else if ((fp = stdfile(tmp->stptr, tmp->stlen)) != NULL) { - status = fflush(fp); - } else { - status = -1; - warning(_("fflush: `%s' is not an open file, pipe or co-process"), file); - } - free_temp(tmp); - return tmp_number((AWKNUM) status); -} - -/* do_index --- find index of a string */ - -NODE * -do_index(NODE *tree) -{ - NODE *s1, *s2; - register char *p1, *p2; - register size_t l1, l2; - long ret; - - - s1 = tree_eval(tree->lnode); - s2 = tree_eval(tree->rnode->lnode); - if (do_lint) { - if ((s1->flags & (STRING|STR)) == 0) - lintwarn(_("index: received non-string first argument")); - if ((s2->flags & (STRING|STR)) == 0) - lintwarn(_("index: received non-string second argument")); - } - force_string(s1); - force_string(s2); - p1 = s1->stptr; - p2 = s2->stptr; - l1 = s1->stlen; - l2 = s2->stlen; - ret = 0; - - /* IGNORECASE will already be false if posix */ - if (IGNORECASE) { - while (l1 > 0) { - if (l2 > l1) - break; - if (casetable[(unsigned char)*p1] == casetable[(unsigned char)*p2] - && (l2 == 1 || strncasecmp(p1, p2, l2) == 0)) { - ret = 1 + s1->stlen - l1; - break; - } - l1--; - p1++; - } - } else { - while (l1 > 0) { - if (l2 > l1) - break; - if (*p1 == *p2 - && (l2 == 1 || STREQN(p1, p2, l2))) { - ret = 1 + s1->stlen - l1; - break; - } - l1--; - p1++; - } - } - free_temp(s1); - free_temp(s2); - return tmp_number((AWKNUM) ret); -} - -/* double_to_int --- convert double to int, used several places */ - -double -double_to_int(double d) -{ - if (d >= 0) - d = Floor(d); - else - d = Ceil(d); - return d; -} - -/* do_int --- convert double to int for awk */ - -NODE * -do_int(NODE *tree) -{ - NODE *tmp; - double d; - - tmp = tree_eval(tree->lnode); - if (do_lint && (tmp->flags & (NUM|NUMBER)) == 0) - lintwarn(_("int: received non-numeric argument")); - d = force_number(tmp); - d = double_to_int(d); - free_temp(tmp); - return tmp_number((AWKNUM) d); -} - -/* do_length --- length of a string or $0 */ - -NODE * -do_length(NODE *tree) -{ - NODE *tmp; - size_t len; - - tmp = tree_eval(tree->lnode); - if (do_lint && (tmp->flags & (STRING|STR)) == 0) - lintwarn(_("length: received non-string argument")); - len = force_string(tmp)->stlen; - free_temp(tmp); - return tmp_number((AWKNUM) len); -} - -/* do_log --- the log function */ - -NODE * -do_log(NODE *tree) -{ - NODE *tmp; - double d, arg; - - tmp = tree_eval(tree->lnode); - if (do_lint && (tmp->flags & (NUM|NUMBER)) == 0) - lintwarn(_("log: received non-numeric argument")); - arg = (double) force_number(tmp); - if (arg < 0.0) - warning(_("log: received negative argument %g"), arg); - d = log(arg); - free_temp(tmp); - return tmp_number((AWKNUM) d); -} - -/* - * format_tree() formats nodes of a tree, starting with a left node, - * and accordingly to a fmt_string providing a format like in - * printf family from C library. Returns a string node which value - * is a formatted string. Called by sprintf function. - * - * It is one of the uglier parts of gawk. Thanks to Michal Jaegermann - * for taming this beast and making it compatible with ANSI C. - */ - -NODE * -format_tree( - const char *fmt_string, - int n0, - register NODE *carg, - int num_args) -{ -/* copy 'l' bytes from 's' to 'obufout' checking for space in the process */ -/* difference of pointers should be of ptrdiff_t type, but let us be kind */ -#define bchunk(s, l) if (l) { \ - while ((l) > ofre) { \ - long olen = obufout - obuf; \ - erealloc(obuf, char *, osiz * 2, "format_tree"); \ - ofre += osiz; \ - osiz *= 2; \ - obufout = obuf + olen; \ - } \ - memcpy(obufout, s, (size_t) (l)); \ - obufout += (l); \ - ofre -= (l); \ -} - -/* copy one byte from 's' to 'obufout' checking for space in the process */ -#define bchunk_one(s) { \ - if (ofre <= 0) { \ - long olen = obufout - obuf; \ - erealloc(obuf, char *, osiz * 2, "format_tree"); \ - ofre += osiz; \ - osiz *= 2; \ - obufout = obuf + olen; \ - } \ - *obufout++ = *s; \ - --ofre; \ -} - -/* Is there space for something L big in the buffer? */ -#define chksize(l) if ((l) > ofre) { \ - long olen = obufout - obuf; \ - erealloc(obuf, char *, osiz * 2, "format_tree"); \ - obufout = obuf + olen; \ - ofre += osiz; \ - osiz *= 2; \ -} - - static NODE **the_args = 0; - static size_t args_size = 0; - size_t cur_arg = 0; - - auto NODE **save_args = 0; - auto size_t save_args_size = 0; - static int call_level = 0; - - NODE *r; - int i; - int toofew = FALSE; - char *obuf, *obufout; - size_t osiz, ofre; - char *chbuf; - const char *s0, *s1; - int cs1; - NODE *arg; - long fw, prec, argnum; - int used_dollar; - int lj, alt, big, bigbig, small, have_prec, need_format; - long *cur = NULL; -#ifdef sun386 /* Can't cast unsigned (int/long) from ptr->value */ - long tmp_uval; /* on 386i 4.0.1 C compiler -- it just hangs */ -#endif - unsigned long uval; - int sgn; - int base = 0; - char cpbuf[30]; /* if we have numbers bigger than 30 */ - char *cend = &cpbuf[30];/* chars, we lose, but seems unlikely */ - char *cp; - char *fill; - double tmpval; - char signchar = FALSE; - size_t len; - int zero_flag = FALSE; - static char sp[] = " "; - static char zero_string[] = "0"; - static char lchbuf[] = "0123456789abcdef"; - static char Uchbuf[] = "0123456789ABCDEF"; - -#define INITIAL_OUT_SIZE 512 - emalloc(obuf, char *, INITIAL_OUT_SIZE, "format_tree"); - obufout = obuf; - osiz = INITIAL_OUT_SIZE; - ofre = osiz - 1; - - /* - * Icky problem. If the args make a nested call to printf/sprintf, - * we end up clobbering the static variable `the_args'. Not good. - * We don't just malloc and free the_args each time, since most of the - * time there aren't nested calls. But if this is a nested call, - * save the memory pointed to by the_args and allocate a fresh - * array. Then free it on end. - */ - if (++call_level > 1) { /* nested */ - save_args = the_args; - save_args_size = args_size; - - args_size = 0; /* force fresh allocation */ - } - - if (args_size == 0) { - /* allocate array */ - emalloc(the_args, NODE **, (num_args+1) * sizeof(NODE *), "format_tree"); - args_size = num_args + 1; - } else if (num_args + 1 > args_size) { - /* grow it */ - erealloc(the_args, NODE **, (num_args+1) * sizeof(NODE *), "format_tree"); - args_size = num_args + 1; - } - - - /* fill it in */ - /* - * We ignore the_args[0] since format strings use - * 1-based numbers to indicate the arguments. It's - * easiest to just convert to int and index, without - * having to remember to subtract 1. - */ - memset(the_args, '\0', num_args * sizeof(NODE *)); - for (i = 1; carg != NULL; i++, carg = carg->rnode) { - NODE *tmp; - - /* Here lies the wumpus's other brother. R.I.P. */ - tmp = tree_eval(carg->lnode); - the_args[i] = dupnode(tmp); - free_temp(tmp); - } - assert(i == num_args); - cur_arg = 1; - - /* - * Check first for use of `count$'. - * If plain argument retrieval was used earlier, choke. - * Otherwise, return the requested argument. - * If not `count$' now, but it was used earlier, choke. - * If this format is more than total number of args, choke. - * Otherwise, return the current argument. - */ -#define parse_next_arg() { \ - if (argnum > 0) { \ - if (cur_arg > 1) \ - fatal(_("must use `count$' on all formats or none")); \ - arg = the_args[argnum]; \ - } else if (used_dollar) { \ - fatal(_("must use `count$' on all formats or none")); \ - arg = 0; /* shutup the compiler */ \ - } else if (cur_arg >= num_args) { \ - arg = 0; /* shutup the compiler */ \ - toofew = TRUE; \ - break; \ - } else { \ - arg = the_args[cur_arg]; \ - cur_arg++; \ - } \ -} - - need_format = FALSE; - used_dollar = FALSE; - - s0 = s1 = fmt_string; - while (n0-- > 0) { - if (*s1 != '%') { - s1++; - continue; - } - need_format = TRUE; - bchunk(s0, s1 - s0); - s0 = s1; - cur = &fw; - fw = 0; - prec = 0; - argnum = 0; - have_prec = FALSE; - signchar = FALSE; - zero_flag = FALSE; - lj = alt = big = bigbig = small = FALSE; - fill = sp; - cp = cend; - chbuf = lchbuf; - s1++; - -retry: - if (n0-- <= 0) /* ran out early! */ - break; - - switch (cs1 = *s1++) { - case (-1): /* dummy case to allow for checking */ -check_pos: - if (cur != &fw) - break; /* reject as a valid format */ - goto retry; - case '%': - need_format = FALSE; - bchunk_one("%"); - s0 = s1; - break; - - case '0': - /* - * Only turn on zero_flag if we haven't seen - * the field width or precision yet. Otherwise, - * screws up floating point formatting. - */ - if (cur == & fw) - zero_flag = TRUE; - if (lj) - goto retry; - /* FALL through */ - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - if (cur == NULL) - break; - if (prec >= 0) - *cur = cs1 - '0'; - /* - * with a negative precision *cur is already set - * to -1, so it will remain negative, but we have - * to "eat" precision digits in any case - */ - while (n0 > 0 && *s1 >= '0' && *s1 <= '9') { - --n0; - *cur = *cur * 10 + *s1++ - '0'; - } - if (prec < 0) /* negative precision is discarded */ - have_prec = FALSE; - if (cur == &prec) - cur = NULL; - if (n0 == 0) /* badly formatted control string */ - continue; - goto retry; - case '$': - if (do_traditional) - fatal(_("`$' is not permitted in awk formats")); - if (cur == &fw) { - argnum = fw; - fw = 0; - used_dollar = TRUE; - if (argnum <= 0) - fatal(_("arg count with `$' must be > 0")); - if (argnum >= num_args) - fatal(_("arg count %d greater than total number of supplied arguments"), argnum); - } else - fatal(_("`$' not permitted after period in format")); - goto retry; - case '*': - if (cur == NULL) - break; - if (! do_traditional && ISDIGIT(*s1)) { - int val = 0; - - for (; n0 > 0 && *s1 && ISDIGIT(*s1); s1++, n0--) { - val *= 10; - val += *s1 - '0'; - } - if (*s1 != '$') { - fatal(_("no `$' supplied for positional field width or precision")); - } else { - s1++; - n0--; - } - - arg = the_args[val]; - } else { - parse_next_arg(); - } - *cur = force_number(arg); - if (*cur < 0 && cur == &fw) { - *cur = -*cur; - lj++; - } - if (cur == &prec) { - if (*cur >= 0) - have_prec = TRUE; - else - have_prec = FALSE; - cur = NULL; - } - goto retry; - case ' ': /* print ' ' or '-' */ - /* 'space' flag is ignored */ - /* if '+' already present */ - if (signchar != FALSE) - goto check_pos; - /* FALL THROUGH */ - case '+': /* print '+' or '-' */ - signchar = cs1; - goto check_pos; - case '-': - if (prec < 0) - break; - if (cur == &prec) { - prec = -1; - goto retry; - } - fill = sp; /* if left justified then other */ - lj++; /* filling is ignored */ - goto check_pos; - case '.': - if (cur != &fw) - break; - cur = ≺ - have_prec = TRUE; - goto retry; - case '#': - alt = TRUE; - goto check_pos; - case 'l': - if (big) - break; - else { - static int warned = FALSE; - - if (do_lint && ! warned) { - lintwarn(_("`l' is meaningless in awk formats; ignored")); - warned = TRUE; - } - if (do_posix) - fatal(_("`l' is not permitted in POSIX awk formats")); - } - big = TRUE; - goto retry; - case 'L': - if (bigbig) - break; - else { - static int warned = FALSE; - - if (do_lint && ! warned) { - lintwarn(_("`L' is meaningless in awk formats; ignored")); - warned = TRUE; - } - if (do_posix) - fatal(_("`L' is not permitted in POSIX awk formats")); - } - bigbig = TRUE; - goto retry; - case 'h': - if (small) - break; - else { - static int warned = FALSE; - - if (do_lint && ! warned) { - lintwarn(_("`h' is meaningless in awk formats; ignored")); - warned = TRUE; - } - if (do_posix) - fatal(_("`h' is not permitted in POSIX awk formats")); - } - small = TRUE; - goto retry; - case 'c': - need_format = FALSE; - if (zero_flag && ! lj) - fill = zero_string; - parse_next_arg(); - /* user input that looks numeric is numeric */ - if ((arg->flags & (MAYBE_NUM|NUMBER)) == MAYBE_NUM) - (void) force_number(arg); - if (arg->flags & NUMBER) { -#ifdef sun386 - tmp_uval = arg->numbr; - uval = (unsigned long) tmp_uval; -#else - uval = (unsigned long) arg->numbr; -#endif - cpbuf[0] = uval; - prec = 1; - cp = cpbuf; - goto pr_tail; - } - if (have_prec == FALSE) - prec = 1; - else if (prec > arg->stlen) - prec = arg->stlen; - cp = arg->stptr; - goto pr_tail; - case 's': - need_format = FALSE; - if (zero_flag && ! lj) - fill = zero_string; - parse_next_arg(); - arg = force_string(arg); - if (! have_prec || prec > arg->stlen) - prec = arg->stlen; - cp = arg->stptr; - goto pr_tail; - case 'd': - case 'i': - need_format = FALSE; - parse_next_arg(); - tmpval = force_number(arg); - - /* - * ``The result of converting a zero value with a - * precision of zero is no characters.'' - */ - if (have_prec && prec == 0 && tmpval == 0) - goto pr_tail; - - if (tmpval < 0) { - if (tmpval < LONG_MIN) - goto out_of_range; - sgn = TRUE; - uval = - (unsigned long) (long) tmpval; - } else { - /* Use !, so that NaNs are out of range. - The cast avoids a SunOS 4.1.x cc bug. */ - if (! (tmpval <= (unsigned long) ULONG_MAX)) - goto out_of_range; - sgn = FALSE; - uval = (unsigned long) tmpval; - } - do { - *--cp = (char) ('0' + uval % 10); - uval /= 10; - } while (uval > 0); - - /* add more output digits to match the precision */ - if (have_prec) { - while (cend - cp < prec) - *--cp = '0'; - } - - if (sgn) - *--cp = '-'; - else if (signchar) - *--cp = signchar; - /* - * When to fill with zeroes is of course not simple. - * First: No zero fill if left-justifying. - * Next: There seem to be two cases: - * A '0' without a precision, e.g. %06d - * A precision with no field width, e.g. %.10d - * Any other case, we don't want to fill with zeroes. - */ - if (! lj - && ((zero_flag && ! have_prec) - || (fw == 0 && have_prec))) - fill = zero_string; - if (prec > fw) - fw = prec; - prec = cend - cp; - if (fw > prec && ! lj && fill != sp - && (*cp == '-' || signchar)) { - bchunk_one(cp); - cp++; - prec--; - fw--; - } - goto pr_tail; - case 'X': - chbuf = Uchbuf; /* FALL THROUGH */ - case 'x': - base += 6; /* FALL THROUGH */ - case 'u': - base += 2; /* FALL THROUGH */ - case 'o': - base += 8; - need_format = FALSE; - parse_next_arg(); - tmpval = force_number(arg); - - /* - * ``The result of converting a zero value with a - * precision of zero is no characters.'' - * - * If I remember the ANSI C standard, though, - * it says that for octal conversions - * the precision is artificially increased - * to add an extra 0 if # is supplied. - * Indeed, in C, - * printf("%#.0o\n", 0); - * prints a single 0. - */ - if (! alt && have_prec && prec == 0 && tmpval == 0) - goto pr_tail; - - if (tmpval < 0) { - if (tmpval < LONG_MIN) - goto out_of_range; - uval = (unsigned long) (long) tmpval; - } else { - /* Use !, so that NaNs are out of range. - The cast avoids a SunOS 4.1.x cc bug. */ - if (! (tmpval <= (unsigned long) ULONG_MAX)) - goto out_of_range; - uval = (unsigned long) tmpval; - } - /* - * When to fill with zeroes is of course not simple. - * First: No zero fill if left-justifying. - * Next: There seem to be two cases: - * A '0' without a precision, e.g. %06d - * A precision with no field width, e.g. %.10d - * Any other case, we don't want to fill with zeroes. - */ - if (! lj - && ((zero_flag && ! have_prec) - || (fw == 0 && have_prec))) - fill = zero_string; - do { - *--cp = chbuf[uval % base]; - uval /= base; - } while (uval > 0); - - /* add more output digits to match the precision */ - if (have_prec) { - while (cend - cp < prec) - *--cp = '0'; - } - - if (alt && tmpval != 0) { - if (base == 16) { - *--cp = cs1; - *--cp = '0'; - if (fill != sp) { - bchunk(cp, 2); - cp += 2; - fw -= 2; - } - } else if (base == 8) - *--cp = '0'; - } - base = 0; - if (prec > fw) - fw = prec; - prec = cend - cp; - pr_tail: - if (! lj) { - while (fw > prec) { - bchunk_one(fill); - fw--; - } - } - bchunk(cp, (int) prec); - while (fw > prec) { - bchunk_one(fill); - fw--; - } - s0 = s1; - break; - - out_of_range: - /* out of range - emergency use of %g format */ - cs1 = 'g'; - goto format_float; - - case 'g': - case 'G': - case 'e': - case 'f': - case 'E': - need_format = FALSE; - parse_next_arg(); - tmpval = force_number(arg); - format_float: - if (! have_prec) - prec = DEFAULT_G_PRECISION; - chksize(fw + prec + 9); /* 9 == slop */ - - cp = cpbuf; - *cp++ = '%'; - if (lj) - *cp++ = '-'; - if (signchar) - *cp++ = signchar; - if (alt) - *cp++ = '#'; - if (zero_flag) - *cp++ = '0'; - strcpy(cp, "*.*"); - cp += 3; - *cp++ = cs1; - *cp = '\0'; -#ifndef GFMT_WORKAROUND - (void) sprintf(obufout, cpbuf, - (int) fw, (int) prec, (double) tmpval); -#else /* GFMT_WORKAROUND */ - if (cs1 == 'g' || cs1 == 'G') - sgfmt(obufout, cpbuf, (int) alt, - (int) fw, (int) prec, (double) tmpval); - else - (void) sprintf(obufout, cpbuf, - (int) fw, (int) prec, (double) tmpval); -#endif /* GFMT_WORKAROUND */ - len = strlen(obufout); - ofre -= len; - obufout += len; - s0 = s1; - break; - default: - break; - } - if (toofew) - fatal("%s\n\t`%s'\n\t%*s%s", - _("not enough arguments to satisfy format string"), - fmt_string, s1 - fmt_string - 2, "", - _("^ ran out for this one")); - } - if (do_lint) { - if (need_format) - lintwarn( - _("[s]printf: format specifier does not have control letter")); - if (carg != NULL) - lintwarn( - _("too many arguments supplied for format string")); - } - bchunk(s0, s1 - s0); - r = make_str_node(obuf, obufout - obuf, ALREADY_MALLOCED); - r->flags |= TEMP; - - for (i = 1; i < num_args; i++) { - unref(the_args[i]); - } - - if (call_level-- > 1) { - free(the_args); - the_args = save_args; - args_size = save_args_size; - } - - return r; -} - -/* do_sprintf --- perform sprintf */ - -NODE * -do_sprintf(NODE *tree) -{ - NODE *r; - NODE *sfmt = force_string(tree_eval(tree->lnode)); - - r = format_tree(sfmt->stptr, sfmt->stlen, tree->rnode, tree->printf_count); - free_temp(sfmt); - return r; -} - -/* do_printf --- perform printf, including redirection */ - -void -do_printf(NODE *tree) -{ - struct redirect *rp = NULL; - register FILE *fp; - - if (tree->lnode == NULL) { - if (do_traditional) { - if (do_lint) - lintwarn(_("printf: no arguments")); - return; /* bwk accepts it silently */ - } - fatal(_("printf: no arguments")); - } - - if (tree->rnode != NULL) { - int errflg; /* not used, sigh */ - - rp = redirect(tree->rnode, &errflg); - if (rp != NULL) { - fp = rp->fp; - if (fp == NULL) - return; - } else - return; - } else - fp = stdout; - tree->lnode->printf_count = tree->printf_count; - tree = do_sprintf(tree->lnode); - efwrite(tree->stptr, sizeof(char), tree->stlen, fp, "printf", rp, TRUE); - if (rp != NULL && (rp->flag & RED_TWOWAY) != 0) - fflush(rp->fp); - free_temp(tree); -} - -/* do_sqrt --- do the sqrt function */ - -NODE * -do_sqrt(NODE *tree) -{ - NODE *tmp; - double arg; - - tmp = tree_eval(tree->lnode); - if (do_lint && (tmp->flags & (NUM|NUMBER)) == 0) - lintwarn(_("sqrt: received non-numeric argument")); - arg = (double) force_number(tmp); - free_temp(tmp); - if (arg < 0.0) - warning(_("sqrt: called with negative argument %g"), arg); - return tmp_number((AWKNUM) sqrt(arg)); -} - -/* do_substr --- do the substr function */ - -NODE * -do_substr(NODE *tree) -{ - NODE *t1, *t2, *t3; - NODE *r; - register size_t indx; - size_t length; - double d_index, d_length; - - t1 = force_string(tree_eval(tree->lnode)); - t2 = tree_eval(tree->rnode->lnode); - d_index = force_number(t2); - free_temp(t2); - - if (d_index < 1.0) { - if (do_lint) - lintwarn(_("substr: start index %g is invalid, using 1"), - d_index); - d_index = 1; - } - if (do_lint && double_to_int(d_index) != d_index) - lintwarn(_("substr: non-integer start index %g will be truncated"), - d_index); - - indx = d_index - 1; /* awk indices are from 1, C's are from 0 */ - - if (tree->rnode->rnode == NULL) { /* third arg. missing */ - /* use remainder of string */ - length = t1->stlen - indx; - } else { - t3 = tree_eval(tree->rnode->rnode->lnode); - d_length = force_number(t3); - free_temp(t3); - if (d_length <= 0.0) { - if (do_lint) - lintwarn(_("substr: length %g is <= 0"), d_length); - free_temp(t1); - return Nnull_string; - } - if (do_lint && double_to_int(d_length) != d_length) - lintwarn( - _("substr: non-integer length %g will be truncated"), - d_length); - length = d_length; - } - - if (t1->stlen == 0) { - if (do_lint) - lintwarn(_("substr: source string is zero length")); - free_temp(t1); - return Nnull_string; - } - if ((indx + length) > t1->stlen) { - if (do_lint) - lintwarn( - _("substr: length %d at start index %d exceeds length of first argument (%d)"), - length, indx+1, t1->stlen); - length = t1->stlen - indx; - } - if (indx >= t1->stlen) { - if (do_lint) - lintwarn(_("substr: start index %d is past end of string"), - indx+1); - free_temp(t1); - return Nnull_string; - } - r = tmp_string(t1->stptr + indx, length); - free_temp(t1); - return r; -} - -/* do_strftime --- format a time stamp */ - -NODE * -do_strftime(NODE *tree) -{ - NODE *t1, *t2, *ret; - struct tm *tm; - time_t fclock; - char *bufp; - size_t buflen, bufsize; - char buf[BUFSIZ]; - /* FIXME: One day make %d be %e, after C 99 is common. */ - static char def_format[] = "%a %b %d %H:%M:%S %Z %Y"; - char *format; - int formatlen; - - /* set defaults first */ - format = def_format; /* traditional date format */ - formatlen = strlen(format); - (void) time(&fclock); /* current time of day */ - - t1 = t2 = NULL; - if (tree != NULL) { /* have args */ - if (tree->lnode != NULL) { - NODE *tmp = tree_eval(tree->lnode); - if (do_lint && (tmp->flags & (STRING|STR)) == 0) - lintwarn(_("strftime: recieved non-string first argument")); - t1 = force_string(tmp); - format = t1->stptr; - formatlen = t1->stlen; - if (formatlen == 0) { - if (do_lint) - lintwarn(_("strftime: received empty format string")); - free_temp(t1); - return tmp_string("", 0); - } - } - - if (tree->rnode != NULL) { - t2 = tree_eval(tree->rnode->lnode); - if (do_lint && (t2->flags & (NUM|NUMBER)) == 0) - lintwarn(_("strftime: recieved non-numeric second argument")); - fclock = (time_t) force_number(t2); - free_temp(t2); - } - } - - tm = localtime(&fclock); - - bufp = buf; - bufsize = sizeof(buf); - for (;;) { - *bufp = '\0'; - buflen = strftime(bufp, bufsize, format, tm); - /* - * buflen can be zero EITHER because there's not enough - * room in the string, or because the control command - * goes to the empty string. Make a reasonable guess that - * if the buffer is 1024 times bigger than the length of the - * format string, it's not failing for lack of room. - * Thanks to Paul Eggert for pointing out this issue. - */ - if (buflen > 0 || bufsize >= 1024 * formatlen) - break; - bufsize *= 2; - if (bufp == buf) - emalloc(bufp, char *, bufsize, "do_strftime"); - else - erealloc(bufp, char *, bufsize, "do_strftime"); - } - ret = tmp_string(bufp, buflen); - if (bufp != buf) - free(bufp); - if (t1) - free_temp(t1); - return ret; -} - -/* do_systime --- get the time of day */ - -NODE * -do_systime(NODE *tree) -{ - time_t lclock; - - (void) time(&lclock); - return tmp_number((AWKNUM) lclock); -} - -/* do_mktime --- turn a time string into a timestamp */ - -NODE * -do_mktime(NODE *tree) -{ - NODE *t1; - struct tm then; - long year; - int month, day, hour, minute, second, count; - int dst = -1; /* default is unknown */ - time_t then_stamp; - char save; - - t1 = tree_eval(tree->lnode); - if (do_lint && (t1->flags & (STRING|STR)) == 0) - lintwarn(_("mktime: received non-string argument")); - t1 = force_string(t1); - - save = t1->stptr[t1->stlen]; - t1->stptr[t1->stlen] = '\0'; - - count = sscanf(t1->stptr, "%ld %d %d %d %d %d %d", - & year, & month, & day, - & hour, & minute, & second, - & dst); - - t1->stptr[t1->stlen] = save; - free_temp(t1); - - if (count < 6 - || month < month - 1 - || year < year - 1900 || year - 1900 != (int) (year - 1900)) - return tmp_number((AWKNUM) -1); - - memset(& then, '\0', sizeof(then)); - then.tm_sec = second; - then.tm_min = minute; - then.tm_hour = hour; - then.tm_mday = day; - then.tm_mon = month - 1; - then.tm_year = year - 1900; - then.tm_isdst = dst; - - then_stamp = mktime(& then); - return tmp_number((AWKNUM) then_stamp); -} - -/* do_system --- run an external command */ - -NODE * -do_system(NODE *tree) -{ - NODE *tmp; - int ret = 0; - char *cmd; - char save; - - (void) flush_io(); /* so output is synchronous with gawk's */ - tmp = tree_eval(tree->lnode); - if (do_lint && (tmp->flags & (STRING|STR)) == 0) - lintwarn(_("system: recieved non-string argument")); - cmd = force_string(tmp)->stptr; - - if (cmd && *cmd) { - /* insure arg to system is zero-terminated */ - - /* - * From: David Trueman <david@cs.dal.ca> - * To: arnold@cc.gatech.edu (Arnold Robbins) - * Date: Wed, 3 Nov 1993 12:49:41 -0400 - * - * It may not be necessary to save the character, but - * I'm not sure. It would normally be the field - * separator. If the parse has not yet gone beyond - * that, it could mess up (although I doubt it). If - * FIELDWIDTHS is being used, it might be the first - * character of the next field. Unless someone wants - * to check it out exhaustively, I suggest saving it - * for now... - */ - save = cmd[tmp->stlen]; - cmd[tmp->stlen] = '\0'; - - os_restore_mode(fileno(stdin)); - ret = system(cmd); - ret = (ret >> 8) & 0xff; - if ((BINMODE & 1) != 0) - os_setbinmode(fileno(stdin), O_BINARY); - - cmd[tmp->stlen] = save; - } - free_temp(tmp); - return tmp_number((AWKNUM) ret); -} - -extern NODE **fmt_list; /* declared in eval.c */ - -/* do_print --- print items, separated by OFS, terminated with ORS */ - -void -do_print(register NODE *tree) -{ - register NODE **t; - struct redirect *rp = NULL; - register FILE *fp; - int numnodes, i; - NODE *save; - NODE *tval; - - if (tree->rnode) { - int errflg; /* not used, sigh */ - - rp = redirect(tree->rnode, &errflg); - if (rp != NULL) { - fp = rp->fp; - if (fp == NULL) - return; - } else - return; - } else - fp = stdout; - - /* - * General idea is to evaluate all the expressions first and - * then print them, otherwise you get suprising behavior. - * See test/prtoeval.awk for an example program. - */ - save = tree = tree->lnode; - for (numnodes = 0; tree != NULL; tree = tree->rnode) - numnodes++; - emalloc(t, NODE **, numnodes * sizeof(NODE *), "do_print"); - - tree = save; - for (i = 0; tree != NULL; i++, tree = tree->rnode) { - NODE *n; - - /* Here lies the wumpus. R.I.P. */ - n = tree_eval(tree->lnode); - t[i] = dupnode(n); - free_temp(n); - - if ((t[i]->flags & (NUMBER|STRING)) == NUMBER) { - if (OFMTidx == CONVFMTidx) - (void) force_string(t[i]); - else { - tval = tmp_number(t[i]->numbr); - unref(t[i]); - t[i] = format_val(OFMT, OFMTidx, tval); - } - } - } - - for (i = 0; i < numnodes; i++) { - efwrite(t[i]->stptr, sizeof(char), t[i]->stlen, fp, "print", rp, FALSE); - unref(t[i]); - - if (i != numnodes - 1 && OFSlen > 0) - efwrite(OFS, sizeof(char), (size_t) OFSlen, - fp, "print", rp, FALSE); - - } - if (ORSlen > 0) - efwrite(ORS, sizeof(char), (size_t) ORSlen, fp, "print", rp, TRUE); - - if (rp != NULL && (rp->flag & RED_TWOWAY) != 0) - fflush(rp->fp); - - free(t); -} - -/* do_tolower --- lower case a string */ - -NODE * -do_tolower(NODE *tree) -{ - NODE *t1, *t2; - register unsigned char *cp, *cp2; - - t1 = tree_eval(tree->lnode); - if (do_lint && (t1->flags & (STRING|STR)) == 0) - lintwarn(_("tolower: recieved non-string argument")); - t1 = force_string(t1); - t2 = tmp_string(t1->stptr, t1->stlen); - for (cp = (unsigned char *)t2->stptr, - cp2 = (unsigned char *)(t2->stptr + t2->stlen); cp < cp2; cp++) - if (ISUPPER(*cp)) - *cp = TOLOWER(*cp); - free_temp(t1); - return t2; -} - -/* do_toupper --- upper case a string */ - -NODE * -do_toupper(NODE *tree) -{ - NODE *t1, *t2; - register unsigned char *cp, *cp2; - - t1 = tree_eval(tree->lnode); - if (do_lint && (t1->flags & (STRING|STR)) == 0) - lintwarn(_("toupper: recieved non-string argument")); - t1 = force_string(t1); - t2 = tmp_string(t1->stptr, t1->stlen); - for (cp = (unsigned char *)t2->stptr, - cp2 = (unsigned char *)(t2->stptr + t2->stlen); cp < cp2; cp++) - if (ISLOWER(*cp)) - *cp = TOUPPER(*cp); - free_temp(t1); - return t2; -} - -/* do_atan2 --- do the atan2 function */ - -NODE * -do_atan2(NODE *tree) -{ - NODE *t1, *t2; - double d1, d2; - - t1 = tree_eval(tree->lnode); - t2 = tree_eval(tree->rnode->lnode); - if (do_lint) { - if ((t1->flags & (NUM|NUMBER)) == 0) - lintwarn(_("atan2: received non-numeric first argument")); - if ((t2->flags & (NUM|NUMBER)) == 0) - lintwarn(_("atan2: received non-numeric second argument")); - } - d1 = force_number(t1); - d2 = force_number(t2); - free_temp(t1); - free_temp(t2); - return tmp_number((AWKNUM) atan2(d1, d2)); -} - -/* do_sin --- do the sin function */ - -NODE * -do_sin(NODE *tree) -{ - NODE *tmp; - double d; - - tmp = tree_eval(tree->lnode); - if (do_lint && (tmp->flags & (NUM|NUMBER)) == 0) - lintwarn(_("sin: received non-numeric argument")); - d = sin((double) force_number(tmp)); - free_temp(tmp); - return tmp_number((AWKNUM) d); -} - -/* do_cos --- do the cos function */ - -NODE * -do_cos(NODE *tree) -{ - NODE *tmp; - double d; - - tmp = tree_eval(tree->lnode); - if (do_lint && (tmp->flags & (NUM|NUMBER)) == 0) - lintwarn(_("cos: received non-numeric argument")); - d = cos((double) force_number(tmp)); - free_temp(tmp); - return tmp_number((AWKNUM) d); -} - -/* do_rand --- do the rand function */ - -static int firstrand = TRUE; -static char state[512]; - -/* ARGSUSED */ -NODE * -do_rand(NODE *tree) -{ - if (firstrand) { - (void) initstate((unsigned) 1, state, sizeof state); - srandom(1); - firstrand = FALSE; - } - return tmp_number((AWKNUM) random() / GAWK_RANDOM_MAX); -} - -/* do_srand --- seed the random number generator */ - -NODE * -do_srand(NODE *tree) -{ - NODE *tmp; - static long save_seed = 1; - long ret = save_seed; /* SVR4 awk srand returns previous seed */ - - if (firstrand) { - (void) initstate((unsigned) 1, state, sizeof state); - /* don't need to srandom(1), we're changing the seed below */ - firstrand = FALSE; - } else - (void) setstate(state); - - if (tree == NULL) -#ifdef __FreeBSD__ - srandom((unsigned int) (save_seed = (long) time((time_t *) 0) - ^ (getpid() << 16))); -#else - srandom((unsigned int) (save_seed = (long) time((time_t *) 0))); -#endif - else { - tmp = tree_eval(tree->lnode); - if (do_lint && (tmp->flags & (NUM|NUMBER)) == 0) - lintwarn(_("srand: received non-numeric argument")); - srandom((unsigned int) (save_seed = (long) force_number(tmp))); - free_temp(tmp); - } - return tmp_number((AWKNUM) ret); -} - -/* do_match --- match a regexp, set RSTART and RLENGTH, - * optional third arg is array filled with text of - * subpatterns enclosed in parens. - */ - -NODE * -do_match(NODE *tree) -{ - NODE *t1, *dest, *it; - int rstart, len, ii; - AWKNUM rlength; - Regexp *rp; - regoff_t s; - char *start; - - t1 = force_string(tree_eval(tree->lnode)); - tree = tree->rnode; - rp = re_update(tree->lnode); - - dest = NULL; - if (tree->rnode != NULL) { /* 3rd optional arg for the subpatterns */ - dest = tree->rnode->lnode; - if (dest->type == Node_param_list) - dest = stack_ptr[dest->param_cnt]; - if (dest->type == Node_array_ref) - dest = dest->orig_array; - if (dest->type != Node_var && dest->type != Node_var_array) - fatal(_("match: third argument is not an array")); - dest->type = Node_var_array; - assoc_clear(dest); - } - - rstart = research(rp, t1->stptr, 0, t1->stlen, TRUE); - if (rstart >= 0) { /* match succeded */ - rstart++; /* 1-based indexing */ - rlength = REEND(rp, t1->stptr) - RESTART(rp, t1->stptr); - - /* Build the array only if the caller wants the optional subpatterns */ - if (dest != NULL) { - for (ii = 0; (s = SUBPATSTART(rp, t1->stptr, ii)) != -1; ii++) { - start = t1->stptr + s; - len = SUBPATEND(rp, t1->stptr, ii) - s; - - it = make_string(start, len); - it->flags |= MAYBE_NUM; - *assoc_lookup(dest, tmp_number((AWKNUM) (ii)), FALSE) = it; - } - } - } else { /* match failed */ - rstart = 0; - rlength = -1.0; - } - free_temp(t1); - unref(RSTART_node->var_value); - RSTART_node->var_value = make_number((AWKNUM) rstart); - unref(RLENGTH_node->var_value); - RLENGTH_node->var_value = make_number(rlength); - return tmp_number((AWKNUM) rstart); -} - -/* sub_common --- the common code (does the work) for sub, gsub, and gensub */ - -/* - * Gsub can be tricksy; particularly when handling the case of null strings. - * The following awk code was useful in debugging problems. It is too bad - * that it does not readily translate directly into the C code, below. - * - * #! /usr/local/bin/mawk -f - * - * BEGIN { - * TRUE = 1; FALSE = 0 - * print "--->", mygsub("abc", "b+", "FOO") - * print "--->", mygsub("abc", "x*", "X") - * print "--->", mygsub("abc", "b*", "X") - * print "--->", mygsub("abc", "c", "X") - * print "--->", mygsub("abc", "c+", "X") - * print "--->", mygsub("abc", "x*$", "X") - * } - * - * function mygsub(str, regex, replace, origstr, newstr, eosflag, nonzeroflag) - * { - * origstr = str; - * eosflag = nonzeroflag = FALSE - * while (match(str, regex)) { - * if (RLENGTH > 0) { # easy case - * nonzeroflag = TRUE - * if (RSTART == 1) { # match at front of string - * newstr = newstr replace - * } else { - * newstr = newstr substr(str, 1, RSTART-1) replace - * } - * str = substr(str, RSTART+RLENGTH) - * } else if (nonzeroflag) { - * # last match was non-zero in length, and at the - * # current character, we get a zero length match, - * # which we don't really want, so skip over it - * newstr = newstr substr(str, 1, 1) - * str = substr(str, 2) - * nonzeroflag = FALSE - * } else { - * # 0-length match - * if (RSTART == 1) { - * newstr = newstr replace substr(str, 1, 1) - * str = substr(str, 2) - * } else { - * return newstr str replace - * } - * } - * if (length(str) == 0) - * if (eosflag) - * break; - * else - * eosflag = TRUE - * } - * if (length(str) > 0) - * newstr = newstr str # rest of string - * - * return newstr - * } - */ - -/* - * NB: `howmany' conflicts with a SunOS 4.x macro in <sys/param.h>. - */ - -static NODE * -sub_common(NODE *tree, int how_many, int backdigs) -{ - register char *scan; - register char *bp, *cp; - char *buf; - size_t buflen; - register char *matchend; - register size_t len; - char *matchstart; - char *text; - size_t textlen; - char *repl; - char *replend; - size_t repllen; - int sofar; - int ampersands; - int matches = 0; - Regexp *rp; - NODE *s; /* subst. pattern */ - NODE *t; /* string to make sub. in; $0 if none given */ - NODE *tmp; - NODE **lhs = &tree; /* value not used -- just different from NULL */ - int priv = FALSE; - Func_ptr after_assign = NULL; - - int global = (how_many == -1); - long current; - int lastmatchnonzero; - - tmp = tree->lnode; - rp = re_update(tmp); - - tree = tree->rnode; - s = tree->lnode; - - tree = tree->rnode; - tmp = tree->lnode; - t = force_string(tree_eval(tmp)); - - /* do the search early to avoid work on non-match */ - if (research(rp, t->stptr, 0, t->stlen, TRUE) == -1 || - RESTART(rp, t->stptr) > t->stlen) { - free_temp(t); - return tmp_number((AWKNUM) 0.0); - } - - if (tmp->type == Node_val) - lhs = NULL; - else - lhs = get_lhs(tmp, &after_assign, FALSE); - t->flags |= STRING; - /* - * create a private copy of the string - */ - if (t->stref > 1 || (t->flags & (PERM|FIELD)) != 0) { - tmp = copynode(t); - t = tmp; - priv = TRUE; - } - text = t->stptr; - textlen = t->stlen; - buflen = textlen + 2; - - s = force_string(tree_eval(s)); - repl = s->stptr; - replend = repl + s->stlen; - repllen = replend - repl; - emalloc(buf, char *, buflen + 2, "sub_common"); - buf[buflen] = '\0'; - buf[buflen + 1] = '\0'; - ampersands = 0; - for (scan = repl; scan < replend; scan++) { - if (*scan == '&') { - repllen--; - ampersands++; - } else if (*scan == '\\') { - if (backdigs) { /* gensub, behave sanely */ - if (ISDIGIT(scan[1])) { - ampersands++; - scan++; - } else { /* \q for any q --> q */ - repllen--; - scan++; - } - } else { /* (proposed) posix '96 mode */ - if (strncmp(scan, "\\\\\\&", 4) == 0) { - /* \\\& --> \& */ - repllen -= 2; - scan += 3; - } else if (strncmp(scan, "\\\\&", 3) == 0) { - /* \\& --> \<string> */ - ampersands++; - repllen--; - scan += 2; - } else if (scan[1] == '&') { - /* \& --> & */ - repllen--; - scan++; - } /* else - leave alone, it goes into the output */ - } - } - } - - lastmatchnonzero = FALSE; - bp = buf; - for (current = 1;; current++) { - matches++; - matchstart = t->stptr + RESTART(rp, t->stptr); - matchend = t->stptr + REEND(rp, t->stptr); - - /* - * create the result, copying in parts of the original - * string - */ - len = matchstart - text + repllen - + ampersands * (matchend - matchstart); - sofar = bp - buf; - while (buflen < (sofar + len + 1)) { - buflen *= 2; - erealloc(buf, char *, buflen, "sub_common"); - bp = buf + sofar; - } - for (scan = text; scan < matchstart; scan++) - *bp++ = *scan; - if (global || current == how_many) { - /* - * If the current match matched the null string, - * and the last match didn't and did a replacement, - * then skip this one. - */ - if (lastmatchnonzero && matchstart == matchend) { - lastmatchnonzero = FALSE; - matches--; - goto empty; - } - /* - * If replacing all occurrences, or this is the - * match we want, copy in the replacement text, - * making substitutions as we go. - */ - for (scan = repl; scan < replend; scan++) - if (*scan == '&') - for (cp = matchstart; cp < matchend; cp++) - *bp++ = *cp; - else if (*scan == '\\') { - if (backdigs) { /* gensub, behave sanely */ - if (ISDIGIT(scan[1])) { - int dig = scan[1] - '0'; - char *start, *end; - - start = t->stptr - + SUBPATSTART(rp, t->stptr, dig); - end = t->stptr - + SUBPATEND(rp, t->stptr, dig); - - for (cp = start; cp < end; cp++) - *bp++ = *cp; - scan++; - } else /* \q for any q --> q */ - *bp++ = *++scan; - } else { /* posix '96 mode, bleah */ - if (strncmp(scan, "\\\\\\&", 4) == 0) { - /* \\\& --> \& */ - *bp++ = '\\'; - *bp++ = '&'; - scan += 3; - } else if (strncmp(scan, "\\\\&", 3) == 0) { - /* \\& --> \<string> */ - *bp++ = '\\'; - for (cp = matchstart; cp < matchend; cp++) - *bp++ = *cp; - scan += 2; - } else if (scan[1] == '&') { - /* \& --> & */ - *bp++ = '&'; - scan++; - } else - *bp++ = *scan; - } - } else - *bp++ = *scan; - if (matchstart != matchend) - lastmatchnonzero = TRUE; - } else { - /* - * don't want this match, skip over it by copying - * in current text. - */ - for (cp = matchstart; cp < matchend; cp++) - *bp++ = *cp; - } - empty: - /* catch the case of gsub(//, "blah", whatever), i.e. empty regexp */ - if (matchstart == matchend && matchend < text + textlen) { - *bp++ = *matchend; - matchend++; - } - textlen = text + textlen - matchend; - text = matchend; - - if ((current >= how_many && !global) - || ((long) textlen <= 0 && matchstart == matchend) - || research(rp, t->stptr, text - t->stptr, textlen, TRUE) == -1) - break; - - } - sofar = bp - buf; - if (buflen - sofar - textlen - 1) { - buflen = sofar + textlen + 2; - erealloc(buf, char *, buflen, "sub_common"); - bp = buf + sofar; - } - for (scan = matchend; scan < text + textlen; scan++) - *bp++ = *scan; - *bp = '\0'; - textlen = bp - buf; - free(t->stptr); - t->stptr = buf; - t->stlen = textlen; - - free_temp(s); - if (matches > 0 && lhs) { - if (priv) { - unref(*lhs); - *lhs = t; - } - if (after_assign != NULL) - (*after_assign)(); - t->flags &= ~(NUM|NUMBER); - } - return tmp_number((AWKNUM) matches); -} - -/* do_gsub --- global substitution */ - -NODE * -do_gsub(NODE *tree) -{ - return sub_common(tree, -1, FALSE); -} - -/* do_sub --- single substitution */ - -NODE * -do_sub(NODE *tree) -{ - return sub_common(tree, 1, FALSE); -} - -/* do_gensub --- fix up the tree for sub_common for the gensub function */ - -NODE * -do_gensub(NODE *tree) -{ - NODE n1, n2, n3, *t, *tmp, *target, *ret; - long how_many = 1; /* default is one substitution */ - double d; - - /* - * We have to pull out the value of the global flag, and - * build up a tree without the flag in it, turning it into the - * kind of tree that sub_common() expects. It helps to draw - * a picture of this ... - */ - n1 = *tree; - n2 = *(tree->rnode); - n1.rnode = & n2; - - t = tree_eval(n2.rnode->lnode); /* value of global flag */ - - tmp = force_string(tree_eval(n2.rnode->rnode->lnode)); /* target */ - - /* - * We make copy of the original target string, and pass that - * in to sub_common() as the target to make the substitution in. - * We will then return the result string as the return value of - * this function. - */ - target = make_string(tmp->stptr, tmp->stlen); - free_temp(tmp); - - n3 = *(n2.rnode->rnode); - n3.lnode = target; - n2.rnode = & n3; - - if ((t->flags & (STR|STRING)) != 0) { - if (t->stlen > 0 && (t->stptr[0] == 'g' || t->stptr[0] == 'G')) - how_many = -1; - else - how_many = 1; - } else { - d = force_number(t); - if (d > 0) - how_many = d; - else - how_many = 1; - if (d == 0) - warning(_("gensub: 3rd argument of 0 treated as 1")); - } - - free_temp(t); - - ret = sub_common(&n1, how_many, TRUE); - free_temp(ret); - - /* - * Note that we don't care what sub_common() returns, since the - * easiest thing for the programmer is to return the string, even - * if no substitutions were done. - */ - target->flags |= TEMP; - return target; -} - -#ifdef GFMT_WORKAROUND -/* - * printf's %g format [can't rely on gcvt()] - * caveat: don't use as argument to *printf()! - * 'format' string HAS to be of "<flags>*.*g" kind, or we bomb! - */ -static void -sgfmt(char *buf, /* return buffer; assumed big enough to hold result */ - const char *format, - int alt, /* use alternate form flag */ - int fwidth, /* field width in a format */ - int prec, /* indicates desired significant digits, not decimal places */ - double g) /* value to format */ -{ - char dform[40]; - register char *gpos; - register char *d, *e, *p; - int again = FALSE; - - strncpy(dform, format, sizeof dform - 1); - dform[sizeof dform - 1] = '\0'; - gpos = strrchr(dform, '.'); - - if (g == 0.0 && ! alt) { /* easy special case */ - *gpos++ = 'd'; - *gpos = '\0'; - (void) sprintf(buf, dform, fwidth, 0); - return; - } - - /* advance to location of 'g' in the format */ - while (*gpos && *gpos != 'g' && *gpos != 'G') - gpos++; - - if (prec <= 0) /* negative precision is ignored */ - prec = (prec < 0 ? DEFAULT_G_PRECISION : 1); - - if (*gpos == 'G') - again = TRUE; - /* start with 'e' format (it'll provide nice exponent) */ - *gpos = 'e'; - prec--; - (void) sprintf(buf, dform, fwidth, prec, g); - if ((e = strrchr(buf, 'e')) != NULL) { /* find exponent */ - int expn = atoi(e+1); /* fetch exponent */ - if (expn >= -4 && expn <= prec) { /* per K&R2, B1.2 */ - /* switch to 'f' format and re-do */ - *gpos = 'f'; - prec -= expn; /* decimal precision */ - (void) sprintf(buf, dform, fwidth, prec, g); - e = buf + strlen(buf); - while (*--e == ' ') - continue; - e++; - } - else if (again) - *gpos = 'E'; - - /* if 'alt' in force, then trailing zeros are not removed */ - if (! alt && (d = strrchr(buf, '.')) != NULL) { - /* throw away an excess of precision */ - for (p = e; p > d && *--p == '0'; ) - prec--; - if (d == p) - prec--; - if (prec < 0) - prec = 0; - /* and do that once again */ - again = TRUE; - } - if (again) - (void) sprintf(buf, dform, fwidth, prec, g); - } -} -#endif /* GFMT_WORKAROUND */ - -#define BITS_PER_BYTE 8 /* if not true, you lose. too bad. */ - -/* do_lshift --- perform a << operation */ - -NODE * -do_lshift(NODE *tree) -{ - NODE *s1, *s2; - unsigned long uval, ushift, res; - AWKNUM val, shift; - - s1 = tree_eval(tree->lnode); - s2 = tree_eval(tree->rnode->lnode); - val = force_number(s1); - shift = force_number(s2); - - if (do_lint) { - if ((s1->flags & (NUM|NUMBER)) == 0) - lintwarn(_("lshift: received non-numeric first argument")); - if ((s2->flags & (NUM|NUMBER)) == 0) - lintwarn(_("lshift: received non-numeric first argument")); - if (val < 0 || shift < 0) - lintwarn(_("lshift(%lf, %lf): negative values will give strange results"), val, shift); - if (double_to_int(val) != val || double_to_int(shift) != shift) - lintwarn(_("lshift(%lf, %lf): fractional values will be truncated"), val, shift); - if (shift > (sizeof(unsigned long) * BITS_PER_BYTE)) - lintwarn(_("lshift(%lf, %lf): too large shift value will give strange results"), val, shift); - } - - free_temp(s1); - free_temp(s2); - - uval = (unsigned long) val; - ushift = (unsigned long) shift; - - res = uval << ushift; - return tmp_number((AWKNUM) res); -} - -/* do_rshift --- perform a >> operation */ - -NODE * -do_rshift(NODE *tree) -{ - NODE *s1, *s2; - unsigned long uval, ushift, res; - AWKNUM val, shift; - - s1 = tree_eval(tree->lnode); - s2 = tree_eval(tree->rnode->lnode); - val = force_number(s1); - shift = force_number(s2); - - if (do_lint) { - if ((s1->flags & (NUM|NUMBER)) == 0) - lintwarn(_("rshift: received non-numeric first argument")); - if ((s2->flags & (NUM|NUMBER)) == 0) - lintwarn(_("rshift: received non-numeric first argument")); - if (val < 0 || shift < 0) - lintwarn(_("rshift(%lf, %lf): negative values will give strange results"), val, shift); - if (double_to_int(val) != val || double_to_int(shift) != shift) - lintwarn(_("rshift(%lf, %lf): fractional values will be truncated"), val, shift); - if (shift > (sizeof(unsigned long) * BITS_PER_BYTE)) - lintwarn(_("rshift(%lf, %lf): too large shift value will give strange results"), val, shift); - } - - free_temp(s1); - free_temp(s2); - - uval = (unsigned long) val; - ushift = (unsigned long) shift; - - res = uval >> ushift; - return tmp_number((AWKNUM) res); -} - -/* do_and --- perform an & operation */ - -NODE * -do_and(NODE *tree) -{ - NODE *s1, *s2; - unsigned long uleft, uright, res; - AWKNUM left, right; - - s1 = tree_eval(tree->lnode); - s2 = tree_eval(tree->rnode->lnode); - left = force_number(s1); - right = force_number(s2); - - if (do_lint) { - if ((s1->flags & (NUM|NUMBER)) == 0) - lintwarn(_("and: received non-numeric first argument")); - if ((s2->flags & (NUM|NUMBER)) == 0) - lintwarn(_("and: received non-numeric first argument")); - if (left < 0 || right < 0) - lintwarn(_("and(%lf, %lf): negative values will give strange results"), left, right); - if (double_to_int(left) != left || double_to_int(right) != right) - lintwarn(_("and(%lf, %lf): fractional values will be truncated"), left, right); - } - - free_temp(s1); - free_temp(s2); - - uleft = (unsigned long) left; - uright = (unsigned long) right; - - res = uleft & uright; - return tmp_number((AWKNUM) res); -} - -/* do_or --- perform an | operation */ - -NODE * -do_or(NODE *tree) -{ - NODE *s1, *s2; - unsigned long uleft, uright, res; - AWKNUM left, right; - - s1 = tree_eval(tree->lnode); - s2 = tree_eval(tree->rnode->lnode); - left = force_number(s1); - right = force_number(s2); - - if (do_lint) { - if ((s1->flags & (NUM|NUMBER)) == 0) - lintwarn(_("or: received non-numeric first argument")); - if ((s2->flags & (NUM|NUMBER)) == 0) - lintwarn(_("or: received non-numeric first argument")); - if (left < 0 || right < 0) - lintwarn(_("or(%lf, %lf): negative values will give strange results"), left, right); - if (double_to_int(left) != left || double_to_int(right) != right) - lintwarn(_("or(%lf, %lf): fractional values will be truncated"), left, right); - } - - free_temp(s1); - free_temp(s2); - - uleft = (unsigned long) left; - uright = (unsigned long) right; - - res = uleft | uright; - return tmp_number((AWKNUM) res); -} - -/* do_xor --- perform an ^ operation */ - -NODE * -do_xor(NODE *tree) -{ - NODE *s1, *s2; - unsigned long uleft, uright, res; - AWKNUM left, right; - - s1 = tree_eval(tree->lnode); - s2 = tree_eval(tree->rnode->lnode); - left = force_number(s1); - right = force_number(s2); - - if (do_lint) { - if ((s1->flags & (NUM|NUMBER)) == 0) - lintwarn(_("xor: received non-numeric first argument")); - if ((s2->flags & (NUM|NUMBER)) == 0) - lintwarn(_("xor: received non-numeric first argument")); - if (left < 0 || right < 0) - lintwarn(_("xor(%lf, %lf): negative values will give strange results"), left, right); - if (double_to_int(left) != left || double_to_int(right) != right) - lintwarn(_("xor(%lf, %lf): fractional values will be truncated"), left, right); - } - - free_temp(s1); - free_temp(s2); - - uleft = (unsigned long) left; - uright = (unsigned long) right; - - res = uleft ^ uright; - return tmp_number((AWKNUM) res); -} - -/* do_compl --- perform a ~ operation */ - -NODE * -do_compl(NODE *tree) -{ - NODE *tmp; - double d; - unsigned long uval; - - tmp = tree_eval(tree->lnode); - d = force_number(tmp); - free_temp(tmp); - - if (do_lint) { - if ((tmp->flags & (NUM|NUMBER)) == 0) - lintwarn(_("compl: received non-numeric argument")); - if (d < 0) - lintwarn(_("compl(%lf): negative value will give strange results"), d); - if (double_to_int(d) != d) - lintwarn(_("compl(%lf): fractional value will be truncated"), d); - } - - uval = (unsigned long) d; - uval = ~ uval; - return tmp_number((AWKNUM) uval); -} - -/* do_strtonum --- the strtonum function */ - -NODE * -do_strtonum(NODE *tree) -{ - NODE *tmp; - double d; - - tmp = tree_eval(tree->lnode); - - if ((tmp->flags & (NUM|NUMBER)) != 0) - d = (double) force_number(tmp); - else if (isnondecimal(tmp->stptr)) - d = nondec2awknum(tmp->stptr, tmp->stlen); - else - d = (double) force_number(tmp); - - free_temp(tmp); - return tmp_number((AWKNUM) d); -} - -/* nondec2awknum --- convert octal or hex value to double */ - -/* - * Because of awk's concatenation rules and the way awk.y:yylex() - * collects a number, this routine has to be willing to stop on the - * first invalid character. - */ - -AWKNUM -nondec2awknum(char *str, size_t len) -{ - AWKNUM retval = 0.0; - char save; - short val; - char *start = str; - - if (*str == '0' && (str[1] == 'x' || str[1] == 'X')) { - assert(len > 2); - - for (str += 2, len -= 2; len > 0; len--, str++) { - switch (*str) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - val = *str - '0'; - break; - case 'a': - case 'b': - case 'c': - case 'd': - case 'e': - case 'f': - val = *str - 'a' + 10; - break; - case 'A': - case 'B': - case 'C': - case 'D': - case 'E': - case 'F': - val = *str - 'A' + 10; - break; - default: - goto done; - } - retval = (retval * 16) + val; - } - } else if (*str == '0') { - if (strchr(str, '8') != NULL || strchr(str, '9') != NULL) - goto decimal; - for (; len > 0; len--) { - if (! ISDIGIT(*str)) - goto done; - else if (*str == '8' || *str == '9') { - str = start; - goto decimal; - } - retval = (retval * 8) + (*str - '0'); - str++; - } - } else { -decimal: - save = str[len]; - retval = strtod(str, NULL); - str[len] = save; - } -done: - return retval; -} - -/* do_dcgettext --- handle i18n translations */ - -/* - * awk usage is - * - * str = dcgettext(string [, domain [, category]]) - * - * Default domain is TEXTDOMAIN, default category is LC_MESSAGES. - */ - -NODE * -do_dcgettext(NODE *tree) -{ - NODE *tmp, *t1, *t2; - char *string; - char *the_result; -#if ENABLE_NLS && HAVE_LC_MESSAGES && HAVE_DCGETTEXT - int lc_cat = -1; - char *category, *domain; - static struct category_table { - int val; - char *name; - } cat_tab[] = { -#ifdef LC_ALL - { LC_ALL, "LC_ALL" }, -#endif /* LC_ALL */ -#ifdef LC_COLLATE - { LC_COLLATE, "LC_COLLATE" }, -#endif /* LC_COLLATE */ -#ifdef LC_CTYPE - { LC_CTYPE, "LC_CTYPE" }, -#endif /* LC_CTYPE */ -#ifdef LC_MESSAGES - { LC_MESSAGES, "LC_MESSAGES" }, -#endif /* LC_MESSAGES */ -#ifdef LC_MONETARY - { LC_MONETARY, "LC_MONETARY" }, -#endif /* LC_MONETARY */ -#ifdef LC_NUMERIC - { LC_NUMERIC, "LC_NUMERIC" }, -#endif /* LC_NUMERIC */ -#ifdef LC_RESPONSE - { LC_RESPONSE, "LC_RESPONSE" }, -#endif /* LC_RESPONSE */ -#ifdef LC_TIME - { LC_TIME, "LC_TIME" }, -#endif /* LC_TIME */ - }; -#endif /* ENABLE_NLS */ - - tmp = tree->lnode; /* first argument */ - t1 = force_string(tree_eval(tmp)); - string = t1->stptr; - - t2 = NULL; -#if ENABLE_NLS && HAVE_LC_MESSAGES && HAVE_DCGETTEXT - tree = tree->rnode; /* second argument */ - if (tree != NULL) { - tmp = tree->lnode; - t2 = force_string(tree_eval(tmp)); - domain = t2->stptr; - } else - domain = TEXTDOMAIN; - - if (tree != NULL && tree->rnode != NULL) { /* third argument */ - int low, high, i, mid; - NODE *t; - - tree = tree->rnode; - tmp = tree->lnode; - t = force_string(tree_eval(tmp)); - category = t->stptr; - - /* binary search the table */ - low = 0; - high = (sizeof(cat_tab) / sizeof(cat_tab[0])) - 1; - while (low <= high) { - mid = (low + high) / 2; - i = strcmp(category, cat_tab[mid].name); - - if (i < 0) /* category < mid */ - high = mid - 1; - else if (i > 0) /* category > mid */ - low = mid + 1; - else { - lc_cat = cat_tab[mid].val; - break; - } - } - if (lc_cat == -1) /* not there */ - fatal(_("dcgettext: `%s' is not a valid locale category"), category); - - free_temp(t); - } else - lc_cat = LC_MESSAGES; - - the_result = dcgettext(domain, string, lc_cat); -#else - the_result = string; -#endif - free_temp(t1); - if (t2 != NULL) - free_temp(t2); - - return tmp_string(the_result, strlen(the_result)); -} - -/* do_bindtextdomain --- set the directory for a text domain */ - -/* - * awk usage is - * - * binding = bindtextdomain(dir [, domain]) - * - * If dir is "", pass NULL to C version. - * Default domain is TEXTDOMAIN. - */ - -NODE * -do_bindtextdomain(NODE *tree) -{ - NODE *tmp, *t1, *t2; - char *directory, *domain; - char *the_result; - - t1 = t2 = NULL; - /* set defaults */ - directory = NULL; - domain = TEXTDOMAIN; - - tmp = tree->lnode; /* first argument */ - t1 = force_string(tree_eval(tmp)); - if (t1->stlen > 0) - directory = t1->stptr; - - tree = tree->rnode; /* second argument */ - if (tree != NULL) { - tmp = tree->lnode; - t2 = force_string(tree_eval(tmp)); - domain = t2->stptr; - } - - the_result = bindtextdomain(domain, directory); - - free_temp(t1); - if (t2 != NULL) - free_temp(t1); - - return tmp_string(the_result, strlen(the_result)); -} |
