builtin.c

Go to the documentation of this file.

/*
 * builtin.c - Builtin functions and various utility procedures 
 */

/* 
 * Copyright (C) 1986, 1988, 1989, 1991-2003 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
 */


#include "awk.h"
#if defined(HAVE_FCNTL_H)
#include <fcntl.h>
#endif
#undef HUGE
#undef CHARBITS
#undef INTBITS
#if HAVE_INTTYPES_H
# include <inttypes.h>
#else
# if HAVE_STDINT_H
#  include <stdint.h>
# endif
#endif
#include <math.h>
#include "random.h"

#ifndef CHAR_BIT
# define CHAR_BIT 8
#endif

/* The extra casts work around common compiler bugs.  */
#define TYPE_SIGNED(t) (! ((t) 0 < (t) -1))
/* The outer cast is needed to work around a bug in Cray C 5.0.3.0.
   It is necessary at least when t == time_t.  */
#define TYPE_MINIMUM(t) ((t) (TYPE_SIGNED (t) \
                              ? ~ (t) 0 << (sizeof (t) * CHAR_BIT - 1) : (t) 0))
#define TYPE_MAXIMUM(t) ((t) (~ (t) 0 - TYPE_MINIMUM (t)))

#ifndef INTMAX_MIN
# define INTMAX_MIN TYPE_MINIMUM (intmax_t)
#endif
#ifndef UINTMAX_MAX
# define UINTMAX_MAX TYPE_MAXIMUM (uintmax_t)
#endif

#ifndef SIZE_MAX        /* C99 constant, can't rely on it everywhere */
#define SIZE_MAX ((size_t) -1)
#endif

/* 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));

extern NODE **fields_arr;
extern int output_is_tty;

static NODE *sub_common P((NODE *tree, long 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 & (NUMCUR|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(const 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;
        const 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);
}

#ifdef MBS_SUPPORT
/* strncasecmpmbs --- like strncasecmp(multibyte string version)  */
int
strncasecmpmbs(const char *s1, mbstate_t mbs1, const char *s2,
                           mbstate_t mbs2, size_t n)
{
        int i1, i2, mbclen1, mbclen2, gap;
        wchar_t wc1, wc2;
        for (i1 = i2 = 0 ; i1 < n && i2 < n ;i1 += mbclen1, i2 += mbclen2) {
                mbclen1 = mbrtowc(&wc1, s1 + i1, n - i1, &mbs1);
                if (mbclen1 == (size_t) -1 || mbclen1 == (size_t) -2 || mbclen1 == 0) {
                        /* We treat it as a singlebyte character.  */
                        mbclen1 = 1;
                        wc1 = s1[i1];
                }
                mbclen2 = mbrtowc(&wc2, s2 + i2, n - i2, &mbs2);
                if (mbclen2 == (size_t) -1 || mbclen2 == (size_t) -2 || mbclen2 == 0) {
                        /* We treat it as a singlebyte character.  */
                        mbclen2 = 1;
                        wc2 = s2[i2];
                }
                if ((gap = towlower(wc1) - towlower(wc2)) != 0)
                        /* s1 and s2 are not equivalent.  */
                        return gap;
        }
        /* s1 and s2 are equivalent.  */
        return 0;
}

/* Inspect the buffer `src' and write the index of each byte to `dest'.
   Caller must allocate `dest'.
   e.g. str = <mb1(1)>, <mb1(2)>, a, b, <mb2(1)>, <mb2(2)>, <mb2(3)>, c
        where mb(i) means the `i'-th byte of a multibyte character.
                dest =       1,        2, 1, 1,        1,        2,        3. 1
*/
static void
index_multibyte_buffer(char* src, char* dest, int len)
{
        int idx, prev_idx;
        mbstate_t mbs, prevs;
        memset(&prevs, 0, sizeof(mbstate_t));

        for (idx = prev_idx = 0 ; idx < len ; idx++) {
                size_t mbclen;
                mbs = prevs;
                mbclen = mbrlen(src + prev_idx, idx - prev_idx + 1, &mbs);
                if (mbclen == (size_t) -1 || mbclen == 1 || mbclen == 0) {
                        /* singlebyte character.  */
                        mbclen = 1;
                        prev_idx = idx + 1;
                } else if (mbclen == (size_t) -2) {
                        /* a part of a multibyte character.  */
                        mbclen = idx - prev_idx + 1;
                } else if (mbclen > 1) {
                        /* the end of a multibyte character.  */
                        prev_idx = idx + 1;
                        prevs = mbs;
                } else {
                        /* Can't reach.  */
                }
                dest[idx] = mbclen;
    }
}
#endif

/* do_index --- find index of a string */

