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