contrib/awk/builtin.c

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