home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 6 / FreshFish_September1994.bin / bbs / gnu / gawk-2.15.5-src.lha / GNU / src / amiga / gawk-2.15.5 / builtin.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-19  |  25.7 KB  |  1,240 lines
  1. /*
  2.  * builtin.c - Builtin functions and various utility procedures 
  3.  */
  4.  
  5. /* 
  6.  * Copyright (C) 1986, 1988, 1989, 1991, 1992, 1993 the Free Software Foundation, Inc.
  7.  * 
  8.  * This file is part of GAWK, the GNU implementation of the
  9.  * AWK Progamming 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 GAWK; see the file COPYING.  If not, write to
  23.  * the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  24.  */
  25.  
  26.  
  27. #include "awk.h"
  28.  
  29. #ifndef SRANDOM_PROTO
  30. extern void srandom P((unsigned int seed));
  31. #endif
  32. #ifndef linux
  33. extern char *initstate P((unsigned seed, char *state, int n));
  34. extern char *setstate P((char *state));
  35. extern long random P((void));
  36. #endif
  37.  
  38. extern NODE **fields_arr;
  39. extern int output_is_tty;
  40.  
  41. static NODE *sub_common P((NODE *tree, int global));
  42. NODE *format_tree P((const char *, int, NODE *));
  43.  
  44. #ifdef _CRAY
  45. /* Work around a problem in conversion of doubles to exact integers. */
  46. #include <float.h>
  47. #define Floor(n) floor((n) * (1.0 + DBL_EPSILON))
  48. #define Ceil(n) ceil((n) * (1.0 + DBL_EPSILON))
  49.  
  50. /* Force the standard C compiler to use the library math functions. */
  51. extern double exp(double);
  52. double (*Exp)() = exp;
  53. #define exp(x) (*Exp)(x)
  54. extern double log(double);
  55. double (*Log)() = log;
  56. #define log(x) (*Log)(x)
  57. #else
  58. #define Floor(n) floor(n)
  59. #define Ceil(n) ceil(n)
  60. #endif
  61.  
  62. #define DEFAULT_G_PRECISION 6
  63.  
  64. #ifdef GFMT_WORKAROUND
  65. /* semi-temporary hack, mostly to gracefully handle VMS */
  66. static void sgfmt P((char *buf, const char *format, int alt,
  67.              int fwidth, int precision, double value));
  68. #endif /* GFMT_WORKAROUND */
  69.  
  70. /*
  71.  * On the alpha, LONG_MAX is too big for doing rand().
  72.  * On the Cray (Y-MP, anyway), ints and longs are 64 bits, but
  73.  * random() does things in terms of 32 bits. So we have to chop
  74.  * LONG_MAX down.
  75.  */
  76. #if (defined(__alpha) && defined(__osf__)) || defined(_CRAY)
  77. #define GAWK_RANDOM_MAX (LONG_MAX & 0x7fffffff)
  78. #else
  79. #define GAWK_RANDOM_MAX LONG_MAX
  80. #endif
  81.  
  82. static void efwrite P((const void *ptr, size_t size, size_t count, FILE *fp,
  83.                const char *from, struct redirect *rp,int flush));
  84.  
  85. static void
  86. efwrite(ptr, size, count, fp, from, rp, flush)
  87. const void *ptr;
  88. size_t size, count;
  89. FILE *fp;
  90. const char *from;
  91. struct redirect *rp;
  92. int flush;
  93. {
  94.     errno = 0;
  95.     if (fwrite(ptr, size, count, fp) != count)
  96.         goto wrerror;
  97.     if (flush
  98.       && ((fp == stdout && output_is_tty)
  99.        || (rp && (rp->flag & RED_NOBUF)))) {
  100.         fflush(fp);
  101.         if (ferror(fp))
  102.             goto wrerror;
  103.     }
  104.     return;
  105.  
  106.   wrerror:
  107.     fatal("%s to \"%s\" failed (%s)", from,
  108.         rp ? rp->value : "standard output",
  109.         errno ? strerror(errno) : "reason unknown");
  110. }
  111.  
  112. /* Builtin functions */
  113. NODE *
  114. do_exp(tree)
  115. NODE *tree;
  116. {
  117.     NODE *tmp;
  118.     double d, res;
  119. #ifndef exp
  120.     double exp P((double));
  121. #endif
  122.  
  123.     tmp= tree_eval(tree->lnode);
  124.     d = force_number(tmp);
  125.     free_temp(tmp);
  126.     errno = 0;
  127.     res = exp(d);
  128.     if (errno == ERANGE)
  129.         warning("exp argument %g is out of range", d);
  130.     return tmp_number((AWKNUM) res);
  131. }
  132.  
  133. NODE *
  134. do_index(tree)
  135. NODE *tree;
  136. {
  137.     NODE *s1, *s2;
  138.     register char *p1, *p2;
  139.     register size_t l1, l2;
  140.     long ret;
  141.  
  142.  
  143.     s1 = tree_eval(tree->lnode);
  144.     s2 = tree_eval(tree->rnode->lnode);
  145.     force_string(s1);
  146.     force_string(s2);
  147.     p1 = s1->stptr;
  148.     p2 = s2->stptr;
  149.     l1 = s1->stlen;
  150.     l2 = s2->stlen;
  151.     ret = 0;
  152.     if (IGNORECASE) {
  153.         while (l1) {
  154.             if (l2 > l1)
  155.                 break;
  156.             if (casetable[(int)*p1] == casetable[(int)*p2]
  157.                 && (l2 == 1 || strncasecmp(p1, p2, l2) == 0)) {
  158.                 ret = 1 + s1->stlen - l1;
  159.                 break;
  160.             }
  161.             l1--;
  162.             p1++;
  163.         }
  164.     } else {
  165.         while (l1) {
  166.             if (l2 > l1)
  167.                 break;
  168.             if (*p1 == *p2
  169.                 && (l2 == 1 || STREQN(p1, p2, l2))) {
  170.                 ret = 1 + s1->stlen - l1;
  171.                 break;
  172.             }
  173.             l1--;
  174.             p1++;
  175.         }
  176.     }
  177.     free_temp(s1);
  178.     free_temp(s2);
  179.     return tmp_number((AWKNUM) ret);
  180. }
  181.  
  182. double
  183. double_to_int(d)
  184. double d;
  185. {
  186.     double floor P((double));
  187.     double ceil P((double));
  188.  
  189.     if (d >= 0)
  190.         d = Floor(d);
  191.     else
  192.         d = Ceil(d);
  193.     return d;
  194. }
  195.  
  196. NODE *
  197. do_int(tree)
  198. NODE *tree;
  199. {
  200.     NODE *tmp;
  201.     double d;
  202.  
  203.     tmp = tree_eval(tree->lnode);
  204.     d = force_number(tmp);
  205.     d = double_to_int(d);
  206.     free_temp(tmp);
  207.     return tmp_number((AWKNUM) d);
  208. }
  209.  
  210. NODE *
  211. do_length(tree)
  212. NODE *tree;
  213. {
  214.     NODE *tmp;
  215.     size_t len;
  216.  
  217.     tmp = tree_eval(tree->lnode);
  218.     len = force_string(tmp)->stlen;
  219.     free_temp(tmp);
  220.     return tmp_number((AWKNUM) len);
  221. }
  222.  
  223. NODE *
  224. do_log(tree)
  225. NODE *tree;
  226. {
  227.     NODE *tmp;
  228. #ifndef log
  229.     double log P((double));
  230. #endif
  231.     double d, arg;
  232.  
  233.     tmp = tree_eval(tree->lnode);
  234.     arg = (double) force_number(tmp);
  235.     if (arg < 0.0)
  236.         warning("log called with negative argument %g", arg);
  237.     d = log(arg);
  238.     free_temp(tmp);
  239.     return tmp_number((AWKNUM) d);
  240. }
  241.  
  242. /*
  243.  * format_tree() formats nodes of a tree, starting with a left node,
  244.  * and accordingly to a fmt_string providing a format like in
  245.  * printf family from C library.  Returns a string node which value
  246.  * is a formatted string.  Called by  sprintf function.
  247.  *
  248.  * It is one of the uglier parts of gawk.  Thanks to Michal Jaegermann
  249.  * for taming this beast and making it compatible with ANSI C.
  250.  */
  251.  
  252. NODE *
  253. format_tree(fmt_string, n0, carg)
  254. const char *fmt_string;
  255. int n0;
  256. register NODE *carg;
  257. {
  258. /* copy 'l' bytes from 's' to 'obufout' checking for space in the process */
  259. /* difference of pointers should be of ptrdiff_t type, but let us be kind */
  260. #define bchunk(s,l) if(l) {\
  261.     while((l)>ofre) {\
  262.       long olen = obufout - obuf;\
  263.       erealloc(obuf, char *, osiz*2, "format_tree");\
  264.       ofre+=osiz;\
  265.       osiz*=2;\
  266.       obufout = obuf + olen;\
  267.     }\
  268.     memcpy(obufout,s,(size_t)(l));\
  269.     obufout+=(l);\
  270.     ofre-=(l);\
  271.   }
  272. /* copy one byte from 's' to 'obufout' checking for space in the process */
  273. #define bchunk_one(s) {\
  274.     if(ofre <= 0) {\
  275.       long olen = obufout - obuf;\
  276.       erealloc(obuf, char *, osiz*2, "format_tree");\
  277.       ofre+=osiz;\
  278.       osiz*=2;\
  279.       obufout = obuf + olen;\
  280.     }\
  281.     *obufout++ = *s;\
  282.     --ofre;\
  283.   }
  284.  
  285.     /* Is there space for something L big in the buffer? */
  286. #define chksize(l)  if((l)>ofre) {\
  287.     long olen = obufout - obuf;\
  288.     erealloc(obuf, char *, osiz*2, "format_tree");\
  289.     obufout = obuf + olen;\
  290.     ofre+=osiz;\
  291.     osiz*=2;\
  292.   }
  293.  
  294.     /*
  295.      * Get the next arg to be formatted.  If we've run out of args,
  296.      * return "" (Null string) 
  297.      */
  298. #define parse_next_arg() {\
  299.   if(!carg) { toofew = 1; break; }\
  300.   else {\
  301.     arg=tree_eval(carg->lnode);\
  302.     carg=carg->rnode;\
  303.   }\
  304.  }
  305.  
  306.     NODE *r;
  307.     int toofew = 0;
  308.     char *obuf, *obufout;
  309.     size_t osiz, ofre;
  310.     char *chbuf;
  311.     const char *s0, *s1;
  312.     int cs1;
  313.     NODE *arg;
  314.     long fw, prec;
  315.     int lj, alt, big, have_prec;
  316.     long *cur;
  317.     long val;
  318. #ifdef sun386        /* Can't cast unsigned (int/long) from ptr->value */
  319.     long tmp_uval;    /* on 386i 4.0.1 C compiler -- it just hangs */
  320. #endif
  321.     unsigned long uval;
  322.     int sgn;
  323.     int base = 0;
  324.     char cpbuf[30];        /* if we have numbers bigger than 30 */
  325.     char *cend = &cpbuf[30];/* chars, we lose, but seems unlikely */
  326.     char *cp;
  327.     char *fill;
  328.     double tmpval;
  329.     char signchar = 0;
  330.     size_t len;
  331.     static char sp[] = " ";
  332.     static char zero_string[] = "0";
  333.     static char lchbuf[] = "0123456789abcdef";
  334.     static char Uchbuf[] = "0123456789ABCDEF";
  335.  
  336.     emalloc(obuf, char *, 120, "format_tree");
  337.     obufout = obuf;
  338.     osiz = 120;
  339.     ofre = osiz - 1;
  340.  
  341.     s0 = s1 = fmt_string;
  342.     while (n0-- > 0) {
  343.         if (*s1 != '%') {
  344.             s1++;
  345.             continue;
  346.         }
  347.         bchunk(s0, s1 - s0);
  348.         s0 = s1;
  349.         cur = &fw;
  350.         fw = 0;
  351.         prec = 0;
  352.         have_prec = 0;
  353.         lj = alt = big = 0;
  354.         fill = sp;
  355.         cp = cend;
  356.         chbuf = lchbuf;
  357.         s1++;
  358.  
  359. retry:
  360.         --n0;
  361.         switch (cs1 = *s1++) {
  362.         case (-1):    /* dummy case to allow for checking */
  363. check_pos:
  364.             if (cur != &fw)
  365.                 break;        /* reject as a valid format */
  366.             goto retry;
  367.         case '%':
  368.             bchunk_one("%");
  369.             s0 = s1;
  370.             break;
  371.  
  372.         case '0':
  373.             if (lj)
  374.                 goto retry;
  375.             if (cur == &fw)
  376.                 fill = zero_string;    /* FALL through */
  377.         case '1':
  378.         case '2':
  379.         case '3':
  380.         case '4':
  381.         case '5':
  382.         case '6':
  383.         case '7':
  384.         case '8':
  385.         case '9':
  386.             if (cur == 0)
  387.                 /* goto lose; */
  388.                 break;
  389.             if (prec >= 0)
  390.                 *cur = cs1 - '0';
  391.             /* with a negative precision *cur is already set  */
  392.             /* to -1, so it will remain negative, but we have */
  393.             /* to "eat" precision digits in any case          */
  394.             while (n0 > 0 && *s1 >= '0' && *s1 <= '9') {
  395.                 --n0;
  396.                 *cur = *cur * 10 + *s1++ - '0';
  397.             }
  398.             if (prec < 0)     /* negative precision is discarded */
  399.                 have_prec = 0;
  400.             if (cur == &prec)
  401.                 cur = 0;
  402.             goto retry;
  403.         case '*':
  404.             if (cur == 0)
  405.                 /* goto lose; */
  406.                 break;
  407.             parse_next_arg();
  408.             *cur = force_number(arg);
  409.             free_temp(arg);
  410.             if (cur == &prec)
  411.                 cur = 0;
  412.             goto retry;
  413.         case ' ':        /* print ' ' or '-' */
  414.                     /* 'space' flag is ignored */
  415.                     /* if '+' already present  */
  416.             if (signchar != 0) 
  417.                 goto check_pos;
  418.             /* FALL THROUGH */
  419.         case '+':        /* print '+' or '-' */
  420.             signchar = cs1;
  421.             goto check_pos;
  422.         case '-':
  423.             if (prec < 0)
  424.                 break;
  425.             if (cur == &prec) {
  426.                 prec = -1;
  427.                 goto retry;
  428.             }
  429.             fill = sp;      /* if left justified then other */
  430.             lj++;         /* filling is ignored */
  431.             goto check_pos;
  432.         case '.':
  433.             if (cur != &fw)
  434.                 break;
  435.             cur = ≺
  436.             have_prec++;
  437.             goto retry;
  438.         case '#':
  439.             alt++;
  440.             goto check_pos;
  441.         case 'l':
  442.             if (big)
  443.                 break;
  444.             big++;
  445.             goto check_pos;
  446.         case 'c':
  447.             parse_next_arg();
  448.             if (arg->flags & NUMBER) {
  449. #ifdef sun386
  450.                 tmp_uval = arg->numbr; 
  451.                 uval= (unsigned long) tmp_uval;
  452. #else
  453.                 uval = (unsigned long) arg->numbr;
  454. #endif
  455.                 cpbuf[0] = uval;
  456.                 prec = 1;
  457.                 cp = cpbuf;
  458.                 goto pr_tail;
  459.             }
  460.             if (have_prec == 0)
  461.                 prec = 1;
  462.             else if (prec > arg->stlen)
  463.                 prec = arg->stlen;
  464.             cp = arg->stptr;
  465.             goto pr_tail;
  466.         case 's':
  467.             parse_next_arg();
  468.             arg = force_string(arg);
  469.             if (have_prec == 0 || prec > arg->stlen)
  470.                 prec = arg->stlen;
  471.             cp = arg->stptr;
  472.             goto pr_tail;
  473.         case 'd':
  474.         case 'i':
  475.             parse_next_arg();
  476.             tmpval = force_number(arg);
  477.             if (tmpval > LONG_MAX || tmpval < LONG_MIN) {
  478.                 /* out of range - emergency use of %g format */
  479.                 cs1 = 'g';
  480.                 goto format_float;
  481.             }
  482.             val = (long) tmpval;
  483.  
  484.             if (val < 0) {
  485.                 sgn = 1;
  486.                 if (val > LONG_MIN)
  487.                     uval = (unsigned long) -val;
  488.                 else
  489.                     uval = (unsigned long)(-(LONG_MIN + 1))
  490.                            + (unsigned long)1;
  491.             } else {
  492.                 sgn = 0;
  493.                 uval = (unsigned long) val;
  494.             }
  495.             do {
  496.                 *--cp = (char) ('0' + uval % 10);
  497.                 uval /= 10;
  498.             } while (uval);
  499.             if (sgn)
  500.                 *--cp = '-';
  501.             else if (signchar)
  502.                 *--cp = signchar;
  503.             if (have_prec != 0)    /* ignore '0' flag if */
  504.                 fill = sp;     /* precision given    */
  505.             if (prec > fw)
  506.                 fw = prec;
  507.             prec = cend - cp;
  508.             if (fw > prec && ! lj && fill != sp
  509.                 && (*cp == '-' || signchar)) {
  510.                 bchunk_one(cp);
  511.                 cp++;
  512.                 prec--;
  513.                 fw--;
  514.             }
  515.             goto pr_tail;
  516.         case 'X':
  517.             chbuf = Uchbuf;    /* FALL THROUGH */
  518.         case 'x':
  519.             base += 6;    /* FALL THROUGH */
  520.         case 'u':
  521.             base += 2;    /* FALL THROUGH */
  522.         case 'o':
  523.             base += 8;
  524.             parse_next_arg();
  525.             tmpval = force_number(arg);
  526.             if (tmpval > ULONG_MAX || tmpval < LONG_MIN) {
  527.                 /* out of range - emergency use of %g format */
  528.                 cs1 = 'g';
  529.                 goto format_float;
  530.             }
  531.             uval = (unsigned long)tmpval;
  532.             if (have_prec != 0)    /* ignore '0' flag if */
  533.                 fill = sp;     /* precision given    */
  534.             do {
  535.                 *--cp = chbuf[uval % base];
  536.                 uval /= base;
  537.             } while (uval);
  538.             if (alt) {
  539.                 if (base == 16) {
  540.                     *--cp = cs1;
  541.                     *--cp = '0';
  542.                     if (fill != sp) {
  543.                         bchunk(cp, 2);
  544.                         cp += 2;
  545.                         fw -= 2;
  546.                     }
  547.                 } else if (base == 8)
  548.                     *--cp = '0';
  549.             }
  550.             base = 0;
  551.             prec = cend - cp;
  552.     pr_tail:
  553.             if (! lj) {
  554.                 while (fw > prec) {
  555.                         bchunk_one(fill);
  556.                     fw--;
  557.                 }
  558.             }
  559.             bchunk(cp, (int) prec);
  560.             while (fw > prec) {
  561.                 bchunk_one(fill);
  562.                 fw--;
  563.             }
  564.             s0 = s1;
  565.             free_temp(arg);
  566.             break;
  567.         case 'g':
  568.         case 'G':
  569.         case 'e':
  570.         case 'f':
  571.         case 'E':
  572.             parse_next_arg();
  573.             tmpval = force_number(arg);
  574.      format_float:
  575.             free_temp(arg);
  576.             if (have_prec == 0)
  577.                 prec = DEFAULT_G_PRECISION;
  578.             chksize(fw + prec + 9);    /* 9==slop */
  579.  
  580.             cp = cpbuf;
  581.             *cp++ = '%';
  582.             if (lj)
  583.                 *cp++ = '-';
  584.             if (signchar)
  585.                 *cp++ = signchar;
  586.             if (alt)
  587.                 *cp++ = '#';
  588.             if (fill != sp)
  589.                 *cp++ = '0';
  590.             cp = strcpy(cp, "*.*") + 3;
  591.             *cp++ = cs1;
  592.             *cp   = '\0';
  593. #ifndef GFMT_WORKAROUND
  594.             (void) sprintf(obufout, cpbuf,
  595.                        (int) fw, (int) prec, (double) tmpval);
  596. #else    /* GFMT_WORKAROUND */
  597.             if (cs1 == 'g' || cs1 == 'G')
  598.                 sgfmt(obufout, cpbuf, (int) alt,
  599.                        (int) fw, (int) prec, (double) tmpval);
  600.             else
  601.                 (void) sprintf(obufout, cpbuf,
  602.                        (int) fw, (int) prec, (double) tmpval);
  603. #endif    /* GFMT_WORKAROUND */
  604.             len = strlen(obufout);
  605.             ofre -= len;
  606.             obufout += len;
  607.             s0 = s1;
  608.             break;
  609.         default:
  610.             break;
  611.         }
  612.         if (toofew)
  613.             fatal("%s\n\t%s\n\t%*s%s",
  614.             "not enough arguments to satisfy format string",
  615.             fmt_string, s1 - fmt_string - 2, "",
  616.             "^ ran out for this one"
  617.             );
  618.     }
  619.     if (do_lint && carg != NULL)
  620.         warning("too many arguments supplied for format string");
  621.     bchunk(s0, s1 - s0);
  622.     r = make_str_node(obuf, obufout - obuf, ALREADY_MALLOCED);
  623.     r->flags |= TEMP;
  624.     return r;
  625. }
  626.  
  627. NODE *
  628. do_sprintf(tree)
  629. NODE *tree;
  630. {
  631.     NODE *r;
  632.     NODE *sfmt = force_string(tree_eval(tree->lnode));
  633.  
  634.     r = format_tree(sfmt->stptr, sfmt->stlen, tree->rnode);
  635.     free_temp(sfmt);
  636.     return r;
  637. }
  638.  
  639.  
  640. void
  641. do_printf(tree)
  642. register NODE *tree;
  643. {
  644.     struct redirect *rp = NULL;
  645.     register FILE *fp;
  646.  
  647.     if (tree->rnode) {
  648.         int errflg;    /* not used, sigh */
  649.  
  650.         rp = redirect(tree->rnode, &errflg);
  651.         if (rp) {
  652.             fp = rp->fp;
  653.             if (!fp)
  654.                 return;
  655.         } else
  656.             return;
  657.     } else
  658.         fp = stdout;
  659.     tree = do_sprintf(tree->lnode);
  660.     efwrite(tree->stptr, sizeof(char), tree->stlen, fp, "printf", rp , 1);
  661.     free_temp(tree);
  662. }
  663.  
  664. NODE *
  665. do_sqrt(tree)
  666. NODE *tree;
  667. {
  668.     NODE *tmp;
  669.     double arg;
  670.     extern double sqrt P((double));
  671.  
  672.     tmp = tree_eval(tree->lnode);
  673.     arg = (double) force_number(tmp);
  674.     free_temp(tmp);
  675.     if (arg < 0.0)
  676.         warning("sqrt called with negative argument %g", arg);
  677.     return tmp_number((AWKNUM) sqrt(arg));
  678. }
  679.  
  680. NODE *
  681. do_substr(tree)
  682. NODE *tree;
  683. {
  684.     NODE *t1, *t2, *t3;
  685.     NODE *r;
  686.     register int indx;
  687.     size_t length;
  688.     int is_long;
  689.  
  690.     t1 = tree_eval(tree->lnode);
  691.     t2 = tree_eval(tree->rnode->lnode);
  692.     if (tree->rnode->rnode == NULL)    /* third arg. missing */
  693.         length = t1->stlen;
  694.     else {
  695.         t3 = tree_eval(tree->rnode->rnode->lnode);
  696.         length = (size_t) force_number(t3);
  697.         free_temp(t3);
  698.     }
  699.     indx = (int) force_number(t2) - 1;
  700.     free_temp(t2);
  701.     t1 = force_string(t1);
  702.     if (indx < 0)
  703.         indx = 0;
  704.     if (indx >= t1->stlen || (long) length <= 0) {
  705.         free_temp(t1);
  706.         return Nnull_string;
  707.     }
  708.     if ((is_long = (indx + length > t1->stlen)) || LONG_MAX - indx < length) {
  709.         length = t1->stlen - indx;
  710.         if (do_lint && is_long)
  711.             warning("substr: length %d at position %d exceeds length of first argument",
  712.                 length, indx+1);
  713.     }
  714.     r =  tmp_string(t1->stptr + indx, length);
  715.     free_temp(t1);
  716.     return r;
  717. }
  718.  
  719. NODE *
  720. do_strftime(tree)
  721. NODE *tree;
  722. {
  723.     NODE *t1, *t2;
  724.     struct tm *tm;
  725.     time_t fclock;
  726.     char buf[100];
  727.  
  728.     t1 = force_string(tree_eval(tree->lnode));
  729.  
  730.     if (tree->rnode == NULL)    /* second arg. missing, default */
  731.         (void) time(&fclock);
  732.     else {
  733.         t2 = tree_eval(tree->rnode->lnode);
  734.         fclock = (time_t) force_number(t2);
  735.         free_temp(t2);
  736.     }
  737.     tm = localtime(&fclock);
  738.  
  739.     return tmp_string(buf, strftime(buf, 100, t1->stptr, tm));
  740. }
  741.  
  742. NODE *
  743. do_systime(tree)
  744. NODE *tree;
  745. {
  746.     time_t lclock;
  747.  
  748.     (void) time(&lclock);
  749.     return tmp_number((AWKNUM) lclock);
  750. }
  751.  
  752. NODE *
  753. do_system(tree)
  754. NODE *tree;
  755. {
  756.     NODE *tmp;
  757.     int ret = 0;
  758.     char *cmd;
  759.     char save;
  760.  
  761.     (void) flush_io ();     /* so output is synchronous with gawk's */
  762.     tmp = tree_eval(tree->lnode);
  763.     cmd = force_string(tmp)->stptr;
  764.  
  765.     if (cmd && *cmd) {
  766.         /* insure arg to system is zero-terminated */
  767.  
  768.         /*
  769.          * From: David Trueman <emory!cs.dal.ca!david>
  770.          * To: arnold@cc.gatech.edu (Arnold Robbins)
  771.          * Date:     Wed, 3 Nov 1993 12:49:41 -0400
  772.          * 
  773.          * It may not be necessary to save the character, but
  774.          * I'm not sure.  It would normally be the field
  775.          * separator.  If the parse has not yet gone beyond
  776.          * that, it could mess up (although I doubt it).  If
  777.          * FIELDWIDTHS is being used, it might be the first
  778.          * character of the next field.  Unless someone wants
  779.          * to check it out exhaustively, I suggest saving it
  780.          * for now...
  781.          */
  782.         save = cmd[tmp->stlen];
  783.         cmd[tmp->stlen] = '\0';
  784.  
  785.         ret = system(cmd);
  786.         ret = (ret >> 8) & 0xff;
  787.  
  788.         cmd[tmp->stlen] = save;
  789.     }
  790.     free_temp(tmp);
  791.     return tmp_number((AWKNUM) ret);
  792. }
  793.  
  794. extern NODE **fmt_list;  /* declared in eval.c */
  795.  
  796. void 
  797. do_print(tree)
  798. register NODE *tree;
  799. {
  800.     register NODE *t1;
  801.     struct redirect *rp = NULL;
  802.     register FILE *fp;
  803.     register char *s;
  804.  
  805.     if (tree->rnode) {
  806.         int errflg;        /* not used, sigh */
  807.  
  808.         rp = redirect(tree->rnode, &errflg);
  809.         if (rp) {
  810.             fp = rp->fp;
  811.             if (!fp)
  812.                 return;
  813.         } else
  814.             return;
  815.     } else
  816.         fp = stdout;
  817.     tree = tree->lnode;
  818.     while (tree) {
  819.         t1 = tree_eval(tree->lnode);
  820.         if (t1->flags & NUMBER) {
  821.             if (OFMTidx == CONVFMTidx)
  822.                 (void) force_string(t1);
  823.             else {
  824. #ifndef GFMT_WORKAROUND
  825.                 char buf[100];
  826.  
  827.                 (void) sprintf(buf, OFMT, t1->numbr);
  828.                 free_temp(t1);
  829.                 t1 = tmp_string(buf, strlen(buf));
  830. #else /* GFMT_WORKAROUND */
  831.                 free_temp(t1);
  832.                 t1 = format_tree(OFMT,
  833.                          fmt_list[OFMTidx]->stlen,
  834.                          tree);
  835. #endif /* GFMT_WORKAROUND */
  836.             }
  837.         }
  838.         efwrite(t1->stptr, sizeof(char), t1->stlen, fp, "print", rp, 0);
  839.         free_temp(t1);
  840.         tree = tree->rnode;
  841.         if (tree) {
  842.             s = OFS;
  843.             if (OFSlen)
  844.                 efwrite(s, sizeof(char), (size_t)OFSlen,
  845.                     fp, "print", rp, 0);
  846.         }
  847.     }
  848.     s = ORS;
  849.     if (ORSlen)
  850.         efwrite(s, sizeof(char), (size_t)ORSlen, fp, "print", rp, 1);
  851. }
  852.  
  853. NODE *
  854. do_tolower(tree)
  855. NODE *tree;
  856. {
  857.     NODE *t1, *t2;
  858.     register char *cp, *cp2;
  859.  
  860.     t1 = tree_eval(tree->lnode);
  861.     t1 = force_string(t1);
  862.     t2 = tmp_string(t1->stptr, t1->stlen);
  863.     for (cp = t2->stptr, cp2 = t2->stptr + t2->stlen; cp < cp2; cp++)
  864.         if (isupper(*cp))
  865.             *cp = tolower(*cp);
  866.     free_temp(t1);
  867.     return t2;
  868. }
  869.  
  870. NODE *
  871. do_toupper(tree)
  872. NODE *tree;
  873. {
  874.     NODE *t1, *t2;
  875.     register char *cp;
  876.  
  877.     t1 = tree_eval(tree->lnode);
  878.     t1 = force_string(t1);
  879.     t2 = tmp_string(t1->stptr, t1->stlen);
  880.     for (cp = t2->stptr; cp < t2->stptr + t2->stlen; cp++)
  881.         if (islower(*cp))
  882.             *cp = toupper(*cp);
  883.     free_temp(t1);
  884.     return t2;
  885. }
  886.  
  887. NODE *
  888. do_atan2(tree)
  889. NODE *tree;
  890. {
  891.     NODE *t1, *t2;
  892.     extern double atan2 P((double, double));
  893.     double d1, d2;
  894.  
  895.     t1 = tree_eval(tree->lnode);
  896.     t2 = tree_eval(tree->rnode->lnode);
  897.     d1 = force_number(t1);
  898.     d2 = force_number(t2);
  899.     free_temp(t1);
  900.     free_temp(t2);
  901.     return tmp_number((AWKNUM) atan2(d1, d2));
  902. }
  903.  
  904. NODE *
  905. do_sin(tree)
  906. NODE *tree;
  907. {
  908.     NODE *tmp;
  909.     extern double sin P((double));
  910.     double d;
  911.  
  912.     tmp = tree_eval(tree->lnode);
  913.     d = sin((double)force_number(tmp));
  914.     free_temp(tmp);
  915.     return tmp_number((AWKNUM) d);
  916. }
  917.  
  918. NODE *
  919. do_cos(tree)
  920. NODE *tree;
  921. {
  922.     NODE *tmp;
  923.     extern double cos P((double));
  924.     double d;
  925.  
  926.     tmp = tree_eval(tree->lnode);
  927.     d = cos((double)force_number(tmp));
  928.     free_temp(tmp);
  929.     return tmp_number((AWKNUM) d);
  930. }
  931.  
  932. static int firstrand = 1;
  933. static char state[512];
  934.  
  935. /* ARGSUSED */
  936. NODE *
  937. do_rand(tree)
  938. NODE *tree;
  939. {
  940.     if (firstrand) {
  941.         (void) initstate((unsigned) 1, state, sizeof state);
  942.         srandom(1);
  943.         firstrand = 0;
  944.     }
  945.     return tmp_number((AWKNUM) random() / GAWK_RANDOM_MAX);
  946. }
  947.  
  948. NODE *
  949. do_srand(tree)
  950. NODE *tree;
  951. {
  952.     NODE *tmp;
  953.     static long save_seed = 0;
  954.     long ret = save_seed;    /* SVR4 awk srand returns previous seed */
  955.  
  956.     if (firstrand)
  957.         (void) initstate((unsigned) 1, state, sizeof state);
  958.     else
  959.         (void) setstate(state);
  960.  
  961.     if (!tree)
  962.         srandom((unsigned int) (save_seed = (long) time((time_t *) 0)));
  963.     else {
  964.         tmp = tree_eval(tree->lnode);
  965.         srandom((unsigned int) (save_seed = (long) force_number(tmp)));
  966.         free_temp(tmp);
  967.     }
  968.     firstrand = 0;
  969.     return tmp_number((AWKNUM) ret);
  970. }
  971.  
  972. NODE *
  973. do_match(tree)
  974. NODE *tree;
  975. {
  976.     NODE *t1;
  977.     int rstart;
  978.     AWKNUM rlength;
  979.     Regexp *rp;
  980.  
  981.     t1 = force_string(tree_eval(tree->lnode));
  982.     tree = tree->rnode->lnode;
  983.     rp = re_update(tree);
  984.     rstart = research(rp, t1->stptr, 0, t1->stlen, 1);
  985.     if (rstart >= 0) {    /* match succeded */
  986.         rstart++;    /* 1-based indexing */
  987.         rlength = REEND(rp, t1->stptr) - RESTART(rp, t1->stptr);
  988.     } else {        /* match failed */
  989.         rstart = 0;
  990.         rlength = -1.0;
  991.     }
  992.     free_temp(t1);
  993.     unref(RSTART_node->var_value);
  994.     RSTART_node->var_value = make_number((AWKNUM) rstart);
  995.     unref(RLENGTH_node->var_value);
  996.     RLENGTH_node->var_value = make_number(rlength);
  997.     return tmp_number((AWKNUM) rstart);
  998. }
  999.  
  1000. static NODE *
  1001. sub_common(tree, global)
  1002. NODE *tree;
  1003. int global;
  1004. {
  1005.     register char *scan;
  1006.     register char *bp, *cp;
  1007.     char *buf;
  1008.     size_t buflen;
  1009.     register char *matchend;
  1010.     register size_t len;
  1011.     char *matchstart;
  1012.     char *text;
  1013.     size_t textlen;
  1014.     char *repl;
  1015.     char *replend;
  1016.     size_t repllen;
  1017.     int sofar;
  1018.     int ampersands;
  1019.     int matches = 0;
  1020.     Regexp *rp;
  1021.     NODE *s;        /* subst. pattern */
  1022.     NODE *t;        /* string to make sub. in; $0 if none given */
  1023.     NODE *tmp;
  1024.     NODE **lhs = &tree;    /* value not used -- just different from NULL */
  1025.     int priv = 0;
  1026.     Func_ptr after_assign = NULL;
  1027.  
  1028.     tmp = tree->lnode;
  1029.     rp = re_update(tmp);
  1030.  
  1031.     tree = tree->rnode;
  1032.     s = tree->lnode;
  1033.  
  1034.     tree = tree->rnode;
  1035.     tmp = tree->lnode;
  1036.     t = force_string(tree_eval(tmp));
  1037.  
  1038.     /* do the search early to avoid work on non-match */
  1039.     if (research(rp, t->stptr, 0, t->stlen, 1) == -1 ||
  1040.         RESTART(rp, t->stptr) > t->stlen) {
  1041.         free_temp(t);
  1042.         return tmp_number((AWKNUM) 0.0);
  1043.     }
  1044.  
  1045.     if (tmp->type == Node_val)
  1046.         lhs = NULL;
  1047.     else
  1048.         lhs = get_lhs(tmp, &after_assign);
  1049.     t->flags |= STRING;
  1050.     /*
  1051.      * create a private copy of the string
  1052.      */
  1053.     if (t->stref > 1 || (t->flags & PERM)) {
  1054.         unsigned int saveflags;
  1055.  
  1056.         saveflags = t->flags;
  1057.         t->flags &= ~MALLOC;
  1058.         tmp = dupnode(t);
  1059.         t->flags = saveflags;
  1060.         t = tmp;
  1061.         priv = 1;
  1062.     }
  1063.     text = t->stptr;
  1064.     textlen = t->stlen;
  1065.     buflen = textlen + 2;
  1066.  
  1067.     s = force_string(tree_eval(s));
  1068.     repl = s->stptr;
  1069.     replend = repl + s->stlen;
  1070.     repllen = replend - repl;
  1071.     emalloc(buf, char *, buflen + 2, "do_sub");
  1072.     buf[buflen] = '\0';
  1073.     buf[buflen + 1] = '\0';
  1074.     ampersands = 0;
  1075.     for (scan = repl; scan < replend; scan++) {
  1076.         if (*scan == '&') {
  1077.             repllen--;
  1078.             ampersands++;
  1079.         } else if (*scan == '\\' && *(scan+1) == '&') {
  1080.             repllen--;
  1081.             scan++;
  1082.         }
  1083.     }
  1084.  
  1085.     bp = buf;
  1086.     for (;;) {
  1087.         matches++;
  1088.         matchstart = t->stptr + RESTART(rp, t->stptr);
  1089.         matchend = t->stptr + REEND(rp, t->stptr);
  1090.  
  1091.         /*
  1092.          * create the result, copying in parts of the original
  1093.          * string 
  1094.          */
  1095.         len = matchstart - text + repllen
  1096.               + ampersands * (matchend - matchstart);
  1097.         sofar = bp - buf;
  1098.         while ((long)(buflen - sofar - len - 1) < 0) {
  1099.             buflen *= 2;
  1100.             erealloc(buf, char *, buflen, "do_sub");
  1101.             bp = buf + sofar;
  1102.         }
  1103.         for (scan = text; scan < matchstart; scan++)
  1104.             *bp++ = *scan;
  1105.         for (scan = repl; scan < replend; scan++)
  1106.             if (*scan == '&')
  1107.                 for (cp = matchstart; cp < matchend; cp++)
  1108.                     *bp++ = *cp;
  1109.             else if (*scan == '\\' && *(scan+1) == '&') {
  1110.                 scan++;
  1111.                 *bp++ = *scan;
  1112.             } else
  1113.                 *bp++ = *scan;
  1114.  
  1115.         /* catch the case of gsub(//, "blah", whatever), i.e. empty regexp */
  1116.         if (global && matchstart == matchend && matchend < text + textlen) {
  1117.             *bp++ = *matchend;
  1118.             matchend++;
  1119.         }
  1120.         textlen = text + textlen - matchend;
  1121.         text = matchend;
  1122.         if (!global || (long)textlen <= 0 ||
  1123.             research(rp, t->stptr, text-t->stptr, textlen, 1) == -1)
  1124.             break;
  1125.     }
  1126.     sofar = bp - buf;
  1127.     if (buflen - sofar - textlen - 1) {
  1128.         buflen = sofar + textlen + 2;
  1129.         erealloc(buf, char *, buflen, "do_sub");
  1130.         bp = buf + sofar;
  1131.     }
  1132.     for (scan = matchend; scan < text + textlen; scan++)
  1133.         *bp++ = *scan;
  1134.     *bp = '\0';
  1135.     textlen = bp - buf;
  1136.     free(t->stptr);
  1137.     t->stptr = buf;
  1138.     t->stlen = textlen;
  1139.  
  1140.     free_temp(s);
  1141.     if (matches > 0 && lhs) {
  1142.         if (priv) {
  1143.             unref(*lhs);
  1144.             *lhs = t;
  1145.         }
  1146.         if (after_assign)
  1147.             (*after_assign)();
  1148.         t->flags &= ~(NUM|NUMBER);
  1149.     }
  1150.     return tmp_number((AWKNUM) matches);
  1151. }
  1152.  
  1153. NODE *
  1154. do_gsub(tree)
  1155. NODE *tree;
  1156. {
  1157.     return sub_common(tree, 1);
  1158. }
  1159.  
  1160. NODE *
  1161. do_sub(tree)
  1162. NODE *tree;
  1163. {
  1164.     return sub_common(tree, 0);
  1165. }
  1166.  
  1167. #ifdef GFMT_WORKAROUND
  1168. /*
  1169.  * printf's %g format [can't rely on gcvt()]
  1170.  *    caveat: don't use as argument to *printf()!
  1171.  * 'format' string HAS to be of "<flags>*.*g" kind, or we bomb!
  1172.  */
  1173. static void
  1174. sgfmt(buf, format, alt, fwidth, prec, g)
  1175. char *buf;    /* return buffer; assumed big enough to hold result */
  1176. const char *format;
  1177. int alt;    /* use alternate form flag */
  1178. int fwidth;    /* field width in a format */
  1179. int prec;    /* indicates desired significant digits, not decimal places */
  1180. double g;    /* value to format */
  1181. {
  1182.     char dform[40];
  1183.     register char *gpos;
  1184.     register char *d, *e, *p;
  1185.     int again = 0;
  1186.  
  1187.     strncpy(dform, format, sizeof dform - 1);
  1188.     dform[sizeof dform - 1] = '\0';
  1189.     gpos = strrchr(dform, '.');
  1190.  
  1191.     if (g == 0.0 && alt == 0) {    /* easy special case */
  1192.         *gpos++ = 'd';
  1193.         *gpos = '\0';
  1194.         (void) sprintf(buf, dform, fwidth, 0);
  1195.         return;
  1196.     }
  1197.     gpos += 2;  /* advance to location of 'g' in the format */
  1198.  
  1199.     if (prec <= 0)          /* negative precision is ignored */
  1200.         prec = (prec < 0 ?  DEFAULT_G_PRECISION : 1);
  1201.  
  1202.     if (*gpos == 'G')
  1203.         again = 1;
  1204.     /* start with 'e' format (it'll provide nice exponent) */
  1205.     *gpos = 'e';
  1206.     prec -= 1;
  1207.     (void) sprintf(buf, dform, fwidth, prec, g);
  1208.     if ((e = strrchr(buf, 'e')) != NULL) {    /* find exponent  */
  1209.         int exp = atoi(e+1);        /* fetch exponent */
  1210.         if (exp >= -4 && exp <= prec) {    /* per K&R2, B1.2 */
  1211.             /* switch to 'f' format and re-do */
  1212.             *gpos = 'f';
  1213.             prec -= exp;        /* decimal precision */
  1214.             (void) sprintf(buf, dform, fwidth, prec, g);
  1215.             e = buf + strlen(buf);
  1216.             while (*--e == ' ')
  1217.                 continue;
  1218.             e += 1;
  1219.         }
  1220.         else if (again != 0)
  1221.             *gpos = 'E';
  1222.  
  1223.         /* if 'alt' in force, then trailing zeros are not removed */
  1224.         if (alt == 0 && (d = strrchr(buf, '.')) != NULL) {
  1225.             /* throw away an excess of precision */
  1226.             for (p = e; p > d && *--p == '0'; )
  1227.                 prec -= 1;
  1228.             if (d == p)
  1229.                 prec -= 1;
  1230.             if (prec < 0)
  1231.                 prec = 0;
  1232.             /* and do that once again */
  1233.             again = 1;
  1234.         }
  1235.         if (again != 0)
  1236.             (void) sprintf(buf, dform, fwidth, prec, g);
  1237.     }
  1238. }
  1239. #endif    /* GFMT_WORKAROUND */
  1240.