NODE *
do_index(NODE *tree)
{
        NODE *s1, *s2;
        register const char *p1, *p2;
        register size_t l1, l2;
        long ret;
#ifdef MBS_SUPPORT
        size_t mbclen = 0;
        mbstate_t mbs1, mbs2;
        if (gawk_mb_cur_max > 1) {
                memset(&mbs1, 0, sizeof(mbstate_t));
                memset(&mbs2, 0, sizeof(mbstate_t));
        }
#endif


        s1 = tree_eval(tree->lnode);
        s2 = tree_eval(tree->rnode->lnode);
        if (do_lint) {
                if ((s1->flags & (STRING|STRCUR)) == 0)
                        lintwarn(_("index: received non-string first argument"));
                if ((s2->flags & (STRING|STRCUR)) == 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;

        /*
         * Icky special case, index(foo, "") should return 1,
         * since both bwk awk and mawk do, and since match("foo", "")
         * returns 1. This makes index("", "") work, too, fwiw.
         */
        if (l2 == 0) {
                ret = 1;
                goto out;
        }

        /* IGNORECASE will already be false if posix */
        if (IGNORECASE) {
                while (l1 > 0) {
                        if (l2 > l1)
                                break;
#ifdef MBS_SUPPORT
                        if (gawk_mb_cur_max > 1) {
                                if (strncasecmpmbs(p1, mbs1, p2, mbs2, l2) == 0) {
                                        ret = 1 + s1->stlen - l1;
                                        break;
                                }
                                /* Update l1, and p1.  */
                                mbclen = mbrlen(p1, l1, &mbs1);
                                if ((mbclen == 1) || (mbclen == (size_t) -1)
                                        || (mbclen == (size_t) -2) || (mbclen == 0)) {
                                        /* We treat it as a singlebyte character.  */
                                        mbclen = 1;
                                }
                                l1 -= mbclen;
                                p1 += mbclen;
                        } else {
#endif
                        if (casetable[(unsigned char)*p1] == casetable[(unsigned char)*p2]
                            && (l2 == 1 || strncasecmp(p1, p2, l2) == 0)) {
                                ret = 1 + s1->stlen - l1;
                                break;
                        }
                        l1--;
                        p1++;
#ifdef MBS_SUPPORT
                        }
#endif
                }
        } else {
                while (l1 > 0) {
                        if (l2 > l1)
                                break;
                        if (*p1 == *p2
                            && (l2 == 1 || STREQN(p1, p2, l2))) {
                                ret = 1 + s1->stlen - l1;
                                break;
                        }
#ifdef MBS_SUPPORT
                        if (gawk_mb_cur_max > 1) {
                                mbclen = mbrlen(p1, l1, &mbs1);
                                if ((mbclen == 1) || (mbclen == (size_t) -1) ||
                                        (mbclen == (size_t) -2) || (mbclen == 0)) {
                                        /* We treat it as a singlebyte character.  */
                                        mbclen = 1;
                                }
                                l1 -= mbclen;
                                p1 += mbclen;
                        } else {
                                l1--;
                                p1++;
                        }
#else
                        l1--;
                        p1++;
#endif
                }
        }
out:
        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 & (NUMCUR|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|STRCUR)) == 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 & (NUMCUR|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,
        size_t n0,
        register NODE *carg,
        long 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 < 1) { \
                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;
        const 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
        uintmax_t 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;
        const char *fill;
        double tmpval;
        char signchar = FALSE;
        size_t len;
        int zero_flag = FALSE;
        static const char sp[] = " ";
        static const char zero_string[] = "0";
        static const char lchbuf[] = "0123456789abcdef";
        static const 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;
                        /*
                         * 29 Oct. 2002:
                         * The C99 standard pages 274 and 279 seem to imply that
                         * since there's no arg converted, the field width doesn't
                         * apply.  The code already was that way, but this
                         * comment documents it, at least in the code.
                         */
                        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 %ld 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 = &prec;
                        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 = (uintmax_t) arg->numbr;
#endif
                                cpbuf[0] = uval;
                                prec = 1;
                                cp = cpbuf;
                                goto pr_tail;
                        }
                        /*
                         * As per POSIX, only output first character of a
                         * string value.  Thus, we ignore any provided
                         * precision, forcing it to 1.  (Didn't this
                         * used to work? 6/2003.)
                         */
                        prec = 1;
                        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 < INTMAX_MIN)
                                        goto out_of_range;
                                sgn = TRUE;
                                uval = - (uintmax_t) (intmax_t) tmpval;
                        } else {
                                /* Use !, so that NaNs are out of range.  */
                                if (! (tmpval <= UINTMAX_MAX))
                                        goto out_of_range;
                                sgn = FALSE;
                                uval = (uintmax_t) 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 < INTMAX_MIN)
                                        goto out_of_range;
                                uval = (uintmax_t) (intmax_t) tmpval;
                        } else {
                                /* Use !, so that NaNs are out of range.  */
                                if (! (tmpval <= UINTMAX_MAX))
                                        goto out_of_range;
                                uval = (uintmax_t) 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 */
                        if (do_lint)
                                lintwarn(_("[s]printf: value %g is out of range for `%%%c' format"),
                                                        tmpval, cs1);
                        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, (int) (s1 - fmt_string - 1), "",
                              _("^ ran out for this one"));
        }
        if (do_lint) {
                if (need_format)
                        lintwarn(
                        _("[s]printf: format specifier does not have control letter"));
                if (cur_arg < num_args)
                        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;
}

/*
 * redirect_to_fp --- return fp for redirection, NULL on failure
 * or stdout if no redirection, used by all print routines
 */

static inline FILE *
redirect_to_fp(NODE *tree, struct redirect **rpp)
{
        int errflg;     /* not used, sigh */
        struct redirect *rp;

        if (tree == NULL)
                return stdout;

        rp = redirect(tree, &errflg);
        if (rp != NULL) {
                *rpp = rp;
                return  rp->fp;
        }

        return NULL;
}

/* 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"));
        }

        fp = redirect_to_fp(tree->rnode, & rp);
        if (fp == NULL)
                return;
        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 & (NUMCUR|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);