Introduced -devel and -extras subpackages for gawk
[platform/upstream/gawk.git] / builtin.c
1 /*
2  * builtin.c - Builtin functions and various utility procedures.
3  */
4
5 /* 
6  * Copyright (C) 1986, 1988, 1989, 1991-2012 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 3 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., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
24  */
25
26
27 #include "awk.h"
28 #if defined(HAVE_FCNTL_H)
29 #include <fcntl.h>
30 #endif
31 #include <math.h>
32 #include "random.h"
33 #include "floatmagic.h"
34
35 #if defined(HAVE_POPEN_H)
36 #include "popen.h"
37 #endif
38
39 #ifndef CHAR_BIT
40 # define CHAR_BIT 8
41 #endif
42
43 /* The extra casts work around common compiler bugs.  */
44 #define TYPE_SIGNED(t) (! ((t) 0 < (t) -1))
45 /* The outer cast is needed to work around a bug in Cray C 5.0.3.0.
46    It is necessary at least when t == time_t.  */
47 #define TYPE_MINIMUM(t) ((t) (TYPE_SIGNED (t) \
48                               ? ~ (t) 0 << (sizeof (t) * CHAR_BIT - 1) : (t) 0))
49 #define TYPE_MAXIMUM(t) ((t) (~ (t) 0 - TYPE_MINIMUM (t)))
50
51 #ifndef INTMAX_MIN
52 # define INTMAX_MIN TYPE_MINIMUM (intmax_t)
53 #endif
54 #ifndef UINTMAX_MAX
55 # define UINTMAX_MAX TYPE_MAXIMUM (uintmax_t)
56 #endif
57
58 #ifndef SIZE_MAX        /* C99 constant, can't rely on it everywhere */
59 #define SIZE_MAX ((size_t) -1)
60 #endif
61
62 #define DEFAULT_G_PRECISION 6
63
64 static size_t mbc_byte_count(const char *ptr, size_t numchars);
65 static size_t mbc_char_count(const char *ptr, size_t numbytes);
66
67 /* Can declare these, since we always use the random shipped with gawk */
68 extern char *initstate(unsigned long seed, char *state, long n);
69 extern char *setstate(char *state);
70 extern long random(void);
71 extern void srandom(unsigned long seed);
72
73 extern NODE **args_array;
74 extern int max_args;
75 extern NODE **fields_arr;
76 extern int output_is_tty;
77 extern FILE *output_fp;
78
79
80 #define POP_TWO_SCALARS(s1, s2) \
81 s2 = POP_SCALAR(); \
82 s1 = POP(); \
83 if ((s1)->type == Node_var_array) \
84     DEREF(s2), fatal(_("attempt to use array `%s' in a scalar context"), array_vname(s1)), 0
85
86
87 /*
88  * Since we supply the version of random(), we know what
89  * value to use here.
90  */
91 #define GAWK_RANDOM_MAX 0x7fffffffL
92
93 static void efwrite(const void *ptr, size_t size, size_t count, FILE *fp,
94                        const char *from, struct redirect *rp, int flush);
95
96 /* efwrite --- like fwrite, but with error checking */
97
98 static void
99 efwrite(const void *ptr,
100         size_t size,
101         size_t count,
102         FILE *fp,
103         const char *from,
104         struct redirect *rp,
105         int flush)
106 {
107         errno = 0;
108         if (fwrite(ptr, size, count, fp) != count)
109                 goto wrerror;
110         if (flush
111           && ((fp == stdout && output_is_tty)
112               || (rp != NULL && (rp->flag & RED_NOBUF)))) {
113                 fflush(fp);
114                 if (ferror(fp))
115                         goto wrerror;
116         }
117         return;
118
119 wrerror:
120         fatal(_("%s to \"%s\" failed (%s)"), from,
121                 rp ? rp->value : _("standard output"),
122                 errno ? strerror(errno) : _("reason unknown"));
123 }
124
125 /* do_exp --- exponential function */
126
127 NODE *
128 do_exp(int nargs)
129 {
130         NODE *tmp;
131         double d, res;
132
133         tmp = POP_SCALAR();
134         if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
135                 lintwarn(_("exp: received non-numeric argument"));
136         d = force_number(tmp);
137         DEREF(tmp);
138         errno = 0;
139         res = exp(d);
140         if (errno == ERANGE)
141                 warning(_("exp: argument %g is out of range"), d);
142         return make_number((AWKNUM) res);
143 }
144
145 /* stdfile --- return fp for a standard file */
146
147 /*
148  * This function allows `fflush("/dev/stdout")' to work.
149  * The other files will be available via getredirect().
150  * /dev/stdin is not included, since fflush is only for output.
151  */
152
153 static FILE *
154 stdfile(const char *name, size_t len)
155 {
156         if (len == 11) {
157                 if (strncmp(name, "/dev/stderr", 11) == 0)
158                         return stderr;
159                 else if (strncmp(name, "/dev/stdout", 11) == 0)
160                         return stdout;
161         }
162
163         return NULL;
164 }
165
166 /* do_fflush --- flush output, either named file or pipe or everything */
167
168 NODE *
169 do_fflush(int nargs)
170 {
171         struct redirect *rp;
172         NODE *tmp;
173         FILE *fp;
174         int status = 0;
175         const char *file;
176
177         /* fflush() --- flush stdout */
178         if (nargs == 0) {
179                 if (output_fp != stdout)
180                         (void) fflush(output_fp);
181                 status = fflush(stdout);
182                 return make_number((AWKNUM) status);
183         }
184
185         tmp = POP_STRING();
186         file = tmp->stptr;
187
188         /* fflush("") --- flush all */
189         if (tmp->stlen == 0) {
190                 status = flush_io();
191                 DEREF(tmp);
192                 return make_number((AWKNUM) status);
193         }
194
195         rp = getredirect(tmp->stptr, tmp->stlen);
196         status = -1;
197         if (rp != NULL) {
198                 if ((rp->flag & (RED_WRITE|RED_APPEND)) == 0) {
199                         if (rp->flag & RED_PIPE)
200                                 warning(_("fflush: cannot flush: pipe `%s' opened for reading, not writing"),
201                                         file);
202                         else
203                                 warning(_("fflush: cannot flush: file `%s' opened for reading, not writing"),
204                                         file);
205                         DEREF(tmp);
206                         return make_number((AWKNUM) status);
207                 }
208                 fp = rp->fp;
209                 if (fp != NULL)
210                         status = fflush(fp);
211         } else if ((fp = stdfile(tmp->stptr, tmp->stlen)) != NULL) {
212                 status = fflush(fp);
213         } else {
214                 status = -1;
215                 warning(_("fflush: `%s' is not an open file, pipe or co-process"), file);
216         }
217         DEREF(tmp);
218         return make_number((AWKNUM) status);
219 }
220
221 #if MBS_SUPPORT
222 /* strncasecmpmbs --- like strncasecmp (multibyte string version)  */
223
224 int
225 strncasecmpmbs(const unsigned char *s1, const unsigned char *s2, size_t n)
226 {
227         size_t i1, i2, mbclen1, mbclen2, gap;
228         wchar_t wc1, wc2;
229         mbstate_t mbs1, mbs2;
230
231         memset(& mbs1, 0, sizeof(mbs1));
232         memset(& mbs2, 0, sizeof(mbs2));
233
234         for (i1 = i2 = 0 ; i1 < n && i2 < n ;i1 += mbclen1, i2 += mbclen2) {
235                 if (is_valid_character(s1[i1])) {
236                         mbclen1 = 1;
237                         wc1 = btowc_cache(s1[i1]);
238                 } else {
239                         mbclen1 = mbrtowc(& wc1, (const char *)s1 + i1,
240                                           n - i1, & mbs1);
241                         if (mbclen1 == (size_t) -1 || mbclen1 == (size_t) -2 || mbclen1 == 0) {
242                                 /* We treat it as a singlebyte character. */
243                                 mbclen1 = 1;
244                                 wc1 = btowc_cache(s1[i1]);
245                         }
246                 }
247                 if (is_valid_character(s2[i2])) {
248                         mbclen2 = 1;
249                         wc2 = btowc_cache(s2[i2]);
250                 } else {
251                         mbclen2 = mbrtowc(& wc2, (const char *)s2 + i2,
252                                           n - i2, & mbs2);
253                         if (mbclen2 == (size_t) -1 || mbclen2 == (size_t) -2 || mbclen2 == 0) {
254                                 /* We treat it as a singlebyte character. */
255                                 mbclen2 = 1;
256                                 wc2 = btowc_cache(s2[i2]);
257                         }
258                 }
259                 if ((gap = towlower(wc1) - towlower(wc2)) != 0)
260                         /* s1 and s2 are not equivalent. */
261                         return gap;
262         }
263         /* s1 and s2 are equivalent. */
264         return 0;
265 }
266
267 /* Inspect the buffer `src' and write the index of each byte to `dest'.
268    Caller must allocate `dest'.
269    e.g. str = <mb1(1)>, <mb1(2)>, a, b, <mb2(1)>, <mb2(2)>, <mb2(3)>, c
270         where mb(i) means the `i'-th byte of a multibyte character.
271                 dest =       1,        2, 1, 1,        1,        2,        3. 1
272 */
273 static void
274 index_multibyte_buffer(char* src, char* dest, int len)
275 {
276         int idx, prev_idx;
277         mbstate_t mbs, prevs;
278
279         memset(& prevs, 0, sizeof(mbstate_t));
280         for (idx = prev_idx = 0 ; idx < len ; idx++) {
281                 size_t mbclen;
282                 mbs = prevs;
283                 mbclen = mbrlen(src + prev_idx, idx - prev_idx + 1, & mbs);
284                 if (mbclen == (size_t) -1 || mbclen == 1 || mbclen == 0) {
285                         /* singlebyte character.  */
286                         mbclen = 1;
287                         prev_idx = idx + 1;
288                 } else if (mbclen == (size_t) -2) {
289                         /* a part of a multibyte character.  */
290                         mbclen = idx - prev_idx + 1;
291                 } else if (mbclen > 1) {
292                         /* the end of a multibyte character.  */
293                         prev_idx = idx + 1;
294                         prevs = mbs;
295                 } else {
296                         /* Can't reach.  */
297                 }
298                 dest[idx] = mbclen;
299     }
300 }
301 #else
302 /* a dummy function */
303 static void
304 index_multibyte_buffer(char* src ATTRIBUTE_UNUSED, char* dest ATTRIBUTE_UNUSED, int len ATTRIBUTE_UNUSED)
305 {
306         cant_happen();
307 }
308 #endif
309
310 /* do_index --- find index of a string */
311
312 NODE *
313 do_index(int nargs)
314 {
315         NODE *s1, *s2;
316         const char *p1, *p2;
317         size_t l1, l2;
318         long ret;
319 #if MBS_SUPPORT
320         int do_single_byte = FALSE;
321         mbstate_t mbs1, mbs2;
322
323         if (gawk_mb_cur_max > 1) {
324                 memset(& mbs1, 0, sizeof(mbstate_t));
325                 memset(& mbs2, 0, sizeof(mbstate_t));
326         }
327 #endif
328
329         POP_TWO_SCALARS(s1, s2);
330
331         if (do_lint) {
332                 if ((s1->flags & (STRING|STRCUR)) == 0)
333                         lintwarn(_("index: received non-string first argument"));
334                 if ((s2->flags & (STRING|STRCUR)) == 0)
335                         lintwarn(_("index: received non-string second argument"));
336         }
337         force_string(s1);
338         force_string(s2);
339         p1 = s1->stptr;
340         p2 = s2->stptr;
341         l1 = s1->stlen;
342         l2 = s2->stlen;
343         ret = 0;
344
345         /*
346          * Icky special case, index(foo, "") should return 1,
347          * since both bwk awk and mawk do, and since match("foo", "")
348          * returns 1. This makes index("", "") work, too, fwiw.
349          */
350         if (l2 == 0) {
351                 ret = 1;
352                 goto out;
353         }
354
355 #if MBS_SUPPORT
356         if (gawk_mb_cur_max > 1) {
357                 s1 = force_wstring(s1);
358                 s2 = force_wstring(s2);
359                 /*
360                  * If we don't have valid wide character strings, use
361                  * the real bytes.
362                  */
363                 do_single_byte = ((s1->wstlen == 0 && s1->stlen > 0) 
364                                         || (s2->wstlen == 0 && s2->stlen > 0));
365         }
366 #endif
367
368         /* IGNORECASE will already be false if posix */
369         if (IGNORECASE) {
370                 while (l1 > 0) {
371                         if (l2 > l1)
372                                 break;
373 #if MBS_SUPPORT
374                         if (! do_single_byte && gawk_mb_cur_max > 1) {
375                                 const wchar_t *pos;
376
377                                 pos = wcasestrstr(s1->wstptr, s1->wstlen, s2->wstptr, s2->wstlen);
378                                 if (pos == NULL)
379                                         ret = 0;
380                                 else
381                                         ret = pos - s1->wstptr + 1;     /* 1-based */
382                                 goto out;
383                         } else {
384 #endif
385                         /*
386                          * Could use tolower(*p1) == tolower(*p2) here.
387                          * See discussion in eval.c as to why not.
388                          */
389                         if (casetable[(unsigned char)*p1] == casetable[(unsigned char)*p2]
390                             && (l2 == 1 || strncasecmp(p1, p2, l2) == 0)) {
391                                 ret = 1 + s1->stlen - l1;
392                                 break;
393                         }
394                         l1--;
395                         p1++;
396 #if MBS_SUPPORT
397                         }
398 #endif
399                 }
400         } else {
401                 while (l1 > 0) {
402                         if (l2 > l1)
403                                 break;
404                         if (*p1 == *p2
405                             && (l2 == 1 || (l2 > 0 && memcmp(p1, p2, l2) == 0))) {
406                                 ret = 1 + s1->stlen - l1;
407                                 break;
408                         }
409 #if MBS_SUPPORT
410                         if (! do_single_byte && gawk_mb_cur_max > 1) {
411                                 const wchar_t *pos;
412
413                                 pos = wstrstr(s1->wstptr, s1->wstlen, s2->wstptr, s2->wstlen);
414                                 if (pos == NULL)
415                                         ret = 0;
416                                 else
417                                         ret = pos - s1->wstptr + 1;     /* 1-based */
418                                 goto out;
419                         } else {
420                                 l1--;
421                                 p1++;
422                         }
423 #else
424                         l1--;
425                         p1++;
426 #endif
427                 }
428         }
429 out:
430         DEREF(s1);
431         DEREF(s2);
432         return make_number((AWKNUM) ret);
433 }
434
435 /* double_to_int --- convert double to int, used several places */
436
437 double
438 double_to_int(double d)
439 {
440         if (d >= 0)
441                 d = Floor(d);
442         else
443                 d = Ceil(d);
444         return d;
445 }
446
447 /* do_int --- convert double to int for awk */
448
449 NODE *
450 do_int(int nargs)
451 {
452         NODE *tmp;
453         double d;
454
455         tmp = POP_SCALAR();
456         if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
457                 lintwarn(_("int: received non-numeric argument"));
458         d = force_number(tmp);
459         d = double_to_int(d);
460         DEREF(tmp);
461         return make_number((AWKNUM) d);
462 }
463
464 /* do_isarray --- check if argument is array */
465
466 NODE *
467 do_isarray(int nargs)
468 {
469         NODE *tmp;
470         int ret = 1;
471
472         tmp = POP();
473         if (tmp->type != Node_var_array) {
474                 ret = 0;
475                 DEREF(tmp);
476         }
477         return make_number((AWKNUM) ret);
478 }
479
480 /* do_length --- length of a string, array or $0 */
481
482 NODE *
483 do_length(int nargs)
484 {
485         NODE *tmp;
486         size_t len;
487
488         tmp = POP();
489         if (tmp->type == Node_var_array) {
490                 static short warned = FALSE;
491
492                 if (do_posix)
493                         fatal(_("length: received array argument"));
494                 if (do_lint && ! warned) {
495                         warned = TRUE;
496                         lintwarn(_("`length(array)' is a gawk extension"));
497                 }
498                 return make_number((AWKNUM) tmp->table_size);
499         }
500
501         assert(tmp->type == Node_val);
502
503         if (do_lint && (tmp->flags & (STRING|STRCUR)) == 0)
504                 lintwarn(_("length: received non-string argument"));
505         (void) force_string(tmp);
506
507 #if MBS_SUPPORT
508         if (gawk_mb_cur_max > 1) {
509                 tmp = force_wstring(tmp);
510                 len = tmp->wstlen;
511                 /*
512                  * If the bytes don't make a valid wide character
513                  * string, fall back to the bytes themselves.
514                  */
515                  if (len == 0 && tmp->stlen > 0)
516                          len = tmp->stlen;
517         } else
518 #endif
519                 len = tmp->stlen;
520
521         DEREF(tmp);
522         return make_number((AWKNUM) len);
523 }
524
525 /* do_log --- the log function */
526
527 NODE *
528 do_log(int nargs)
529 {
530         NODE *tmp;
531         double d, arg;
532
533         tmp = POP_SCALAR();
534         if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
535                 lintwarn(_("log: received non-numeric argument"));
536         arg = (double) force_number(tmp);
537         if (arg < 0.0)
538                 warning(_("log: received negative argument %g"), arg);
539         d = log(arg);
540         DEREF(tmp);
541         return make_number((AWKNUM) d);
542 }
543
544
545 /*
546  * format_tree() formats arguments of sprintf,
547  * and accordingly to a fmt_string providing a format like in
548  * printf family from C library.  Returns a string node which value
549  * is a formatted string.  Called by  sprintf function.
550  *
551  * It is one of the uglier parts of gawk.  Thanks to Michal Jaegermann
552  * for taming this beast and making it compatible with ANSI C.
553  */
554
555 NODE *
556 format_tree(
557         const char *fmt_string,
558         size_t n0,
559         NODE **the_args,
560         long num_args)
561 {
562 /* copy 'l' bytes from 's' to 'obufout' checking for space in the process */
563 /* difference of pointers should be of ptrdiff_t type, but let us be kind */
564 #define bchunk(s, l) if (l) { \
565         while ((l) > ofre) { \
566                 size_t olen = obufout - obuf; \
567                 erealloc(obuf, char *, osiz * 2, "format_tree"); \
568                 ofre += osiz; \
569                 osiz *= 2; \
570                 obufout = obuf + olen; \
571         } \
572         memcpy(obufout, s, (size_t) (l)); \
573         obufout += (l); \
574         ofre -= (l); \
575 }
576
577 /* copy one byte from 's' to 'obufout' checking for space in the process */
578 #define bchunk_one(s) { \
579         if (ofre < 1) { \
580                 size_t olen = obufout - obuf; \
581                 erealloc(obuf, char *, osiz * 2, "format_tree"); \
582                 ofre += osiz; \
583                 osiz *= 2; \
584                 obufout = obuf + olen; \
585         } \
586         *obufout++ = *s; \
587         --ofre; \
588 }
589
590 /* Is there space for something L big in the buffer? */
591 #define chksize(l)  if ((l) >= ofre) { \
592         size_t olen = obufout - obuf; \
593         size_t delta = osiz+l-ofre; \
594         erealloc(obuf, char *, osiz + delta, "format_tree"); \
595         obufout = obuf + olen; \
596         ofre += delta; \
597         osiz += delta; \
598 }
599
600         size_t cur_arg = 0;
601         NODE *r = NULL;
602         int i;
603         int toofew = FALSE;
604         char *obuf, *obufout;
605         size_t osiz, ofre;
606         const char *chbuf;
607         const char *s0, *s1;
608         int cs1;
609         NODE *arg;
610         long fw, prec, argnum;
611         int used_dollar;
612         int lj, alt, big_flag, bigbig_flag, small_flag, have_prec, need_format;
613         long *cur = NULL;
614         uintmax_t uval;
615         int sgn;
616         int base;
617         /*
618          * Although this is an array, the elements serve two different
619          * purposes. The first element is the general buffer meant
620          * to hold the entire result string.  The second one is a
621          * temporary buffer for large floating point values. They
622          * could just as easily be separate variables, and the
623          * code might arguably be clearer.
624          */
625         struct {
626                 char *buf;
627                 size_t bufsize;
628                 char stackbuf[30];
629         } cpbufs[2];
630 #define cpbuf   cpbufs[0].buf
631         char *cend = &cpbufs[0].stackbuf[sizeof(cpbufs[0].stackbuf)];
632         char *cp;
633         const char *fill;
634         AWKNUM tmpval;
635         char signchar = FALSE;
636         size_t len;
637         int zero_flag = FALSE;
638         int quote_flag = FALSE;
639         int ii, jj;
640         char *chp;
641         size_t copy_count, char_count;
642         static const char sp[] = " ";
643         static const char zero_string[] = "0";
644         static const char lchbuf[] = "0123456789abcdef";
645         static const char Uchbuf[] = "0123456789ABCDEF";
646
647 #define INITIAL_OUT_SIZE        512
648         emalloc(obuf, char *, INITIAL_OUT_SIZE, "format_tree");
649         obufout = obuf;
650         osiz = INITIAL_OUT_SIZE;
651         ofre = osiz - 2;
652
653         cur_arg = 1;
654
655         {
656                 size_t k;
657                 for (k = 0; k < sizeof(cpbufs)/sizeof(cpbufs[0]); k++) {
658                         cpbufs[k].bufsize = sizeof(cpbufs[k].stackbuf);
659                         cpbufs[k].buf = cpbufs[k].stackbuf;
660                 }
661         }
662
663         /*
664          * The point of this goop is to grow the buffer
665          * holding the converted number, so that large
666          * values don't overflow a fixed length buffer.
667          */
668 #define PREPEND(CH) do {        \
669         if (cp == cpbufs[0].buf) {      \
670                 char *prev = cpbufs[0].buf;     \
671                 emalloc(cpbufs[0].buf, char *, 2*cpbufs[0].bufsize, \
672                         "format_tree"); \
673                 memcpy((cp = cpbufs[0].buf+cpbufs[0].bufsize), prev,    \
674                        cpbufs[0].bufsize);      \
675                 cpbufs[0].bufsize *= 2; \
676                 if (prev != cpbufs[0].stackbuf) \
677                         efree(prev);    \
678                 cend = cpbufs[0].buf+cpbufs[0].bufsize; \
679         }       \
680         *--cp = (CH);   \
681 } while(0)
682
683         /*
684          * Check first for use of `count$'.
685          * If plain argument retrieval was used earlier, choke.
686          *      Otherwise, return the requested argument.
687          * If not `count$' now, but it was used earlier, choke.
688          * If this format is more than total number of args, choke.
689          * Otherwise, return the current argument.
690          */
691 #define parse_next_arg() { \
692         if (argnum > 0) { \
693                 if (cur_arg > 1) { \
694                         msg(_("fatal: must use `count$' on all formats or none")); \
695                         goto out; \
696                 } \
697                 arg = the_args[argnum]; \
698         } else if (used_dollar) { \
699                 msg(_("fatal: must use `count$' on all formats or none")); \
700                 arg = 0; /* shutup the compiler */ \
701                 goto out; \
702         } else if (cur_arg >= num_args) { \
703                 arg = 0; /* shutup the compiler */ \
704                 toofew = TRUE; \
705                 break; \
706         } else { \
707                 arg = the_args[cur_arg]; \
708                 cur_arg++; \
709         } \
710 }
711
712         need_format = FALSE;
713         used_dollar = FALSE;
714
715         s0 = s1 = fmt_string;
716         while (n0-- > 0) {
717                 if (*s1 != '%') {
718                         s1++;
719                         continue;
720                 }
721                 need_format = TRUE;
722                 bchunk(s0, s1 - s0);
723                 s0 = s1;
724                 cur = &fw;
725                 fw = 0;
726                 prec = 0;
727                 base = 0;
728                 argnum = 0;
729                 have_prec = FALSE;
730                 signchar = FALSE;
731                 zero_flag = FALSE;
732                 quote_flag = FALSE;
733                 lj = alt = big_flag = bigbig_flag = small_flag = FALSE;
734                 fill = sp;
735                 cp = cend;
736                 chbuf = lchbuf;
737                 s1++;
738
739 retry:
740                 if (n0-- == 0)  /* ran out early! */
741                         break;
742
743                 switch (cs1 = *s1++) {
744                 case (-1):      /* dummy case to allow for checking */
745 check_pos:
746                         if (cur != &fw)
747                                 break;          /* reject as a valid format */
748                         goto retry;
749                 case '%':
750                         need_format = FALSE;
751                         /*
752                          * 29 Oct. 2002:
753                          * The C99 standard pages 274 and 279 seem to imply that
754                          * since there's no arg converted, the field width doesn't
755                          * apply.  The code already was that way, but this
756                          * comment documents it, at least in the code.
757                          */
758                         if (do_lint) {
759                                 const char *msg = NULL;
760
761                                 if (fw && ! have_prec)
762                                         msg = _("field width is ignored for `%%' specifier");
763                                 else if (fw == 0 && have_prec)
764                                         msg = _("precision is ignored for `%%' specifier");
765                                 else if (fw && have_prec)
766                                         msg = _("field width and precision are ignored for `%%' specifier");
767
768                                 if (msg != NULL)
769                                         lintwarn("%s", msg);
770                         }
771                         bchunk_one("%");
772                         s0 = s1;
773                         break;
774
775                 case '0':
776                         /*
777                          * Only turn on zero_flag if we haven't seen
778                          * the field width or precision yet.  Otherwise,
779                          * screws up floating point formatting.
780                          */
781                         if (cur == & fw)
782                                 zero_flag = TRUE;
783                         if (lj)
784                                 goto retry;
785                         /* FALL through */
786                 case '1':
787                 case '2':
788                 case '3':
789                 case '4':
790                 case '5':
791                 case '6':
792                 case '7':
793                 case '8':
794                 case '9':
795                         if (cur == NULL)
796                                 break;
797                         if (prec >= 0)
798                                 *cur = cs1 - '0';
799                         /*
800                          * with a negative precision *cur is already set
801                          * to -1, so it will remain negative, but we have
802                          * to "eat" precision digits in any case
803                          */
804                         while (n0 > 0 && *s1 >= '0' && *s1 <= '9') {
805                                 --n0;
806                                 *cur = *cur * 10 + *s1++ - '0';
807                         }
808                         if (prec < 0)   /* negative precision is discarded */
809                                 have_prec = FALSE;
810                         if (cur == &prec)
811                                 cur = NULL;
812                         if (n0 == 0)    /* badly formatted control string */
813                                 continue;
814                         goto retry;
815                 case '$':
816                         if (do_traditional) {
817                                 msg(_("fatal: `$' is not permitted in awk formats"));
818                                 goto out;
819                         }
820
821                         if (cur == &fw) {
822                                 argnum = fw;
823                                 fw = 0;
824                                 used_dollar = TRUE;
825                                 if (argnum <= 0) {
826                                         msg(_("fatal: arg count with `$' must be > 0"));
827                                         goto out;
828                                 }
829                                 if (argnum >= num_args) {
830                                         msg(_("fatal: arg count %ld greater than total number of supplied arguments"), argnum);
831                                         goto out;
832                                 }
833                         } else {
834                                 msg(_("fatal: `$' not permitted after period in format"));
835                                 goto out;
836                         }
837
838                         goto retry;
839                 case '*':
840                         if (cur == NULL)
841                                 break;
842                         if (! do_traditional && isdigit((unsigned char) *s1)) {
843                                 int val = 0;
844
845                                 for (; n0 > 0 && *s1 && isdigit((unsigned char) *s1); s1++, n0--) {
846                                         val *= 10;
847                                         val += *s1 - '0';
848                                 }
849                                 if (*s1 != '$') {
850                                         msg(_("fatal: no `$' supplied for positional field width or precision"));
851                                         goto out;
852                                 } else {
853                                         s1++;
854                                         n0--;
855                                 }
856                                 if (val >= num_args) {
857                                         toofew = TRUE;
858                                         break;
859                                 }
860                                 arg = the_args[val];
861                         } else {
862                                 parse_next_arg();
863                         }
864                         *cur = force_number(arg);
865                         if (*cur < 0 && cur == &fw) {
866                                 *cur = -*cur;
867                                 lj++;
868                         }
869                         if (cur == &prec) {
870                                 if (*cur >= 0)
871                                         have_prec = TRUE;
872                                 else
873                                         have_prec = FALSE;
874                                 cur = NULL;
875                         }
876                         goto retry;
877                 case ' ':               /* print ' ' or '-' */
878                                         /* 'space' flag is ignored */
879                                         /* if '+' already present  */
880                         if (signchar != FALSE) 
881                                 goto check_pos;
882                         /* FALL THROUGH */
883                 case '+':               /* print '+' or '-' */
884                         signchar = cs1;
885                         goto check_pos;
886                 case '-':
887                         if (prec < 0)
888                                 break;
889                         if (cur == &prec) {
890                                 prec = -1;
891                                 goto retry;
892                         }
893                         fill = sp;      /* if left justified then other */
894                         lj++;           /* filling is ignored */
895                         goto check_pos;
896                 case '.':
897                         if (cur != &fw)
898                                 break;
899                         cur = &prec;
900                         have_prec = TRUE;
901                         goto retry;
902                 case '#':
903                         alt = TRUE;
904                         goto check_pos;
905                 case '\'':
906 #if defined(HAVE_LOCALE_H)       
907                         /* allow quote_flag if there is a thousands separator. */
908                         if (loc.thousands_sep[0] != '\0')
909                                 quote_flag = TRUE;
910                         goto check_pos;
911 #else
912                         goto retry;  
913 #endif
914                 case 'l':
915                         if (big_flag)
916                                 break;
917                         else {
918                                 static short warned = FALSE;
919                                 
920                                 if (do_lint && ! warned) {
921                                         lintwarn(_("`l' is meaningless in awk formats; ignored"));
922                                         warned = TRUE;
923                                 }
924                                 if (do_posix) {
925                                         msg(_("fatal: `l' is not permitted in POSIX awk formats"));
926                                         goto out;
927                                 }
928                         }
929                         big_flag = TRUE;
930                         goto retry;
931                 case 'L':
932                         if (bigbig_flag)
933                                 break;
934                         else {
935                                 static short warned = FALSE;
936                                 
937                                 if (do_lint && ! warned) {
938                                         lintwarn(_("`L' is meaningless in awk formats; ignored"));
939                                         warned = TRUE;
940                                 }
941                                 if (do_posix) {
942                                         msg(_("fatal: `L' is not permitted in POSIX awk formats"));
943                                         goto out;
944                                 }
945                         }
946                         bigbig_flag = TRUE;
947                         goto retry;
948                 case 'h':
949                         if (small_flag)
950                                 break;
951                         else {
952                                 static short warned = FALSE;
953                                 
954                                 if (do_lint && ! warned) {
955                                         lintwarn(_("`h' is meaningless in awk formats; ignored"));
956                                         warned = TRUE;
957                                 }
958                                 if (do_posix) {
959                                         msg(_("fatal: `h' is not permitted in POSIX awk formats"));
960                                         goto out;
961                                 }
962                         }
963                         small_flag = TRUE;
964                         goto retry;
965                 case 'c':
966                         need_format = FALSE;
967                         parse_next_arg();
968                         /* user input that looks numeric is numeric */
969                         if ((arg->flags & (MAYBE_NUM|NUMBER)) == MAYBE_NUM)
970                                 (void) force_number(arg);
971                         if (arg->flags & NUMBER) {
972                                 uval = (uintmax_t) arg->numbr;
973 #if MBS_SUPPORT
974                                 if (gawk_mb_cur_max > 1) {
975                                         char buf[100];
976                                         wchar_t wc;
977                                         mbstate_t mbs;
978                                         size_t count;
979
980                                         memset(& mbs, 0, sizeof(mbs));
981                                         wc = uval;
982
983                                         count = wcrtomb(buf, wc, & mbs);
984                                         if (count == 0
985                                             || count == (size_t)-1
986                                             || count == (size_t)-2)
987                                                 goto out0;
988
989                                         memcpy(cpbuf, buf, count);
990                                         prec = count;
991                                         cp = cpbuf;
992                                         goto pr_tail;
993                                 }
994 out0:
995                                 ;
996                                 /* else,
997                                         fall through */
998 #endif
999                                 if (do_lint && uval > 255) {
1000                                         lintwarn("[s]printf: value %g is too big for %%c format",
1001                                                         arg->numbr);
1002                                 }
1003                                 cpbuf[0] = uval;
1004                                 prec = 1;
1005                                 cp = cpbuf;
1006                                 goto pr_tail;
1007                         }
1008                         /*
1009                          * As per POSIX, only output first character of a
1010                          * string value.  Thus, we ignore any provided
1011                          * precision, forcing it to 1.  (Didn't this
1012                          * used to work? 6/2003.)
1013                          */
1014                         cp = arg->stptr;
1015 #if MBS_SUPPORT
1016                         /*
1017                          * First character can be multiple bytes if
1018                          * it's a multibyte character. Grr.
1019                          */
1020                         if (gawk_mb_cur_max > 1) {
1021                                 mbstate_t state;
1022                                 size_t count;
1023
1024                                 memset(& state, 0, sizeof(state));
1025                                 count = mbrlen(cp, arg->stlen, & state);
1026                                 if (count == 0
1027                                     || count == (size_t)-1
1028                                     || count == (size_t)-2)
1029                                         goto out2;
1030                                 prec = count;
1031                                 goto pr_tail;
1032                         }
1033 out2:
1034                         ;
1035 #endif
1036                         prec = 1;
1037                         goto pr_tail;
1038                 case 's':
1039                         need_format = FALSE;
1040                         parse_next_arg();
1041                         arg = force_string(arg);
1042                         if (fw == 0 && ! have_prec)
1043                                 prec = arg->stlen;
1044                         else {
1045                                 char_count = mbc_char_count(arg->stptr, arg->stlen);
1046                                 if (! have_prec || prec > char_count)
1047                                         prec = char_count;
1048                         }
1049                         cp = arg->stptr;
1050                         goto pr_tail;
1051                 case 'd':
1052                 case 'i':
1053                         need_format = FALSE;
1054                         parse_next_arg();
1055                         tmpval = force_number(arg);
1056                         /*
1057                          * Check for Nan or Inf.
1058                          */
1059                         if (isnan(tmpval) || isinf(tmpval))
1060                                 goto out_of_range;
1061                         else
1062                                 tmpval = double_to_int(tmpval);
1063
1064                         /*
1065                          * ``The result of converting a zero value with a
1066                          * precision of zero is no characters.''
1067                          */
1068                         if (have_prec && prec == 0 && tmpval == 0)
1069                                 goto pr_tail;
1070
1071                         if (tmpval < 0) {
1072                                 tmpval = -tmpval;
1073                                 sgn = TRUE;
1074                         } else {
1075                                 if (tmpval == -0.0)
1076                                         /* avoid printing -0 */
1077                                         tmpval = 0.0;
1078                                 sgn = FALSE;
1079                         }
1080                         /*
1081                          * Use snprintf return value to tell if there
1082                          * is enough room in the buffer or not.
1083                          */
1084                         while ((i = snprintf(cpbufs[1].buf,
1085                                              cpbufs[1].bufsize, "%.0f",
1086                                              tmpval)) >=
1087                                cpbufs[1].bufsize) {
1088                                 if (cpbufs[1].buf == cpbufs[1].stackbuf)
1089                                         cpbufs[1].buf = NULL;
1090                                 if (i > 0) {
1091                                         cpbufs[1].bufsize += ((i > cpbufs[1].bufsize) ?
1092                                                               i : cpbufs[1].bufsize);
1093                                 }
1094                                 else
1095                                         cpbufs[1].bufsize *= 2;
1096                                 assert(cpbufs[1].bufsize > 0);
1097                                 erealloc(cpbufs[1].buf, char *,
1098                                          cpbufs[1].bufsize, "format_tree");
1099                         }
1100                         if (i < 1)
1101                                 goto out_of_range;
1102                         chp = &cpbufs[1].buf[i-1];
1103                         ii = jj = 0;
1104                         do {
1105                                 PREPEND(*chp);
1106                                 chp--; i--;
1107 #if defined(HAVE_LOCALE_H)
1108                                 if (quote_flag && loc.grouping[ii] && ++jj == loc.grouping[ii]) {
1109                                         if (i)  /* only add if more digits coming */
1110                                                 PREPEND(loc.thousands_sep[0]);  /* XXX - assumption it's one char */
1111                                         if (loc.grouping[ii+1] == 0)
1112                                                 jj = 0;         /* keep using current val in loc.grouping[ii] */
1113                                         else if (loc.grouping[ii+1] == CHAR_MAX)
1114                                                 quote_flag = FALSE;
1115                                         else {                 
1116                                                 ii++;
1117                                                 jj = 0;
1118                                         }
1119                                 }
1120 #endif
1121                         } while (i > 0);
1122
1123                         /* add more output digits to match the precision */
1124                         if (have_prec) {
1125                                 while (cend - cp < prec)
1126                                         PREPEND('0');
1127                         }
1128
1129                         if (sgn)
1130                                 PREPEND('-');
1131                         else if (signchar)
1132                                 PREPEND(signchar);
1133                         /*
1134                          * When to fill with zeroes is of course not simple.
1135                          * First: No zero fill if left-justifying.
1136                          * Next: There seem to be two cases:
1137                          *      A '0' without a precision, e.g. %06d
1138                          *      A precision with no field width, e.g. %.10d
1139                          * Any other case, we don't want to fill with zeroes.
1140                          */
1141                         if (! lj
1142                             && ((zero_flag && ! have_prec)
1143                                  || (fw == 0 && have_prec)))
1144                                 fill = zero_string;
1145                         if (prec > fw)
1146                                 fw = prec;
1147                         prec = cend - cp;
1148                         if (fw > prec && ! lj && fill != sp
1149                             && (*cp == '-' || signchar)) {
1150                                 bchunk_one(cp);
1151                                 cp++;
1152                                 prec--;
1153                                 fw--;
1154                         }
1155                         goto pr_tail;
1156                 case 'X':
1157                         chbuf = Uchbuf; /* FALL THROUGH */
1158                 case 'x':
1159                         base += 6;      /* FALL THROUGH */
1160                 case 'u':
1161                         base += 2;      /* FALL THROUGH */
1162                 case 'o':
1163                         base += 8;
1164                         need_format = FALSE;
1165                         parse_next_arg();
1166                         tmpval = force_number(arg);
1167
1168                         /*
1169                          * ``The result of converting a zero value with a
1170                          * precision of zero is no characters.''
1171                          *
1172                          * If I remember the ANSI C standard, though,
1173                          * it says that for octal conversions
1174                          * the precision is artificially increased
1175                          * to add an extra 0 if # is supplied.
1176                          * Indeed, in C,
1177                          *      printf("%#.0o\n", 0);
1178                          * prints a single 0.
1179                          */
1180                         if (! alt && have_prec && prec == 0 && tmpval == 0)
1181                                 goto pr_tail;
1182
1183                         if (tmpval < 0) {
1184                                 uval = (uintmax_t) (intmax_t) tmpval;
1185                                 if ((AWKNUM)(intmax_t)uval !=
1186                                     double_to_int(tmpval))
1187                                         goto out_of_range;
1188                         } else {
1189                                 uval = (uintmax_t) tmpval;
1190                                 if ((AWKNUM)uval != double_to_int(tmpval))
1191                                         goto out_of_range;
1192                         }
1193                         /*
1194                          * When to fill with zeroes is of course not simple.
1195                          * First: No zero fill if left-justifying.
1196                          * Next: There seem to be two cases:
1197                          *      A '0' without a precision, e.g. %06d
1198                          *      A precision with no field width, e.g. %.10d
1199                          * Any other case, we don't want to fill with zeroes.
1200                          */
1201                         if (! lj
1202                             && ((zero_flag && ! have_prec)
1203                                  || (fw == 0 && have_prec)))
1204                                 fill = zero_string;
1205                         ii = jj = 0;
1206                         do {
1207                                 PREPEND(chbuf[uval % base]);
1208                                 uval /= base;
1209 #if defined(HAVE_LOCALE_H)
1210                                 if (base == 10 && quote_flag && loc.grouping[ii] && ++jj == loc.grouping[ii]) {
1211                                         if (uval)       /* only add if more digits coming */
1212                                                 PREPEND(loc.thousands_sep[0]);  /* XXX --- assumption it's one char */
1213                                         if (loc.grouping[ii+1] == 0)                                          
1214                                                 jj = 0;     /* keep using current val in loc.grouping[ii] */
1215                                         else if (loc.grouping[ii+1] == CHAR_MAX)                        
1216                                                 quote_flag = FALSE;
1217                                         else {                 
1218                                                 ii++;
1219                                                 jj = 0;
1220                                         }
1221                                 }
1222 #endif
1223                         } while (uval > 0);
1224
1225                         /* add more output digits to match the precision */
1226                         if (have_prec) {
1227                                 while (cend - cp < prec)
1228                                         PREPEND('0');
1229                         }
1230
1231                         if (alt && tmpval != 0) {
1232                                 if (base == 16) {
1233                                         PREPEND(cs1);
1234                                         PREPEND('0');
1235                                         if (fill != sp) {
1236                                                 bchunk(cp, 2);
1237                                                 cp += 2;
1238                                                 fw -= 2;
1239                                         }
1240                                 } else if (base == 8)
1241                                         PREPEND('0');
1242                         }
1243                         base = 0;
1244                         if (prec > fw)
1245                                 fw = prec;
1246                         prec = cend - cp;
1247         pr_tail:
1248                         if (! lj) {
1249                                 while (fw > prec) {
1250                                         bchunk_one(fill);
1251                                         fw--;
1252                                 }
1253                         }
1254                         copy_count = prec;
1255                         if (fw == 0 && ! have_prec)
1256                                 ;
1257                         else if (gawk_mb_cur_max > 1 && (cs1 == 's' || cs1 == 'c')) {
1258                                 assert(cp == arg->stptr || cp == cpbuf);
1259                                 copy_count = mbc_byte_count(arg->stptr, prec);
1260                         }
1261                         bchunk(cp, copy_count);
1262                         while (fw > prec) {
1263                                 bchunk_one(fill);
1264                                 fw--;
1265                         }
1266                         s0 = s1;
1267                         break;
1268
1269      out_of_range:
1270                         /* out of range - emergency use of %g format */
1271                         if (do_lint)
1272                                 lintwarn(_("[s]printf: value %g is out of range for `%%%c' format"),
1273                                                         (double) tmpval, cs1);
1274                         cs1 = 'g';
1275                         goto format_float;
1276
1277                 case 'F':
1278 #if ! defined(PRINTF_HAS_F_FORMAT) || PRINTF_HAS_F_FORMAT != 1
1279                         cs1 = 'f';
1280                         /* FALL THROUGH */
1281 #endif
1282                 case 'g':
1283                 case 'G':
1284                 case 'e':
1285                 case 'f':
1286                 case 'E':
1287                         need_format = FALSE;
1288                         parse_next_arg();
1289                         tmpval = force_number(arg);
1290      format_float:
1291                         if (! have_prec)
1292                                 prec = DEFAULT_G_PRECISION;
1293                         chksize(fw + prec + 9); /* 9 == slop */
1294                         cp = cpbuf;
1295                         *cp++ = '%';
1296                         if (lj)
1297                                 *cp++ = '-';
1298                         if (signchar)
1299                                 *cp++ = signchar;
1300                         if (alt)
1301                                 *cp++ = '#';
1302                         if (zero_flag)
1303                                 *cp++ = '0';
1304                         if (quote_flag)
1305                                 *cp++ = '\'';
1306                         strcpy(cp, "*.*");
1307                         cp += 3;
1308                         *cp++ = cs1;
1309                         *cp = '\0';
1310 #if defined(LC_NUMERIC)
1311                         if (quote_flag && ! use_lc_numeric)
1312                                 setlocale(LC_NUMERIC, "");
1313 #endif
1314                         {
1315                                 int n;
1316                                 while ((n = snprintf(obufout, ofre, cpbuf,
1317                                                      (int) fw, (int) prec,
1318                                                      (double) tmpval)) >= ofre)
1319                                         chksize(n)
1320                         }
1321 #if defined(LC_NUMERIC)
1322                         if (quote_flag && ! use_lc_numeric)
1323                                 setlocale(LC_NUMERIC, "C");
1324 #endif
1325                         len = strlen(obufout);
1326                         ofre -= len;
1327                         obufout += len;
1328                         s0 = s1;
1329                         break;
1330                 default:
1331                         if (do_lint && isalpha(cs1))
1332                                 lintwarn(_("ignoring unknown format specifier character `%c': no argument converted"), cs1);
1333                         break;
1334                 }
1335                 if (toofew) {
1336                         msg("%s\n\t`%s'\n\t%*s%s",
1337                               _("fatal: not enough arguments to satisfy format string"),
1338                               fmt_string, (int) (s1 - fmt_string - 1), "",
1339                               _("^ ran out for this one"));
1340                         goto out;
1341                 }
1342         }
1343         if (do_lint) {
1344                 if (need_format)
1345                         lintwarn(
1346                         _("[s]printf: format specifier does not have control letter"));
1347                 if (cur_arg < num_args)
1348                         lintwarn(
1349                         _("too many arguments supplied for format string"));
1350         }
1351         bchunk(s0, s1 - s0);
1352         r = make_str_node(obuf, obufout - obuf, ALREADY_MALLOCED);
1353         obuf = NULL;
1354 out:
1355         {
1356                 size_t k;
1357                 size_t count = sizeof(cpbufs)/sizeof(cpbufs[0]);
1358                 for (k = 0; k < count; k++) {
1359                         if (cpbufs[k].buf != cpbufs[k].stackbuf)
1360                                 efree(cpbufs[k].buf);
1361                 }
1362                 if (obuf != NULL)
1363                         efree(obuf);
1364         }
1365         if (r == NULL)
1366                 gawk_exit(EXIT_FATAL);
1367         return r;
1368 }
1369
1370
1371 /* printf_common --- common code for sprintf and printf */
1372
1373 static NODE *
1374 printf_common(int nargs)
1375 {
1376         int i;
1377         NODE *r, *tmp;
1378
1379         assert(nargs <= max_args);
1380         for (i = 1; i <= nargs; i++) {
1381                 tmp = args_array[nargs - i] = POP();
1382                 if (tmp->type == Node_var_array) {
1383                         while (--i > 0)
1384                                 DEREF(args_array[nargs - i]);
1385                         fatal(_("attempt to use array `%s' in a scalar context"), array_vname(tmp));
1386                 }
1387         }
1388
1389         force_string(args_array[0]);
1390         r = format_tree(args_array[0]->stptr, args_array[0]->stlen, args_array, nargs);
1391         for (i = 0; i < nargs; i++)
1392                 DEREF(args_array[i]);
1393         return r;
1394 }
1395
1396 /* do_sprintf --- perform sprintf */
1397
1398 NODE *
1399 do_sprintf(int nargs)
1400 {
1401         NODE *r;
1402         r = printf_common(nargs);
1403         if (r == NULL)
1404                 gawk_exit(EXIT_FATAL);
1405         return r;
1406 }
1407
1408
1409 /* do_printf --- perform printf, including redirection */
1410
1411 void
1412 do_printf(int nargs, int redirtype)
1413 {
1414         FILE *fp = NULL;
1415         NODE *tmp;
1416         struct redirect *rp = NULL;
1417         int errflg;     /* not used, sigh */
1418         NODE *redir_exp = NULL;
1419
1420         if (nargs == 0) {
1421                 if (do_traditional) {
1422                         if (do_lint)
1423                                 lintwarn(_("printf: no arguments"));
1424                         if (redirtype != 0) {
1425                                 redir_exp = TOP();
1426                                 if (redir_exp->type != Node_val)
1427                                         fatal(_("attempt to use array `%s' in a scalar context"), array_vname(redir_exp));
1428                                 rp = redirect(redir_exp, redirtype, & errflg);
1429                                 DEREF(redir_exp);
1430                                 decr_sp();
1431                         }
1432                         return; /* bwk accepts it silently */
1433                 }
1434                 fatal(_("printf: no arguments"));
1435         }
1436
1437         if (redirtype != 0) {
1438                 redir_exp = PEEK(nargs);
1439                 if (redir_exp->type != Node_val)
1440                         fatal(_("attempt to use array `%s' in a scalar context"), array_vname(redir_exp));
1441                 rp = redirect(redir_exp, redirtype, & errflg);
1442                 if (rp != NULL)
1443                         fp = rp->fp;
1444         } else
1445                 fp = output_fp;
1446
1447         tmp = printf_common(nargs);
1448         if (redir_exp != NULL) {
1449                 DEREF(redir_exp);
1450                 decr_sp();
1451         }
1452         if (tmp != NULL) {
1453                 if (fp == NULL) {
1454                         DEREF(tmp);
1455                         return;
1456                 }
1457                 efwrite(tmp->stptr, sizeof(char), tmp->stlen, fp, "printf", rp, TRUE);
1458                 if (rp != NULL && (rp->flag & RED_TWOWAY) != 0)
1459                         fflush(rp->fp);
1460                 DEREF(tmp);
1461         } else
1462                 gawk_exit(EXIT_FATAL);
1463 }
1464
1465 /* do_sqrt --- do the sqrt function */
1466
1467 NODE *
1468 do_sqrt(int nargs)
1469 {
1470         NODE *tmp;
1471         double arg;
1472
1473         tmp = POP_SCALAR();
1474         if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
1475                 lintwarn(_("sqrt: received non-numeric argument"));
1476         arg = (double) force_number(tmp);
1477         DEREF(tmp);
1478         if (arg < 0.0)
1479                 warning(_("sqrt: called with negative argument %g"), arg);
1480         return make_number((AWKNUM) sqrt(arg));
1481 }
1482
1483 /* do_substr --- do the substr function */
1484
1485 NODE *
1486 do_substr(int nargs)
1487 {
1488         NODE *t1;
1489         NODE *r;
1490         size_t indx;
1491         size_t length = 0;
1492         double d_index = 0, d_length = 0;
1493         size_t src_len;
1494
1495         if (nargs == 3)
1496                 POP_NUMBER(d_length);
1497         POP_NUMBER(d_index);
1498         t1 = POP_STRING();
1499
1500         if (nargs == 3) {
1501                 if (! (d_length >= 1)) {
1502                         if (do_lint == LINT_ALL)
1503                                 lintwarn(_("substr: length %g is not >= 1"), d_length);
1504                         else if (do_lint == LINT_INVALID && ! (d_length >= 0))
1505                                 lintwarn(_("substr: length %g is not >= 0"), d_length);
1506                         DEREF(t1);
1507                         return Nnull_string;
1508                 }
1509                 if (do_lint) {
1510                         if (double_to_int(d_length) != d_length)
1511                                 lintwarn(
1512                         _("substr: non-integer length %g will be truncated"),
1513                                         d_length);
1514
1515                         if (d_length > SIZE_MAX)
1516                                 lintwarn(
1517                         _("substr: length %g too big for string indexing, truncating to %g"),
1518                                         d_length, (double) SIZE_MAX);
1519                 }
1520                 if (d_length < SIZE_MAX)
1521                         length = d_length;
1522                 else
1523                         length = SIZE_MAX;
1524         }
1525
1526         /* the weird `! (foo)' tests help catch NaN values. */
1527         if (! (d_index >= 1)) {
1528                 if (do_lint)
1529                         lintwarn(_("substr: start index %g is invalid, using 1"),
1530                                  d_index);
1531                 d_index = 1;
1532         }
1533         if (do_lint && double_to_int(d_index) != d_index)
1534                 lintwarn(_("substr: non-integer start index %g will be truncated"),
1535                          d_index);
1536
1537         /* awk indices are from 1, C's are from 0 */
1538         if (d_index <= SIZE_MAX)
1539                 indx = d_index - 1;
1540         else
1541                 indx = SIZE_MAX;
1542
1543         if (nargs == 2) {       /* third arg. missing */
1544                 /* use remainder of string */
1545                 length = t1->stlen - indx;      /* default to bytes */
1546 #if MBS_SUPPORT
1547                 if (gawk_mb_cur_max > 1) {
1548                         t1 = force_wstring(t1);
1549                         if (t1->wstlen > 0)     /* use length of wide char string if we have one */
1550                                 length = t1->wstlen - indx;
1551                 }
1552 #endif
1553                 d_length = length;      /* set here in case used in diagnostics, below */
1554         }
1555
1556         if (t1->stlen == 0) {
1557                 /* substr("", 1, 0) produces a warning only if LINT_ALL */
1558                 if (do_lint && (do_lint == LINT_ALL || ((indx | length) != 0)))
1559                         lintwarn(_("substr: source string is zero length"));
1560                 DEREF(t1);
1561                 return Nnull_string;
1562         }
1563
1564         /* get total len of input string, for following checks */
1565 #if MBS_SUPPORT
1566         if (gawk_mb_cur_max > 1) {
1567                 t1 = force_wstring(t1);
1568                 src_len = t1->wstlen;
1569         } else
1570 #endif
1571                 src_len = t1->stlen;
1572
1573         if (indx >= src_len) {
1574                 if (do_lint)
1575                         lintwarn(_("substr: start index %g is past end of string"),
1576                                 d_index);
1577                 DEREF(t1);
1578                 return Nnull_string;
1579         }
1580         if (length > src_len - indx) {
1581                 if (do_lint)
1582                         lintwarn(
1583         _("substr: length %g at start index %g exceeds length of first argument (%lu)"),
1584                         d_length, d_index, (unsigned long int) src_len);
1585                 length = src_len - indx;
1586         }
1587
1588 #if MBS_SUPPORT
1589         /* force_wstring() already called */
1590         if (gawk_mb_cur_max == 1 || t1->wstlen == t1->stlen)
1591                 /* single byte case */
1592                 r = make_string(t1->stptr + indx, length);
1593         else {
1594                 /* multibyte case, more work */
1595                 size_t result;
1596                 wchar_t *wp;
1597                 mbstate_t mbs;
1598                 char *substr, *cp;
1599
1600                 /*
1601                  * Convert the wide chars in t1->wstptr back into m.b. chars.
1602                  * This is pretty grotty, but it's the most straightforward
1603                  * way to do things.
1604                  */
1605                 memset(& mbs, 0, sizeof(mbs));
1606                 emalloc(substr, char *, (length * gawk_mb_cur_max) + 2, "do_substr");
1607                 wp = t1->wstptr + indx;
1608                 for (cp = substr; length > 0; length--) {
1609                         result = wcrtomb(cp, *wp, & mbs);
1610                         if (result == (size_t) -1)      /* what to do? break seems best */
1611                                 break;
1612                         cp += result;
1613                         wp++;
1614                 }
1615                 *cp = '\0';
1616                 r = make_str_node(substr, cp - substr, ALREADY_MALLOCED);
1617         }
1618 #else
1619         r = make_string(t1->stptr + indx, length);
1620 #endif
1621
1622         DEREF(t1);
1623         return r;
1624 }
1625
1626 /* do_strftime --- format a time stamp */
1627
1628 NODE *
1629 do_strftime(int nargs)
1630 {
1631         NODE *t1, *t2, *t3, *ret;
1632         struct tm *tm;
1633         time_t fclock;
1634         long clock_val;
1635         char *bufp;
1636         size_t buflen, bufsize;
1637         char buf[BUFSIZ];
1638         const char *format;
1639         int formatlen;
1640         int do_gmt;
1641         NODE *val = NULL;
1642         NODE *sub = NULL;
1643
1644         /* set defaults first */
1645         format = def_strftime_format;   /* traditional date format */
1646         formatlen = strlen(format);
1647         (void) time(& fclock);  /* current time of day */
1648         do_gmt = FALSE;
1649
1650         if (PROCINFO_node != NULL) {
1651                 sub = make_string("strftime", 8);
1652                 val = in_array(PROCINFO_node, sub);
1653                 unref(sub);
1654
1655                 if (val != NULL) {
1656                         if (do_lint && (val->flags & STRING) == 0)
1657                                 lintwarn(_("strftime: format value in PROCINFO[\"strftime\"] has numeric type"));
1658                         val = force_string(val);
1659                         format = val->stptr;
1660                         formatlen = val->stlen;
1661                 }
1662         }
1663
1664         t1 = t2 = t3 = NULL;
1665         if (nargs > 0) {        /* have args */
1666                 NODE *tmp;
1667
1668                 if (nargs == 3) {
1669                         t3 = POP_SCALAR();
1670                         if ((t3->flags & (NUMCUR|NUMBER)) != 0)
1671                                 do_gmt = (t3->numbr != 0);
1672                         else
1673                                 do_gmt = (t3->stlen > 0);
1674                         DEREF(t3);
1675                 }
1676                         
1677                 if (nargs >= 2) {
1678                         t2 = POP_SCALAR();
1679                         if (do_lint && (t2->flags & (NUMCUR|NUMBER)) == 0)
1680                                 lintwarn(_("strftime: received non-numeric second argument"));
1681                         clock_val = (long) force_number(t2);
1682                         if (clock_val < 0)
1683                                 fatal(_("strftime: second argument less than 0 or too big for time_t"));
1684                         fclock = (time_t) clock_val;
1685                         DEREF(t2);
1686                 }
1687
1688                 tmp = POP_SCALAR();
1689                 if (do_lint && (tmp->flags & (STRING|STRCUR)) == 0)
1690                         lintwarn(_("strftime: received non-string first argument"));
1691                 t1 = force_string(tmp);
1692                 format = t1->stptr;
1693                 formatlen = t1->stlen;
1694                 if (formatlen == 0) {
1695                         if (do_lint)
1696                                 lintwarn(_("strftime: received empty format string"));
1697                         DEREF(t1);
1698                         return make_string("", 0);
1699                 }
1700         }
1701
1702         if (do_gmt)
1703                 tm = gmtime(& fclock);
1704         else
1705                 tm = localtime(& fclock);
1706
1707         bufp = buf;
1708         bufsize = sizeof(buf);
1709         for (;;) {
1710                 *bufp = '\0';
1711                 buflen = strftime(bufp, bufsize, format, tm);
1712                 /*
1713                  * buflen can be zero EITHER because there's not enough
1714                  * room in the string, or because the control command
1715                  * goes to the empty string. Make a reasonable guess that
1716                  * if the buffer is 1024 times bigger than the length of the
1717                  * format string, it's not failing for lack of room.
1718                  * Thanks to Paul Eggert for pointing out this issue.
1719                  */
1720                 if (buflen > 0 || bufsize >= 1024 * formatlen)
1721                         break;
1722                 bufsize *= 2;
1723                 if (bufp == buf)
1724                         emalloc(bufp, char *, bufsize, "do_strftime");
1725                 else
1726                         erealloc(bufp, char *, bufsize, "do_strftime");
1727         }
1728         ret = make_string(bufp, buflen);
1729         if (bufp != buf)
1730                 efree(bufp);
1731         if (t1)
1732                 DEREF(t1);
1733         return ret;
1734 }
1735
1736 /* do_systime --- get the time of day */
1737
1738 NODE *
1739 do_systime(int nargs ATTRIBUTE_UNUSED)
1740 {
1741         time_t lclock;
1742
1743         (void) time(& lclock);
1744         return make_number((AWKNUM) lclock);
1745 }
1746
1747 /* do_mktime --- turn a time string into a timestamp */
1748
1749 NODE *
1750 do_mktime(int nargs)
1751 {
1752         NODE *t1;
1753         struct tm then;
1754         long year;
1755         int month, day, hour, minute, second, count;
1756         int dst = -1; /* default is unknown */
1757         time_t then_stamp;
1758         char save;
1759
1760         t1 = POP_SCALAR();
1761         if (do_lint && (t1->flags & (STRING|STRCUR)) == 0)
1762                 lintwarn(_("mktime: received non-string argument"));
1763         t1 = force_string(t1);
1764
1765         save = t1->stptr[t1->stlen];
1766         t1->stptr[t1->stlen] = '\0';
1767
1768         count = sscanf(t1->stptr, "%ld %d %d %d %d %d %d",
1769                         & year, & month, & day,
1770                         & hour, & minute, & second,
1771                         & dst);
1772
1773     if (do_lint /* Ready? Set! Go: */
1774        && (    (second < 0 || second > 60)
1775         || (minute < 0 || minute > 60)
1776         || (hour < 0 || hour > 23)
1777         || (day < 1 || day > 31)
1778         || (month < 1 || month > 12) ))
1779         lintwarn(_("mktime: at least one of the values is out of the default range"));
1780
1781         t1->stptr[t1->stlen] = save;
1782         DEREF(t1);
1783
1784         if (count < 6
1785             || month == INT_MIN
1786             || year < INT_MIN + 1900
1787             || year - 1900 > INT_MAX)
1788                 return make_number((AWKNUM) -1);
1789
1790         memset(& then, '\0', sizeof(then));
1791         then.tm_sec = second;
1792         then.tm_min = minute;
1793         then.tm_hour = hour;
1794         then.tm_mday = day;
1795         then.tm_mon = month - 1;
1796         then.tm_year = year - 1900;
1797         then.tm_isdst = dst;
1798
1799         then_stamp = mktime(& then);
1800         return make_number((AWKNUM) then_stamp);
1801 }
1802
1803 /* do_system --- run an external command */
1804
1805 NODE *
1806 do_system(int nargs)
1807 {
1808         NODE *tmp;
1809         int ret = 0;
1810         char *cmd;
1811         char save;
1812
1813         if (do_sandbox)
1814                 fatal(_("'system' function not allowed in sandbox mode"));
1815
1816         (void) flush_io();     /* so output is synchronous with gawk's */
1817         tmp = POP_SCALAR();
1818         if (do_lint && (tmp->flags & (STRING|STRCUR)) == 0)
1819                 lintwarn(_("system: received non-string argument"));
1820         cmd = force_string(tmp)->stptr;
1821
1822         if (cmd && *cmd) {
1823                 /* insure arg to system is zero-terminated */
1824                 save = cmd[tmp->stlen];
1825                 cmd[tmp->stlen] = '\0';
1826
1827                 os_restore_mode(fileno(stdin));
1828                 ret = system(cmd);
1829                 if (ret != -1)
1830                         ret = WEXITSTATUS(ret);
1831                 if ((BINMODE & 1) != 0)
1832                         os_setbinmode(fileno(stdin), O_BINARY);
1833
1834                 cmd[tmp->stlen] = save;
1835         }
1836         DEREF(tmp);
1837         return make_number((AWKNUM) ret);
1838 }
1839
1840 extern NODE **fmt_list;  /* declared in eval.c */
1841
1842 /* do_print --- print items, separated by OFS, terminated with ORS */
1843
1844 void 
1845 do_print(int nargs, int redirtype)
1846 {
1847         struct redirect *rp = NULL;
1848         int errflg;     /* not used, sigh */
1849         FILE *fp = NULL;
1850         int i;
1851         NODE *redir_exp = NULL;
1852         NODE *tmp;
1853
1854         assert(nargs <= max_args);
1855
1856         if (redirtype != 0) {
1857                 redir_exp = PEEK(nargs);
1858                 if (redir_exp->type != Node_val)
1859                         fatal(_("attempt to use array `%s' in a scalar context"), array_vname(redir_exp));
1860                 rp = redirect(redir_exp, redirtype, & errflg);
1861                 if (rp != NULL)
1862                         fp = rp->fp;
1863         } else
1864                 fp = output_fp;
1865
1866         for (i = 1; i <= nargs; i++) {
1867                 tmp = args_array[i] = POP();
1868                 if (tmp->type == Node_var_array) {
1869                         while (--i > 0)
1870                                 DEREF(args_array[i]);
1871                         fatal(_("attempt to use array `%s' in a scalar context"), array_vname(tmp));
1872                 }
1873                 if (do_lint && tmp->type == Node_var_new)
1874                         lintwarn(_("reference to uninitialized variable `%s'"),
1875                                         tmp->vname);
1876                 if ((tmp->flags & (NUMBER|STRING)) == NUMBER) {
1877                         if (OFMTidx == CONVFMTidx)
1878                                 (void) force_string(tmp);
1879                         else
1880                                 args_array[i] = format_val(OFMT, OFMTidx, tmp);
1881                 }
1882         }
1883
1884         if (redir_exp != NULL) {
1885                 DEREF(redir_exp);
1886                 decr_sp();
1887         }
1888
1889         if (fp == NULL) {
1890                 for (i = nargs; i > 0; i--)
1891                         DEREF(args_array[i]);
1892                 return;
1893         }
1894
1895         for (i = nargs; i > 0; i--) {
1896                 efwrite(args_array[i]->stptr, sizeof(char), args_array[i]->stlen, fp, "print", rp, FALSE);
1897                 DEREF(args_array[i]);
1898                 if (i != 1 && OFSlen > 0)
1899                         efwrite(OFS, sizeof(char), (size_t) OFSlen,
1900                                 fp, "print", rp, FALSE);
1901
1902         }
1903         if (ORSlen > 0)
1904                 efwrite(ORS, sizeof(char), (size_t) ORSlen, fp, "print", rp, TRUE);
1905
1906         if (rp != NULL && (rp->flag & RED_TWOWAY) != 0)
1907                 fflush(rp->fp);
1908 }
1909
1910 /* do_print_rec --- special case printing of $0, for speed */
1911
1912 void 
1913 do_print_rec(int nargs, int redirtype)
1914 {
1915         FILE *fp = NULL;
1916         NODE *f0;
1917         struct redirect *rp = NULL;
1918         int errflg;     /* not used, sigh */
1919         NODE *redir_exp = NULL;
1920
1921         assert(nargs == 0);
1922         if (redirtype != 0) {
1923                 redir_exp = TOP();
1924                 rp = redirect(redir_exp, redirtype, & errflg);
1925                 if (rp != NULL)
1926                         fp = rp->fp;
1927                 DEREF(redir_exp);
1928                 decr_sp();
1929         } else
1930                 fp = output_fp;
1931
1932         if (fp == NULL)
1933                 return;
1934
1935         if (! field0_valid)
1936                 (void) get_field(0L, NULL);     /* rebuild record */
1937
1938         f0 = fields_arr[0];
1939
1940         if (do_lint && f0 == Nnull_string)
1941                 lintwarn(_("reference to uninitialized field `$%d'"), 0);
1942
1943         efwrite(f0->stptr, sizeof(char), f0->stlen, fp, "print", rp, FALSE);
1944
1945         if (ORSlen > 0)
1946                 efwrite(ORS, sizeof(char), (size_t) ORSlen, fp, "print", rp, TRUE);
1947
1948         if (rp != NULL && (rp->flag & RED_TWOWAY) != 0)
1949                 fflush(rp->fp);
1950 }
1951
1952 #if MBS_SUPPORT
1953
1954 /* is_wupper --- function version of iswupper for passing function pointers */
1955
1956 static int
1957 is_wupper(wchar_t c)
1958 {
1959         return iswupper(c);
1960 }
1961
1962 /* is_wlower --- function version of iswlower for passing function pointers */
1963
1964 static int
1965 is_wlower(wchar_t c)
1966 {
1967         return iswlower(c);
1968 }
1969
1970 /* to_wupper --- function version of towupper for passing function pointers */
1971
1972 static int
1973 to_wlower(wchar_t c)
1974 {
1975         return towlower(c);
1976 }
1977
1978 /* to_wlower --- function version of towlower for passing function pointers */
1979
1980 static int
1981 to_wupper(wchar_t c)
1982 {
1983         return towupper(c);
1984 }
1985
1986 /* wide_change_case --- generic case converter for wide characters */
1987
1988 static void
1989 wide_change_case(wchar_t *wstr,
1990                         size_t wlen,
1991                         int (*is_x)(wchar_t c),
1992                         int (*to_y)(wchar_t c))
1993 {
1994         size_t i;
1995         wchar_t *wcp;
1996
1997         for (i = 0, wcp = wstr; i < wlen; i++, wcp++)
1998                 if (is_x(*wcp))
1999                         *wcp = to_y(*wcp);
2000 }
2001
2002 /* wide_toupper --- map a wide string to upper case */
2003
2004 static void
2005 wide_toupper(wchar_t *wstr, size_t wlen)
2006 {
2007         wide_change_case(wstr, wlen, is_wlower, to_wupper);
2008 }
2009
2010 /* wide_tolower --- map a wide string to lower case */
2011
2012 static void
2013 wide_tolower(wchar_t *wstr, size_t wlen)
2014 {
2015         wide_change_case(wstr, wlen, is_wupper, to_wlower);
2016 }
2017 #endif
2018
2019 /* do_tolower --- lower case a string */
2020
2021 NODE *
2022 do_tolower(int nargs)
2023 {
2024         NODE *t1, *t2;
2025
2026         t1 = POP_SCALAR();
2027         if (do_lint && (t1->flags & (STRING|STRCUR)) == 0)
2028                 lintwarn(_("tolower: received non-string argument"));
2029         t1 = force_string(t1);
2030         t2 = make_string(t1->stptr, t1->stlen);
2031
2032         if (gawk_mb_cur_max == 1) {
2033                 unsigned char *cp, *cp2;
2034
2035                 for (cp = (unsigned char *)t2->stptr,
2036                      cp2 = (unsigned char *)(t2->stptr + t2->stlen);
2037                         cp < cp2; cp++)
2038                         if (isupper(*cp))
2039                                 *cp = tolower(*cp);
2040         }
2041 #if MBS_SUPPORT
2042         else {
2043                 force_wstring(t2);
2044                 wide_tolower(t2->wstptr, t2->wstlen);
2045                 wstr2str(t2);
2046         }
2047 #endif
2048
2049         DEREF(t1);
2050         return t2;
2051 }
2052
2053 /* do_toupper --- upper case a string */
2054
2055 NODE *
2056 do_toupper(int nargs)
2057 {
2058         NODE *t1, *t2;
2059
2060         t1 = POP_SCALAR();
2061         if (do_lint && (t1->flags & (STRING|STRCUR)) == 0)
2062                 lintwarn(_("toupper: received non-string argument"));
2063         t1 = force_string(t1);
2064         t2 = make_string(t1->stptr, t1->stlen);
2065
2066         if (gawk_mb_cur_max == 1) {
2067                 unsigned char *cp, *cp2;
2068
2069                 for (cp = (unsigned char *)t2->stptr,
2070                      cp2 = (unsigned char *)(t2->stptr + t2->stlen);
2071                         cp < cp2; cp++)
2072                         if (islower(*cp))
2073                                 *cp = toupper(*cp);
2074         }
2075 #if MBS_SUPPORT
2076         else {
2077                 force_wstring(t2);
2078                 wide_toupper(t2->wstptr, t2->wstlen);
2079                 wstr2str(t2);
2080         }
2081 #endif
2082
2083         DEREF(t1);
2084         return t2;
2085 }
2086
2087 /* do_atan2 --- do the atan2 function */
2088
2089 NODE *
2090 do_atan2(int nargs)
2091 {
2092         NODE *t1, *t2;
2093         double d1, d2;
2094
2095         POP_TWO_SCALARS(t1, t2);
2096         if (do_lint) {
2097                 if ((t1->flags & (NUMCUR|NUMBER)) == 0)
2098                         lintwarn(_("atan2: received non-numeric first argument"));
2099                 if ((t2->flags & (NUMCUR|NUMBER)) == 0)
2100                         lintwarn(_("atan2: received non-numeric second argument"));
2101         }
2102         d1 = force_number(t1);
2103         d2 = force_number(t2);
2104         DEREF(t1);
2105         DEREF(t2);
2106         return make_number((AWKNUM) atan2(d1, d2));
2107 }
2108
2109 /* do_sin --- do the sin function */
2110
2111 NODE *
2112 do_sin(int nargs)
2113 {
2114         NODE *tmp;
2115         double d;
2116
2117         tmp = POP_SCALAR();
2118         if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
2119                 lintwarn(_("sin: received non-numeric argument"));
2120         d = sin((double) force_number(tmp));
2121         DEREF(tmp);
2122         return make_number((AWKNUM) d);
2123 }
2124
2125 /* do_cos --- do the cos function */
2126
2127 NODE *
2128 do_cos(int nargs)
2129 {
2130         NODE *tmp;
2131         double d;
2132
2133         tmp = POP_SCALAR();
2134         if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
2135                 lintwarn(_("cos: received non-numeric argument"));
2136         d = cos((double) force_number(tmp));
2137         DEREF(tmp);
2138         return make_number((AWKNUM) d);
2139 }
2140
2141 /* do_rand --- do the rand function */
2142
2143 static int firstrand = TRUE;
2144 /* Some systems require this array to be integer aligned. Sigh. */
2145 #define SIZEOF_STATE 256
2146 static uint32_t istate[SIZEOF_STATE/sizeof(uint32_t)];
2147 static char *const state = (char *const) istate;
2148
2149 /* ARGSUSED */
2150 NODE *
2151 do_rand(int nargs ATTRIBUTE_UNUSED)
2152 {
2153         if (firstrand) {
2154                 (void) initstate((unsigned) 1, state, SIZEOF_STATE);
2155                 /* don't need to srandom(1), initstate() does it for us. */
2156                 firstrand = FALSE;
2157                 setstate(state);
2158         }
2159         /*
2160          * Per historical practice and POSIX, return value N is
2161          *
2162          *      0 <= n < 1
2163          */
2164         return make_number((AWKNUM) (random() % GAWK_RANDOM_MAX) / GAWK_RANDOM_MAX);
2165 }
2166
2167 /* do_srand --- seed the random number generator */
2168
2169 NODE *
2170 do_srand(int nargs)
2171 {
2172         NODE *tmp;
2173         static long save_seed = 1;
2174         long ret = save_seed;   /* SVR4 awk srand returns previous seed */
2175
2176         if (firstrand) {
2177                 (void) initstate((unsigned) 1, state, SIZEOF_STATE);
2178                 /* don't need to srandom(1), we're changing the seed below */
2179                 firstrand = FALSE;
2180                 (void) setstate(state);
2181         }
2182
2183         if (nargs == 0)
2184                 srandom((unsigned int) (save_seed = (long) time((time_t *) 0)));
2185         else {
2186                 tmp = POP_SCALAR();
2187                 if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
2188                         lintwarn(_("srand: received non-numeric argument"));
2189                 srandom((unsigned int) (save_seed = (long) force_number(tmp)));
2190                 DEREF(tmp);
2191         }
2192         return make_number((AWKNUM) ret);
2193 }
2194
2195 /* do_match --- match a regexp, set RSTART and RLENGTH,
2196  *      optional third arg is array filled with text of
2197  *      subpatterns enclosed in parens and start and len info.
2198  */
2199
2200 NODE *
2201 do_match(int nargs)
2202 {
2203         NODE *tre, *t1, *dest, *it;
2204         int rstart, len, ii;
2205         int rlength;
2206         Regexp *rp;
2207         regoff_t s;
2208         char *start;
2209         char *buf = NULL;
2210         char buff[100];
2211         size_t amt, oldamt = 0, ilen, slen;
2212         char *subsepstr;
2213         size_t subseplen;
2214
2215         dest = NULL;
2216         if (nargs == 3) {       /* 3rd optional arg for the subpatterns */
2217                 dest = POP_PARAM();
2218                 if (dest->type != Node_var_array)
2219                         fatal(_("match: third argument is not an array"));
2220                 assoc_clear(dest);
2221         }
2222         tre = POP();
2223         rp = re_update(tre);
2224         t1 = POP_STRING();
2225         
2226         rstart = research(rp, t1->stptr, 0, t1->stlen, RE_NEED_START);
2227         if (rstart >= 0) {      /* match succeded */
2228                 size_t *wc_indices = NULL;
2229
2230                 rlength = REEND(rp, t1->stptr) - RESTART(rp, t1->stptr);        /* byte length */
2231 #if MBS_SUPPORT
2232                 if (rlength > 0 && gawk_mb_cur_max > 1) {
2233                         t1 = str2wstr(t1, & wc_indices);
2234                         rlength = wc_indices[rstart + rlength - 1] - wc_indices[rstart] + 1;
2235                         rstart = wc_indices[rstart];
2236                 }
2237 #endif
2238                 rstart++;       /* now it's 1-based indexing */
2239         
2240                 /* Build the array only if the caller wants the optional subpatterns */
2241                 if (dest != NULL) {
2242                         subsepstr = SUBSEP_node->var_value->stptr;
2243                         subseplen = SUBSEP_node->var_value->stlen;
2244
2245                         for (ii = 0; ii < NUMSUBPATS(rp, t1->stptr); ii++) {
2246                                 /*
2247                                  * Loop over all the subpats; some of them may have
2248                                  * matched even if all of them did not.
2249                                  */
2250                                 if ((s = SUBPATSTART(rp, t1->stptr, ii)) != -1) {
2251                                         size_t subpat_start;
2252                                         size_t subpat_len;
2253                                         NODE **lhs;
2254                                         NODE *sub;
2255                                         
2256                                         start = t1->stptr + s;
2257                                         subpat_start = s;
2258                                         subpat_len = len = SUBPATEND(rp, t1->stptr, ii) - s;
2259 #if MBS_SUPPORT
2260                                         if (len > 0 && gawk_mb_cur_max > 1) {
2261                                                 subpat_start = wc_indices[s];
2262                                                 subpat_len = wc_indices[s + len - 1] - subpat_start + 1;
2263                                         }
2264 #endif
2265         
2266                                         it = make_string(start, len);
2267                                         it->flags |= MAYBE_NUM; /* user input */
2268
2269                                         sub = make_number((AWKNUM) (ii));
2270                                         lhs = assoc_lookup(dest, sub, FALSE);
2271                                         unref(*lhs);
2272                                         *lhs = it;
2273                                         unref(sub);
2274
2275                                         sprintf(buff, "%d", ii);
2276                                         ilen = strlen(buff);
2277                                         amt = ilen + subseplen + strlen("length") + 2;
2278         
2279                                         if (oldamt == 0) {
2280                                                 emalloc(buf, char *, amt, "do_match");
2281                                         } else if (amt > oldamt) {
2282                                                 erealloc(buf, char *, amt, "do_match");
2283                                         }
2284                                         oldamt = amt;
2285                                         memcpy(buf, buff, ilen);
2286                                         memcpy(buf + ilen, subsepstr, subseplen);
2287                                         memcpy(buf + ilen + subseplen, "start", 6);
2288         
2289                                         slen = ilen + subseplen + 5;
2290         
2291                                         it = make_number((AWKNUM) subpat_start + 1);
2292                                         sub = make_string(buf, slen);
2293                                         lhs = assoc_lookup(dest, sub, FALSE);
2294                                         unref(*lhs);
2295                                         *lhs = it;
2296                                         unref(sub);
2297         
2298                                         memcpy(buf, buff, ilen);
2299                                         memcpy(buf + ilen, subsepstr, subseplen);
2300                                         memcpy(buf + ilen + subseplen, "length", 7);
2301         
2302                                         slen = ilen + subseplen + 6;
2303         
2304                                         it = make_number((AWKNUM) subpat_len);
2305                                         sub = make_string(buf, slen);
2306                                         lhs = assoc_lookup(dest, sub, FALSE);
2307                                         unref(*lhs);
2308                                         *lhs = it;
2309                                         unref(sub);
2310                                 }
2311                         }
2312
2313                         efree(buf);
2314                 }
2315                 if (wc_indices != NULL)
2316                         efree(wc_indices);
2317         } else {                /* match failed */
2318                 rstart = 0;
2319                 rlength = -1;
2320         }
2321
2322         DEREF(t1);
2323         unref(RSTART_node->var_value);
2324         RSTART_node->var_value = make_number((AWKNUM) rstart);
2325         unref(RLENGTH_node->var_value);
2326         RLENGTH_node->var_value = make_number((AWKNUM) rlength);
2327         return make_number((AWKNUM) rstart);
2328 }
2329
2330 /* do_sub --- do the work for sub, gsub, and gensub */
2331
2332 /*
2333  * Gsub can be tricksy; particularly when handling the case of null strings.
2334  * The following awk code was useful in debugging problems.  It is too bad
2335  * that it does not readily translate directly into the C code, below.
2336  * 
2337  * #! /usr/local/bin/mawk -f
2338  * 
2339  * BEGIN {
2340  *      TRUE = 1; FALSE = 0
2341  *      print "--->", mygsub("abc", "b+", "FOO")
2342  *      print "--->", mygsub("abc", "x*", "X")
2343  *      print "--->", mygsub("abc", "b*", "X")
2344  *      print "--->", mygsub("abc", "c", "X")
2345  *      print "--->", mygsub("abc", "c+", "X")
2346  *      print "--->", mygsub("abc", "x*$", "X")
2347  * }
2348  * 
2349  * function mygsub(str, regex, replace, origstr, newstr, eosflag, nonzeroflag)
2350  * {
2351  *      origstr = str;
2352  *      eosflag = nonzeroflag = FALSE
2353  *      while (match(str, regex)) {
2354  *              if (RLENGTH > 0) {      # easy case
2355  *                      nonzeroflag = TRUE
2356  *                      if (RSTART == 1) {      # match at front of string
2357  *                              newstr = newstr replace
2358  *                      } else {
2359  *                              newstr = newstr substr(str, 1, RSTART-1) replace
2360  *                      }
2361  *                      str = substr(str, RSTART+RLENGTH)
2362  *              } else if (nonzeroflag) {
2363  *                      # last match was non-zero in length, and at the
2364  *                      # current character, we get a zero length match,
2365  *                      # which we don't really want, so skip over it
2366  *                      newstr = newstr substr(str, 1, 1)
2367  *                      str = substr(str, 2)
2368  *                      nonzeroflag = FALSE
2369  *              } else {
2370  *                      # 0-length match
2371  *                      if (RSTART == 1) {
2372  *                              newstr = newstr replace substr(str, 1, 1)
2373  *                              str = substr(str, 2)
2374  *                      } else {
2375  *                              return newstr str replace
2376  *                      }
2377  *              }
2378  *              if (length(str) == 0)
2379  *                      if (eosflag)
2380  *                              break
2381  *                      else
2382  *                              eosflag = TRUE
2383  *      }
2384  *      if (length(str) > 0)
2385  *              newstr = newstr str     # rest of string
2386  * 
2387  *      return newstr
2388  * }
2389  */
2390
2391 /*
2392  * 1/2004:  The gawk sub/gsub behavior dates from 1996, when we proposed it
2393  * for POSIX.  The proposal fell through the cracks, and the 2001 POSIX
2394  * standard chose a more simple behavior.
2395  *
2396  * The relevant text is to be found on lines 6394-6407 (pages 166, 167) of the
2397  * 2001 standard:
2398  * 
2399  * sub(ere, repl[, in ])
2400  *  Substitute the string repl in place of the first instance of the extended regular
2401  *  expression ERE in string in and return the number of substitutions. An ampersand
2402  *  ('&') appearing in the string repl shall be replaced by the string from in that
2403  *  matches the ERE. An ampersand preceded with a backslash ('\') shall be
2404  *  interpreted as the literal ampersand character. An occurrence of two consecutive
2405  *  backslashes shall be interpreted as just a single literal backslash character. Any
2406  *  other occurrence of a backslash (for example, preceding any other character) shall
2407  *  be treated as a literal backslash character. Note that if repl is a string literal (the
2408  *  lexical token STRING; see Grammar (on page 170)), the handling of the
2409  *  ampersand character occurs after any lexical processing, including any lexical
2410  *  backslash escape sequence processing. If in is specified and it is not an lvalue (see
2411  *  Expressions in awk (on page 156)), the behavior is undefined. If in is omitted, awk
2412  *  shall use the current record ($0) in its place.
2413  *
2414  * 11/2010: The text in the 2008 standard is the same as just quoted.  However, POSIX behavior
2415  * is now the default.  This can change the behavior of awk programs.  The old behavior
2416  * is not available.
2417  */
2418
2419 /*
2420  * NB: `howmany' conflicts with a SunOS 4.x macro in <sys/param.h>.
2421  */
2422
2423 NODE *
2424 do_sub(int nargs, unsigned int flags)
2425 {
2426         char *scan;
2427         char *bp, *cp;
2428         char *buf = NULL;
2429         size_t buflen;
2430         char *matchend;
2431         size_t len;
2432         char *matchstart;
2433         char *text;
2434         size_t textlen = 0;
2435         char *repl;
2436         char *replend;
2437         size_t repllen;
2438         int sofar;
2439         int ampersands;
2440         int matches = 0;
2441         Regexp *rp;
2442         NODE *s;                /* subst. pattern */
2443         NODE *t;                /* string to make sub. in; $0 if none given */
2444         NODE *tmp;
2445         NODE **lhs = NULL;
2446         long how_many = 1;      /* one substitution for sub, also gensub default */
2447         int global;
2448         long current;
2449         int lastmatchnonzero;
2450         char *mb_indices = NULL;
2451         
2452         if ((flags & GENSUB) != 0) {
2453                 double d;
2454                 NODE *t1;
2455
2456                 tmp = PEEK(3);
2457                 rp = re_update(tmp);
2458
2459                 t = POP_STRING();       /* original string */
2460
2461                 t1 = POP_SCALAR();      /* value of global flag */
2462                 if ((t1->flags & (STRCUR|STRING)) != 0) {
2463                         if (t1->stlen > 0 && (t1->stptr[0] == 'g' || t1->stptr[0] == 'G'))
2464                                 how_many = -1;
2465                         else {
2466                                 d = force_number(t1);
2467
2468                                 if ((t1->flags & NUMCUR) != 0)
2469                                         goto set_how_many;
2470
2471                                 how_many = 1;
2472                         }
2473                 } else {
2474                         d = force_number(t1);
2475 set_how_many:
2476                         if (d < 1)
2477                                 how_many = 1;
2478                         else if (d < LONG_MAX)
2479                                 how_many = d;
2480                         else
2481                                 how_many = LONG_MAX;
2482                         if (d == 0)
2483                                 warning(_("gensub: third argument of 0 treated as 1"));
2484                 }
2485                 DEREF(t1);
2486
2487         } else {
2488
2489                 /* take care of regexp early, in case re_update is fatal */
2490
2491                 tmp = PEEK(2);
2492                 rp = re_update(tmp);
2493
2494                 if ((flags & GSUB) != 0)
2495                         how_many = -1;
2496
2497                 /* original string */
2498
2499                 if ((flags & LITERAL) != 0)
2500                         t = POP_STRING();
2501                 else {
2502                         lhs = POP_ADDRESS();
2503                         t = force_string(*lhs);
2504                 }
2505         }
2506
2507         global = (how_many == -1);
2508
2509         s = POP_STRING();       /* replacement text */
2510         decr_sp();              /* regexp, already updated above */
2511
2512         /* do the search early to avoid work on non-match */
2513         if (research(rp, t->stptr, 0, t->stlen, RE_NEED_START) == -1 ||
2514                         RESTART(rp, t->stptr) > t->stlen)
2515                 goto done;
2516
2517         t->flags |= STRING;
2518
2519         text = t->stptr;
2520         textlen = t->stlen;
2521         buflen = textlen + 2;
2522
2523         repl = s->stptr;
2524         replend = repl + s->stlen;
2525         repllen = replend - repl;
2526         emalloc(buf, char *, buflen + 2, "do_sub");
2527         buf[buflen] = '\0';
2528         buf[buflen + 1] = '\0';
2529         ampersands = 0;
2530
2531         /*
2532          * Some systems' malloc() can't handle being called with an
2533          * argument of zero.  Thus we have to have some special case
2534          * code to check for `repllen == 0'.  This can occur for
2535          * something like:
2536          *      sub(/foo/, "", mystring)
2537          * for example.
2538          */
2539         if (gawk_mb_cur_max > 1 && repllen > 0) {
2540                 emalloc(mb_indices, char *, repllen * sizeof(char), "do_sub");
2541                 index_multibyte_buffer(repl, mb_indices, repllen);
2542         }
2543
2544         for (scan = repl; scan < replend; scan++) {
2545                 if ((gawk_mb_cur_max == 1 || (repllen > 0 && mb_indices[scan - repl] == 1))
2546                     && (*scan == '&')) {
2547                         repllen--;
2548                         ampersands++;
2549                 } else if (*scan == '\\') {
2550                         if (flags & GENSUB) {   /* gensub, behave sanely */
2551                                 if (isdigit((unsigned char) scan[1])) {
2552                                         ampersands++;
2553                                         scan++;
2554                                 } else {        /* \q for any q --> q */
2555                                         repllen--;
2556                                         scan++;
2557                                 }
2558                         } else if (do_posix) {
2559                                 /* \& --> &, \\ --> \ */
2560                                 if (scan[1] == '&' || scan[1] == '\\') {
2561                                         repllen--;
2562                                         scan++;
2563                                 } /* else
2564                                         leave alone, it goes into the output */
2565                         } else {
2566                                 /* gawk default behavior since 1996 */
2567                                 if (strncmp(scan, "\\\\\\&", 4) == 0) {
2568                                         /* \\\& --> \& */
2569                                         repllen -= 2;
2570                                         scan += 3;
2571                                 } else if (strncmp(scan, "\\\\&", 3) == 0) {
2572                                         /* \\& --> \<string> */
2573                                         ampersands++;
2574                                         repllen--;
2575                                         scan += 2;
2576                                 } else if (scan[1] == '&') {
2577                                         /* \& --> & */
2578                                         repllen--;
2579                                         scan++;
2580                                 } /* else
2581                                         leave alone, it goes into the output */
2582                         }
2583                 }
2584         }
2585
2586         lastmatchnonzero = FALSE;
2587         bp = buf;
2588         for (current = 1;; current++) {
2589                 matches++;
2590                 matchstart = t->stptr + RESTART(rp, t->stptr);
2591                 matchend = t->stptr + REEND(rp, t->stptr);
2592
2593                 /*
2594                  * create the result, copying in parts of the original
2595                  * string 
2596                  */
2597                 len = matchstart - text + repllen
2598                       + ampersands * (matchend - matchstart);
2599                 sofar = bp - buf;
2600                 while (buflen < (sofar + len + 1)) {
2601                         buflen *= 2;
2602                         erealloc(buf, char *, buflen, "sub_common");
2603                         bp = buf + sofar;
2604                 }
2605                 for (scan = text; scan < matchstart; scan++)
2606                         *bp++ = *scan;
2607                 if (global || current == how_many) {
2608                         /*
2609                          * If the current match matched the null string,
2610                          * and the last match didn't and did a replacement,
2611                          * and the match of the null string is at the front of
2612                          * the text (meaning right after end of the previous
2613                          * replacement), then skip this one.
2614                          */
2615                         if (matchstart == matchend
2616                             && lastmatchnonzero
2617                             && matchstart == text) {
2618                                 lastmatchnonzero = FALSE;
2619                                 matches--;
2620                                 goto empty;
2621                         }
2622                         /*
2623                          * If replacing all occurrences, or this is the
2624                          * match we want, copy in the replacement text,
2625                          * making substitutions as we go.
2626                          */
2627                         for (scan = repl; scan < replend; scan++)
2628                                 if (*scan == '&'
2629                                         /*
2630                                          * Don't test repllen here. A simple "&" could
2631                                          * end up with repllen == 0.
2632                                          */
2633                                         && (gawk_mb_cur_max == 1
2634                                                 || mb_indices[scan - repl] == 1)
2635                                 ) {
2636                                                 for (cp = matchstart; cp < matchend; cp++)
2637                                                                 *bp++ = *cp;
2638                                 } else if (*scan == '\\'
2639                                         && (gawk_mb_cur_max == 1
2640                                                 || (repllen > 0 && mb_indices[scan - repl] == 1))
2641                                 ) {
2642                                         if (flags & GENSUB) {   /* gensub, behave sanely */
2643                                                 if (isdigit((unsigned char) scan[1])) {
2644                                                         int dig = scan[1] - '0';
2645                                                         if (dig < NUMSUBPATS(rp, t->stptr) && SUBPATSTART(rp, tp->stptr, dig) != -1) {
2646                                                                 char *start, *end;
2647                 
2648                                                                 start = t->stptr
2649                                                                       + SUBPATSTART(rp, t->stptr, dig);
2650                                                                 end = t->stptr
2651                                                                       + SUBPATEND(rp, t->stptr, dig);
2652
2653                                                                 for (cp = start; cp < end; cp++)
2654                                                                         *bp++ = *cp;
2655                                                         }
2656                                                         scan++;
2657                                                 } else  /* \q for any q --> q */
2658                                                         *bp++ = *++scan;
2659                                         } else if (do_posix) {
2660                                                 /* \& --> &, \\ --> \ */
2661                                                 if (scan[1] == '&' || scan[1] == '\\')
2662                                                         scan++;
2663                                                 *bp++ = *scan;
2664                                         } else {
2665                                                 /* gawk default behavior since 1996 */
2666                                                 if (strncmp(scan, "\\\\\\&", 4) == 0) {
2667                                                         /* \\\& --> \& */
2668                                                         *bp++ = '\\';
2669                                                         *bp++ = '&';
2670                                                         scan += 3;
2671                                                 } else if (strncmp(scan, "\\\\&", 3) == 0) {
2672                                                         /* \\& --> \<string> */
2673                                                         *bp++ = '\\';
2674                                                         for (cp = matchstart; cp < matchend; cp++)
2675                                                                 *bp++ = *cp;
2676                                                         scan += 2;
2677                                                 } else if (scan[1] == '&') {
2678                                                         /* \& --> & */
2679                                                         *bp++ = '&';
2680                                                         scan++;
2681                                                 } else
2682                                                         *bp++ = *scan;
2683                                         }
2684                                 } else
2685                                         *bp++ = *scan;
2686                         if (matchstart != matchend)
2687                                 lastmatchnonzero = TRUE;
2688                 } else {
2689                         /*
2690                          * don't want this match, skip over it by copying
2691                          * in current text.
2692                          */
2693                         for (cp = matchstart; cp < matchend; cp++)
2694                                 *bp++ = *cp;
2695                 }
2696         empty:
2697                 /* catch the case of gsub(//, "blah", whatever), i.e. empty regexp */
2698                 if (matchstart == matchend && matchend < text + textlen) {
2699                         *bp++ = *matchend;
2700                         matchend++;
2701                 }
2702                 textlen = text + textlen - matchend;
2703                 text = matchend;
2704
2705                 if ((current >= how_many && ! global)
2706                     || ((long) textlen <= 0 && matchstart == matchend)
2707                     || research(rp, t->stptr, text - t->stptr, textlen, RE_NEED_START) == -1)
2708                         break;
2709
2710         }
2711         sofar = bp - buf;
2712         if (buflen - sofar - textlen - 1) {
2713                 buflen = sofar + textlen + 2;
2714                 erealloc(buf, char *, buflen, "do_sub");
2715                 bp = buf + sofar;
2716         }
2717         for (scan = matchend; scan < text + textlen; scan++)
2718                 *bp++ = *scan;
2719         *bp = '\0';
2720         textlen = bp - buf;
2721
2722         if (mb_indices != NULL)
2723                 efree(mb_indices);
2724
2725 done:
2726         DEREF(s);
2727
2728         if ((matches == 0 || (flags & LITERAL) != 0) && buf != NULL)
2729                 efree(buf); 
2730
2731         if (flags & GENSUB) {
2732                 if (matches > 0) {
2733                         /* return the result string */
2734                         DEREF(t);
2735                         return make_str_node(buf, textlen, ALREADY_MALLOCED);   
2736                 }
2737
2738                 /* return the original string */
2739                 return t;
2740         }
2741
2742         /* For a string literal, must not change the original string. */
2743         if (flags & LITERAL)
2744                 DEREF(t);
2745         else if (matches > 0) {
2746                 unref(*lhs);
2747                 *lhs = make_str_node(buf, textlen, ALREADY_MALLOCED);   
2748         }
2749
2750         return make_number((AWKNUM) matches);
2751 }
2752
2753
2754 /* make_integer - Convert an integer to a number node.  */
2755
2756 static NODE *
2757 make_integer(uintmax_t n)
2758 {
2759         n = adjust_uint(n);
2760
2761         return make_number((AWKNUM) n);
2762 }
2763
2764 /* do_lshift --- perform a << operation */
2765
2766 NODE *
2767 do_lshift(int nargs)
2768 {
2769         NODE *s1, *s2;
2770         uintmax_t uval, ushift, res;
2771         AWKNUM val, shift;
2772
2773         POP_TWO_SCALARS(s1, s2);
2774         if (do_lint) {
2775                 if ((s1->flags & (NUMCUR|NUMBER)) == 0)
2776                         lintwarn(_("lshift: received non-numeric first argument"));
2777                 if ((s2->flags & (NUMCUR|NUMBER)) == 0)
2778                         lintwarn(_("lshift: received non-numeric second argument"));
2779         }
2780         val = force_number(s1);
2781         shift = force_number(s2);
2782         if (do_lint) {
2783                 if (val < 0 || shift < 0)
2784                         lintwarn(_("lshift(%lf, %lf): negative values will give strange results"), val, shift);
2785                 if (double_to_int(val) != val || double_to_int(shift) != shift)
2786                         lintwarn(_("lshift(%lf, %lf): fractional values will be truncated"), val, shift);
2787                 if (shift >= sizeof(uintmax_t) * CHAR_BIT)
2788                         lintwarn(_("lshift(%lf, %lf): too large shift value will give strange results"), val, shift);
2789         }
2790
2791         DEREF(s1);
2792         DEREF(s2);
2793
2794         uval = (uintmax_t) val;
2795         ushift = (uintmax_t) shift;
2796
2797         res = uval << ushift;
2798         return make_integer(res);
2799 }
2800
2801 /* do_rshift --- perform a >> operation */
2802
2803 NODE *
2804 do_rshift(int nargs)
2805 {
2806         NODE *s1, *s2;
2807         uintmax_t uval, ushift, res;
2808         AWKNUM val, shift;
2809
2810         POP_TWO_SCALARS(s1, s2);
2811         if (do_lint) {
2812                 if ((s1->flags & (NUMCUR|NUMBER)) == 0)
2813                         lintwarn(_("rshift: received non-numeric first argument"));
2814                 if ((s2->flags & (NUMCUR|NUMBER)) == 0)
2815                         lintwarn(_("rshift: received non-numeric second argument"));
2816         }
2817         val = force_number(s1);
2818         shift = force_number(s2);
2819         if (do_lint) {
2820                 if (val < 0 || shift < 0)
2821                         lintwarn(_("rshift(%lf, %lf): negative values will give strange results"), val, shift);
2822                 if (double_to_int(val) != val || double_to_int(shift) != shift)
2823                         lintwarn(_("rshift(%lf, %lf): fractional values will be truncated"), val, shift);
2824                 if (shift >= sizeof(uintmax_t) * CHAR_BIT)
2825                         lintwarn(_("rshift(%lf, %lf): too large shift value will give strange results"), val, shift);
2826         }
2827
2828         DEREF(s1);
2829         DEREF(s2);
2830
2831         uval = (uintmax_t) val;
2832         ushift = (uintmax_t) shift;
2833
2834         res = uval >> ushift;
2835         return make_integer(res);
2836 }
2837
2838 /* do_and --- perform an & operation */
2839
2840 NODE *
2841 do_and(int nargs)
2842 {
2843         NODE *s1, *s2;
2844         uintmax_t uleft, uright, res;
2845         AWKNUM left, right;
2846
2847         POP_TWO_SCALARS(s1, s2);
2848         if (do_lint) {
2849                 if ((s1->flags & (NUMCUR|NUMBER)) == 0)
2850                         lintwarn(_("and: received non-numeric first argument"));
2851                 if ((s2->flags & (NUMCUR|NUMBER)) == 0)
2852                         lintwarn(_("and: received non-numeric second argument"));
2853         }
2854         left = force_number(s1);
2855         right = force_number(s2);
2856         if (do_lint) {
2857                 if (left < 0 || right < 0)
2858                         lintwarn(_("and(%lf, %lf): negative values will give strange results"), left, right);
2859                 if (double_to_int(left) != left || double_to_int(right) != right)
2860                         lintwarn(_("and(%lf, %lf): fractional values will be truncated"), left, right);
2861         }
2862
2863         DEREF(s1);
2864         DEREF(s2);
2865
2866         uleft = (uintmax_t) left;
2867         uright = (uintmax_t) right;
2868
2869         res = uleft & uright;
2870         return make_integer(res);
2871 }
2872
2873 /* do_or --- perform an | operation */
2874
2875 NODE *
2876 do_or(int nargs)
2877 {
2878         NODE *s1, *s2;
2879         uintmax_t uleft, uright, res;
2880         AWKNUM left, right;
2881
2882         POP_TWO_SCALARS(s1, s2);
2883         if (do_lint) {
2884                 if ((s1->flags & (NUMCUR|NUMBER)) == 0)
2885                         lintwarn(_("or: received non-numeric first argument"));
2886                 if ((s2->flags & (NUMCUR|NUMBER)) == 0)
2887                         lintwarn(_("or: received non-numeric second argument"));
2888         }
2889         left = force_number(s1);
2890         right = force_number(s2);
2891         if (do_lint) {
2892                 if (left < 0 || right < 0)
2893                         lintwarn(_("or(%lf, %lf): negative values will give strange results"), left, right);
2894                 if (double_to_int(left) != left || double_to_int(right) != right)
2895                         lintwarn(_("or(%lf, %lf): fractional values will be truncated"), left, right);
2896         }
2897
2898         DEREF(s1);
2899         DEREF(s2);
2900
2901         uleft = (uintmax_t) left;
2902         uright = (uintmax_t) right;
2903
2904         res = uleft | uright;
2905         return make_integer(res);
2906 }
2907
2908 /* do_xor --- perform an ^ operation */
2909
2910 NODE *
2911 do_xor(int nargs)
2912 {
2913         NODE *s1, *s2;
2914         uintmax_t uleft, uright, res;
2915         AWKNUM left, right;
2916
2917         POP_TWO_SCALARS(s1, s2);
2918         left = force_number(s1);
2919         right = force_number(s2);
2920
2921         if (do_lint) {
2922                 if ((s1->flags & (NUMCUR|NUMBER)) == 0)
2923                         lintwarn(_("xor: received non-numeric first argument"));
2924                 if ((s2->flags & (NUMCUR|NUMBER)) == 0)
2925                         lintwarn(_("xor: received non-numeric second argument"));
2926         }
2927         left = force_number(s1);
2928         right = force_number(s2);
2929         if (do_lint) {
2930                 if (left < 0 || right < 0)
2931                         lintwarn(_("xor(%lf, %lf): negative values will give strange results"), left, right);
2932                 if (double_to_int(left) != left || double_to_int(right) != right)
2933                         lintwarn(_("xor(%lf, %lf): fractional values will be truncated"), left, right);
2934         }
2935
2936         DEREF(s1);
2937         DEREF(s2);
2938
2939         uleft = (uintmax_t) left;
2940         uright = (uintmax_t) right;
2941
2942         res = uleft ^ uright;
2943         return make_integer(res);
2944 }
2945
2946 /* do_compl --- perform a ~ operation */
2947
2948 NODE *
2949 do_compl(int nargs)
2950 {
2951         NODE *tmp;
2952         double d;
2953         uintmax_t uval;
2954
2955         tmp = POP_SCALAR();
2956         if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
2957                 lintwarn(_("compl: received non-numeric argument"));
2958         d = force_number(tmp);
2959         DEREF(tmp);
2960
2961         if (do_lint) {
2962                 if ((tmp->flags & (NUMCUR|NUMBER)) == 0)
2963                         lintwarn(_("compl: received non-numeric argument"));
2964                 if (d < 0)
2965                         lintwarn(_("compl(%lf): negative value will give strange results"), d);
2966                 if (double_to_int(d) != d)
2967                         lintwarn(_("compl(%lf): fractional value will be truncated"), d);
2968         }
2969
2970         uval = (uintmax_t) d;
2971         uval = ~ uval;
2972         return make_integer(uval);
2973 }
2974
2975 /* do_strtonum --- the strtonum function */
2976
2977 NODE *
2978 do_strtonum(int nargs)
2979 {
2980         NODE *tmp;
2981         AWKNUM d;
2982
2983         tmp = POP_SCALAR();
2984         if ((tmp->flags & (NUMBER|NUMCUR)) != 0)
2985                 d = (AWKNUM) force_number(tmp);
2986         else if (isnondecimal(tmp->stptr, use_lc_numeric))
2987                 d = nondec2awknum(tmp->stptr, tmp->stlen);
2988         else
2989                 d = (AWKNUM) force_number(tmp);
2990
2991         DEREF(tmp);
2992         return make_number((AWKNUM) d);
2993 }
2994
2995 /* nondec2awknum --- convert octal or hex value to double */
2996
2997 /*
2998  * Because of awk's concatenation rules and the way awk.y:yylex()
2999  * collects a number, this routine has to be willing to stop on the
3000  * first invalid character.
3001  */
3002
3003 AWKNUM
3004 nondec2awknum(char *str, size_t len)
3005 {
3006         AWKNUM retval = 0.0;
3007         char save;
3008         short val;
3009         char *start = str;
3010
3011         if (*str == '0' && (str[1] == 'x' || str[1] == 'X')) {
3012                 /*
3013                  * User called strtonum("0x") or some such,
3014                  * so just quit early.
3015                  */
3016                 if (len <= 2)
3017                         return (AWKNUM) 0.0;
3018
3019                 for (str += 2, len -= 2; len > 0; len--, str++) {
3020                         switch (*str) {
3021                         case '0':
3022                         case '1':
3023                         case '2':
3024                         case '3':
3025                         case '4':
3026                         case '5':
3027                         case '6':
3028                         case '7':
3029                         case '8':
3030                         case '9':
3031                                 val = *str - '0';
3032                                 break;
3033                         case 'a':
3034                         case 'b':
3035                         case 'c':
3036                         case 'd':
3037                         case 'e':
3038                         case 'f':
3039                                 val = *str - 'a' + 10;
3040                                 break;
3041                         case 'A':
3042                         case 'B':
3043                         case 'C':
3044                         case 'D':
3045                         case 'E':
3046                         case 'F':
3047                                 val = *str - 'A' + 10;
3048                                 break;
3049                         default:
3050                                 goto done;
3051                         }
3052                         retval = (retval * 16) + val;
3053                 }
3054         } else if (*str == '0') {
3055                 for (; len > 0; len--) {
3056                         if (! isdigit((unsigned char) *str))
3057                                 goto done;
3058                         else if (*str == '8' || *str == '9') {
3059                                 str = start;
3060                                 goto decimal;
3061                         }
3062                         retval = (retval * 8) + (*str - '0');
3063                         str++;
3064                 }
3065         } else {
3066 decimal:
3067                 save = str[len];
3068                 retval = strtod(str, NULL);
3069                 str[len] = save;
3070         }
3071 done:
3072         return retval;
3073 }
3074
3075 /* do_dcgettext, do_dcngettext --- handle i18n translations */
3076
3077 #if ENABLE_NLS && defined(LC_MESSAGES) && HAVE_DCGETTEXT
3078
3079 static int
3080 localecategory_from_argument(NODE *t)
3081 {
3082         static const struct category_table {
3083                 int val;
3084                 const char *name;
3085         } cat_tab[] = {
3086 #ifdef LC_ALL
3087                 { LC_ALL,       "LC_ALL" },
3088 #endif /* LC_ALL */
3089 #ifdef LC_COLLATE
3090                 { LC_COLLATE,   "LC_COLLATE" },
3091 #endif /* LC_COLLATE */
3092 #ifdef LC_CTYPE
3093                 { LC_CTYPE,     "LC_CTYPE" },
3094 #endif /* LC_CTYPE */
3095 #ifdef LC_MESSAGES
3096                 { LC_MESSAGES,  "LC_MESSAGES" },
3097 #endif /* LC_MESSAGES */
3098 #ifdef LC_MONETARY
3099                 { LC_MONETARY,  "LC_MONETARY" },
3100 #endif /* LC_MONETARY */
3101 #ifdef LC_NUMERIC
3102                 { LC_NUMERIC,   "LC_NUMERIC" },
3103 #endif /* LC_NUMERIC */
3104 #ifdef LC_RESPONSE
3105                 { LC_RESPONSE,  "LC_RESPONSE" },
3106 #endif /* LC_RESPONSE */
3107 #ifdef LC_TIME
3108                 { LC_TIME,      "LC_TIME" },
3109 #endif /* LC_TIME */
3110         };
3111
3112         if (t != NULL) {
3113                 int low, high, i, mid;
3114                 char *category;
3115                 int lc_cat = -1;
3116
3117                 category = t->stptr;
3118
3119                 /* binary search the table */
3120                 low = 0;
3121                 high = (sizeof(cat_tab) / sizeof(cat_tab[0])) - 1;
3122                 while (low <= high) {
3123                         mid = (low + high) / 2;
3124                         i = strcmp(category, cat_tab[mid].name);
3125
3126                         if (i < 0)              /* category < mid */
3127                                 high = mid - 1;
3128                         else if (i > 0)         /* category > mid */
3129                                 low = mid + 1;
3130                         else {
3131                                 lc_cat = cat_tab[mid].val;
3132                                 break;
3133                         }
3134                 }
3135                 if (lc_cat == -1)       /* not there */
3136                         fatal(_("dcgettext: `%s' is not a valid locale category"), category);
3137
3138                 return lc_cat;
3139         } else
3140                 return LC_MESSAGES;
3141 }
3142
3143 #endif
3144
3145 /*
3146  * awk usage is
3147  *
3148  *      str = dcgettext(string [, domain [, category]])
3149  *      str = dcngettext(string1, string2, number [, domain [, category]])
3150  *
3151  * Default domain is TEXTDOMAIN, default category is LC_MESSAGES.
3152  */
3153
3154 NODE *
3155 do_dcgettext(int nargs)
3156 {
3157         NODE *tmp, *t1, *t2 = NULL;
3158         char *string;
3159         char *the_result;
3160 #if ENABLE_NLS && defined(LC_MESSAGES) && HAVE_DCGETTEXT
3161         int lc_cat;
3162         char *domain;
3163
3164         if (nargs == 3) {       /* third argument */
3165                 tmp = POP_STRING();
3166                 lc_cat = localecategory_from_argument(tmp);
3167                 DEREF(tmp);
3168         } else
3169                 lc_cat = LC_MESSAGES;
3170
3171         if (nargs >= 2) {  /* second argument */
3172                 t2 = POP_STRING();
3173                 domain = t2->stptr;
3174         } else
3175                 domain = TEXTDOMAIN;
3176 #else
3177         if (nargs == 3) {
3178                 tmp = POP_STRING();
3179                 DEREF(tmp);
3180         }
3181         if (nargs >= 2) {
3182                 t2 = POP_STRING();
3183                 DEREF(t2);
3184         }
3185 #endif
3186
3187         t1 = POP_STRING();      /* first argument */
3188         string = t1->stptr;
3189
3190 #if ENABLE_NLS && defined(LC_MESSAGES) && HAVE_DCGETTEXT
3191         the_result = dcgettext(domain, string, lc_cat);
3192         if (t2 != NULL)
3193                 DEREF(t2);
3194 #else
3195         the_result = string;
3196 #endif
3197         DEREF(t1);
3198         return make_string(the_result, strlen(the_result));
3199 }
3200
3201
3202 NODE *
3203 do_dcngettext(int nargs)
3204 {
3205         NODE *tmp, *t1, *t2, *t3;
3206         char *string1, *string2;
3207         unsigned long number;
3208         AWKNUM d;
3209         char *the_result;
3210
3211 #if ENABLE_NLS && defined(LC_MESSAGES) && HAVE_DCGETTEXT
3212         int lc_cat;
3213         char *domain;
3214
3215         if (nargs == 5) {       /* fifth argument */
3216                 tmp = POP_STRING();
3217                 lc_cat = localecategory_from_argument(tmp);
3218                 DEREF(tmp);
3219         } else
3220                 lc_cat = LC_MESSAGES;
3221
3222         t3 = NULL;
3223         if (nargs >= 4) {       /* fourth argument */
3224                 t3 = POP_STRING();
3225                 domain = t3->stptr;
3226         } else
3227                 domain = TEXTDOMAIN;
3228 #else
3229         if (nargs == 5) {
3230                 tmp = POP_STRING();
3231                 DEREF(tmp);
3232         }
3233         if (nargs >= 4) {
3234                 t3 = POP_STRING();
3235                 DEREF(t3);
3236         }
3237 #endif
3238
3239         POP_NUMBER(d);  /* third argument */
3240         number = (unsigned long) double_to_int(d);
3241         t2 = POP_STRING();      /* second argument */
3242         string2 = t2->stptr;
3243         t1 = POP_STRING();      /* first argument */
3244         string1 = t1->stptr;
3245
3246 #if ENABLE_NLS && defined(LC_MESSAGES) && HAVE_DCGETTEXT
3247
3248         the_result = dcngettext(domain, string1, string2, number, lc_cat);
3249         if (t3 != NULL)
3250                 DEREF(t3);
3251 #else
3252         the_result = (number == 1 ? string1 : string2);
3253 #endif
3254         DEREF(t1);
3255         DEREF(t2);
3256         return make_string(the_result, strlen(the_result));
3257 }
3258
3259 /* do_bindtextdomain --- set the directory for a text domain */
3260
3261 /*
3262  * awk usage is
3263  *
3264  *      binding = bindtextdomain(dir [, domain])
3265  *
3266  * If dir is "", pass NULL to C version.
3267  * Default domain is TEXTDOMAIN.
3268  */
3269
3270 NODE *
3271 do_bindtextdomain(int nargs)
3272 {
3273         NODE *t1, *t2;
3274         const char *directory, *domain;
3275         const char *the_result;
3276
3277         t1 = t2 = NULL;
3278         /* set defaults */
3279         directory = NULL;
3280         domain = TEXTDOMAIN;
3281
3282         if (nargs == 2) {       /* second argument */
3283                 t2 = POP_STRING();
3284                 domain = (const char *) t2->stptr;
3285         }
3286
3287         /* first argument */
3288         t1 = POP_STRING();
3289         if (t1->stlen > 0)
3290                 directory = (const char *) t1->stptr;
3291
3292         the_result = bindtextdomain(domain, directory);
3293
3294         DEREF(t1);
3295         if (t2 != NULL)
3296                 DEREF(t2);
3297
3298         return make_string(the_result, strlen(the_result));
3299 }
3300
3301
3302 /* mbc_byte_count --- return number of bytes for corresponding numchars multibyte characters */
3303
3304 static size_t
3305 mbc_byte_count(const char *ptr, size_t numchars)
3306 {
3307 #if MBS_SUPPORT
3308         mbstate_t cur_state;
3309         size_t sum = 0;
3310         int mb_len;
3311
3312         memset(& cur_state, 0, sizeof(cur_state));
3313
3314         assert(gawk_mb_cur_max > 1);
3315         mb_len = mbrlen(ptr, numchars * gawk_mb_cur_max, &cur_state);
3316         if (mb_len <= 0)
3317                 return numchars;        /* no valid m.b. char */
3318
3319         for (; numchars > 0; numchars--) {
3320                 mb_len = mbrlen(ptr, numchars * gawk_mb_cur_max, &cur_state);
3321                 if (mb_len <= 0)
3322                         break;
3323                 sum += mb_len;
3324                 ptr += mb_len;
3325         }
3326
3327         return sum;
3328 #else
3329         return numchars;
3330 #endif
3331 }
3332
3333 /* mbc_char_count --- return number of m.b. chars in string, up to numbytes bytes */
3334
3335 static size_t
3336 mbc_char_count(const char *ptr, size_t numbytes)
3337 {
3338 #if MBS_SUPPORT
3339         mbstate_t cur_state;
3340         size_t sum = 0;
3341         int mb_len;
3342
3343         if (gawk_mb_cur_max == 1)
3344                 return numbytes;
3345
3346         memset(& cur_state, 0, sizeof(cur_state));
3347
3348         mb_len = mbrlen(ptr, numbytes * gawk_mb_cur_max, &cur_state);
3349         if (mb_len <= 0)
3350                 return numbytes;        /* no valid m.b. char */
3351
3352         for (; numbytes > 0; numbytes--) {
3353                 mb_len = mbrlen(ptr, numbytes * gawk_mb_cur_max, &cur_state);
3354                 if (mb_len <= 0)
3355                         break;
3356                 sum++;
3357                 ptr += mb_len;
3358         }
3359
3360         return sum;
3361 #else
3362         return numbytes;
3363 #endif
3364 }