]> git.lizzy.rs Git - plan9front.git/blob - sys/src/cmd/awk/run.c
rune(2): add Runeerror reencoding considerations in BUGS section (thanks aiju)
[plan9front.git] / sys / src / cmd / awk / run.c
1 /****************************************************************
2 Copyright (C) Lucent Technologies 1997
3 All Rights Reserved
4
5 Permission to use, copy, modify, and distribute this software and
6 its documentation for any purpose and without fee is hereby
7 granted, provided that the above copyright notice appear in all
8 copies and that both that the copyright notice and this
9 permission notice and warranty disclaimer appear in supporting
10 documentation, and that the name Lucent Technologies or any of
11 its entities not be used in advertising or publicity pertaining
12 to distribution of the software without specific, written prior
13 permission.
14
15 LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
16 INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
17 IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
18 SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
19 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
20 IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
21 ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
22 THIS SOFTWARE.
23 ****************************************************************/
24
25 #define DEBUG
26 #include <stdio.h>
27 #include <ctype.h>
28 #include <setjmp.h>
29 #include <math.h>
30 #include <string.h>
31 #include <stdlib.h>
32 #include <time.h>
33 #include <utf.h>
34 #include "awk.h"
35 #include "y.tab.h"
36
37 #define tempfree(x)     if (istemp(x)) tfree(x); else
38
39 /*
40 #undef tempfree
41
42 void tempfree(Cell *p) {
43         if (p->ctype == OCELL && (p->csub < CUNK || p->csub > CFREE)) {
44                 WARNING("bad csub %d in Cell %d %s",
45                         p->csub, p->ctype, p->sval);
46         }
47         if (istemp(p))
48                 tfree(p);
49 }
50 */
51
52 #ifdef _NFILE
53 #ifndef FOPEN_MAX
54 #define FOPEN_MAX _NFILE
55 #endif
56 #endif
57
58 #ifndef FOPEN_MAX
59 #define FOPEN_MAX       40      /* max number of open files */
60 #endif
61
62 #ifndef RAND_MAX
63 #define RAND_MAX        32767   /* all that ansi guarantees */
64 #endif
65
66 jmp_buf env;
67 extern  int     pairstack[];
68
69 Node    *winner = NULL; /* root of parse tree */
70 Cell    *tmps;          /* free temporary cells for execution */
71
72 static Cell     truecell        ={ OBOOL, BTRUE, 0, 0, 1.0, NUM };
73 Cell    *True   = &truecell;
74 static Cell     falsecell       ={ OBOOL, BFALSE, 0, 0, 0.0, NUM };
75 Cell    *False  = &falsecell;
76 static Cell     breakcell       ={ OJUMP, JBREAK, 0, 0, 0.0, NUM };
77 Cell    *jbreak = &breakcell;
78 static Cell     contcell        ={ OJUMP, JCONT, 0, 0, 0.0, NUM };
79 Cell    *jcont  = &contcell;
80 static Cell     nextcell        ={ OJUMP, JNEXT, 0, 0, 0.0, NUM };
81 Cell    *jnext  = &nextcell;
82 static Cell     nextfilecell    ={ OJUMP, JNEXTFILE, 0, 0, 0.0, NUM };
83 Cell    *jnextfile      = &nextfilecell;
84 static Cell     exitcell        ={ OJUMP, JEXIT, 0, 0, 0.0, NUM };
85 Cell    *jexit  = &exitcell;
86 static Cell     retcell         ={ OJUMP, JRET, 0, 0, 0.0, NUM };
87 Cell    *jret   = &retcell;
88 static Cell     tempcell        ={ OCELL, CTEMP, 0, "", 0.0, NUM|STR|DONTFREE };
89
90 Node    *curnode = NULL;        /* the node being executed, for debugging */
91
92 /* buffer memory management */
93 int adjbuf(char **pbuf, int *psiz, int minlen, int quantum, char **pbptr,
94         char *whatrtn)
95 /* pbuf:    address of pointer to buffer being managed
96  * psiz:    address of buffer size variable
97  * minlen:  minimum length of buffer needed
98  * quantum: buffer size quantum
99  * pbptr:   address of movable pointer into buffer, or 0 if none
100  * whatrtn: name of the calling routine if failure should cause fatal error
101  *
102  * return   0 for realloc failure, !=0 for success
103  */
104 {
105         if (minlen > *psiz) {
106                 char *tbuf;
107                 int rminlen = quantum ? minlen % quantum : 0;
108                 int boff = pbptr ? *pbptr - *pbuf : 0;
109                 /* round up to next multiple of quantum */
110                 if (rminlen)
111                         minlen += quantum - rminlen;
112                 tbuf = (char *) realloc(*pbuf, minlen);
113                 if (tbuf == NULL) {
114                         if (whatrtn)
115                                 FATAL("out of memory in %s", whatrtn);
116                         return 0;
117                 }
118                 *pbuf = tbuf;
119                 *psiz = minlen;
120                 if (pbptr)
121                         *pbptr = tbuf + boff;
122         }
123         return 1;
124 }
125
126 void run(Node *a)       /* execution of parse tree starts here */
127 {
128         extern void stdinit(void);
129
130         stdinit();
131         execute(a);
132         closeall();
133 }
134
135 Cell *execute(Node *u)  /* execute a node of the parse tree */
136 {
137         int nobj;
138         Cell *(*proc)(Node **, int);
139         Cell *x;
140         Node *a;
141
142         if (u == NULL)
143                 return(True);
144         for (a = u; ; a = a->nnext) {
145                 curnode = a;
146                 if (isvalue(a)) {
147                         x = (Cell *) (a->narg[0]);
148                         if (isfld(x) && !donefld)
149                                 fldbld();
150                         else if (isrec(x) && !donerec)
151                                 recbld();
152                         return(x);
153                 }
154                 nobj = a->nobj;
155                 if (notlegal(nobj))     /* probably a Cell* but too risky to print */
156                         FATAL("illegal statement");
157                 proc = proctab[nobj-FIRSTTOKEN];
158                 x = (*proc)(a->narg, nobj);
159                 if (isfld(x) && !donefld)
160                         fldbld();
161                 else if (isrec(x) && !donerec)
162                         recbld();
163                 if (isexpr(a))
164                         return(x);
165                 if (isjump(x))
166                         return(x);
167                 if (a->nnext == NULL)
168                         return(x);
169                 tempfree(x);
170         }
171 }
172
173
174 Cell *program(Node **a, int n)  /* execute an awk program */
175 {                               /* a[0] = BEGIN, a[1] = body, a[2] = END */
176         Cell *x;
177
178         if (setjmp(env) != 0)
179                 goto ex;
180         if (a[0]) {             /* BEGIN */
181                 x = execute(a[0]);
182                 if (isexit(x))
183                         return(True);
184                 if (isjump(x))
185                         FATAL("illegal break, continue, next or nextfile from BEGIN");
186                 tempfree(x);
187         }
188         if (a[1] || a[2])
189                 while (getrec(&record, &recsize, 1) > 0) {
190                         x = execute(a[1]);
191                         if (isexit(x))
192                                 break;
193                         tempfree(x);
194                 }
195   ex:
196         if (setjmp(env) != 0)   /* handles exit within END */
197                 goto ex1;
198         if (a[2]) {             /* END */
199                 x = execute(a[2]);
200                 if (isbreak(x) || isnext(x) || iscont(x))
201                         FATAL("illegal break, continue, next or nextfile from END");
202                 tempfree(x);
203         }
204   ex1:
205         return(True);
206 }
207
208 struct Frame {  /* stack frame for awk function calls */
209         int nargs;      /* number of arguments in this call */
210         Cell *fcncell;  /* pointer to Cell for function */
211         Cell **args;    /* pointer to array of arguments after execute */
212         Cell *retval;   /* return value */
213 };
214
215 #define NARGS   50      /* max args in a call */
216
217 struct Frame *frame = NULL;     /* base of stack frames; dynamically allocated */
218 int     nframe = 0;             /* number of frames allocated */
219 struct Frame *fp = NULL;        /* frame pointer. bottom level unused */
220
221 Cell *call(Node **a, int n)     /* function call.  very kludgy and fragile */
222 {
223         static Cell newcopycell = { OCELL, CCOPY, 0, "", 0.0, NUM|STR|DONTFREE };
224         int i, ncall, ndef;
225         Node *x;
226         Cell *args[NARGS], *oargs[NARGS];       /* BUG: fixed size arrays */
227         Cell *y, *z, *fcn;
228         char *s;
229
230         fcn = execute(a[0]);    /* the function itself */
231         s = fcn->nval;
232         if (!isfcn(fcn))
233                 FATAL("calling undefined function %s", s);
234         if (frame == NULL) {
235                 fp = frame = (struct Frame *) calloc(nframe += 100, sizeof(struct Frame));
236                 if (frame == NULL)
237                         FATAL("out of space for stack frames calling %s", s);
238         }
239         for (ncall = 0, x = a[1]; x != NULL; x = x->nnext)      /* args in call */
240                 ncall++;
241         ndef = (int) fcn->fval;                 /* args in defn */
242            dprintf( ("calling %s, %d args (%d in defn), fp=%d\n", s, ncall, ndef, (int) (fp-frame)) );
243         if (ncall > ndef)
244                 WARNING("function %s called with %d args, uses only %d",
245                         s, ncall, ndef);
246         if (ncall + ndef > NARGS)
247                 FATAL("function %s has %d arguments, limit %d", s, ncall+ndef, NARGS);
248         for (i = 0, x = a[1]; x != NULL; i++, x = x->nnext) {   /* get call args */
249                    dprintf( ("evaluate args[%d], fp=%d:\n", i, (int) (fp-frame)) );
250                 y = execute(x);
251                 oargs[i] = y;
252                    dprintf( ("args[%d]: %s %f <%s>, t=%o\n",
253                            i, y->nval, y->fval, isarr(y) ? "(array)" : y->sval, y->tval) );
254                 if (isfcn(y))
255                         FATAL("can't use function %s as argument in %s", y->nval, s);
256                 if (isarr(y))
257                         args[i] = y;    /* arrays by ref */
258                 else
259                         args[i] = copycell(y);
260                 tempfree(y);
261         }
262         for ( ; i < ndef; i++) {        /* add null args for ones not provided */
263                 args[i] = gettemp();
264                 *args[i] = newcopycell;
265         }
266         fp++;   /* now ok to up frame */
267         if (fp >= frame + nframe) {
268                 int dfp = fp - frame;   /* old index */
269                 frame = (struct Frame *)
270                         realloc((char *) frame, (nframe += 100) * sizeof(struct Frame));
271                 if (frame == NULL)
272                         FATAL("out of space for stack frames in %s", s);
273                 fp = frame + dfp;
274         }
275         fp->fcncell = fcn;
276         fp->args = args;
277         fp->nargs = ndef;       /* number defined with (excess are locals) */
278         fp->retval = gettemp();
279
280            dprintf( ("start exec of %s, fp=%d\n", s, (int) (fp-frame)) );
281         y = execute((Node *)(fcn->sval));       /* execute body */
282            dprintf( ("finished exec of %s, fp=%d\n", s, (int) (fp-frame)) );
283
284         for (i = 0; i < ndef; i++) {
285                 Cell *t = fp->args[i];
286                 if (isarr(t)) {
287                         if (t->csub == CCOPY) {
288                                 if (i >= ncall) {
289                                         freesymtab(t);
290                                         t->csub = CTEMP;
291                                         tempfree(t);
292                                 } else {
293                                         oargs[i]->tval = t->tval;
294                                         oargs[i]->tval &= ~(STR|NUM|DONTFREE);
295                                         oargs[i]->sval = t->sval;
296                                         tempfree(t);
297                                 }
298                         }
299                 } else if (t != y) {    /* kludge to prevent freeing twice */
300                         t->csub = CTEMP;
301                         tempfree(t);
302                 }
303         }
304         tempfree(fcn);
305         if (isexit(y) || isnext(y) || isnextfile(y))
306                 return y;
307         tempfree(y);            /* this can free twice! */
308         z = fp->retval;                 /* return value */
309            dprintf( ("%s returns %g |%s| %o\n", s, getfval(z), getsval(z), z->tval) );
310         fp--;
311         return(z);
312 }
313
314 Cell *copycell(Cell *x) /* make a copy of a cell in a temp */
315 {
316         Cell *y;
317
318         y = gettemp();
319         y->csub = CCOPY;        /* prevents freeing until call is over */
320         y->nval = x->nval;      /* BUG? */
321         y->sval = x->sval ? tostring(x->sval) : NULL;
322         y->fval = x->fval;
323         y->tval = x->tval & ~(CON|FLD|REC|DONTFREE);    /* copy is not constant or field */
324                                                         /* is DONTFREE right? */
325         return y;
326 }
327
328 Cell *arg(Node **a, int n)      /* nth argument of a function */
329 {
330
331         n = ptoi(a[0]); /* argument number, counting from 0 */
332            dprintf( ("arg(%d), fp->nargs=%d\n", n, fp->nargs) );
333         if (n+1 > fp->nargs)
334                 FATAL("argument #%d of function %s was not supplied",
335                         n+1, fp->fcncell->nval);
336         return fp->args[n];
337 }
338
339 Cell *jump(Node **a, int n)     /* break, continue, next, nextfile, return */
340 {
341         Cell *y;
342
343         switch (n) {
344         case EXIT:
345                 if (a[0] != NULL) {
346                         y = execute(a[0]);
347                         errorflag = (int) getfval(y);
348                         tempfree(y);
349                 }
350                 longjmp(env, 1);
351         case RETURN:
352                 if (a[0] != NULL) {
353                         y = execute(a[0]);
354                         if ((y->tval & (STR|NUM)) == (STR|NUM)) {
355                                 setsval(fp->retval, getsval(y));
356                                 fp->retval->fval = getfval(y);
357                                 fp->retval->tval |= NUM;
358                         }
359                         else if (y->tval & STR)
360                                 setsval(fp->retval, getsval(y));
361                         else if (y->tval & NUM)
362                                 setfval(fp->retval, getfval(y));
363                         else            /* can't happen */
364                                 FATAL("bad type variable %d", y->tval);
365                         tempfree(y);
366                 }
367                 return(jret);
368         case NEXT:
369                 return(jnext);
370         case NEXTFILE:
371                 nextfile();
372                 return(jnextfile);
373         case BREAK:
374                 return(jbreak);
375         case CONTINUE:
376                 return(jcont);
377         default:        /* can't happen */
378                 FATAL("illegal jump type %d", n);
379         }
380         return 0;       /* not reached */
381 }
382
383 Cell *getline(Node **a, int n)  /* get next line from specific input */
384 {               /* a[0] is variable, a[1] is operator, a[2] is filename */
385         Cell *r, *x;
386         extern Cell **fldtab;
387         FILE *fp;
388         char *buf;
389         int bufsize = recsize;
390         int mode;
391
392         if ((buf = (char *) malloc(bufsize)) == NULL)
393                 FATAL("out of memory in getline");
394
395         fflush(stdout); /* in case someone is waiting for a prompt */
396         r = gettemp();
397         if (a[1] != NULL) {             /* getline < file */
398                 x = execute(a[2]);              /* filename */
399                 mode = ptoi(a[1]);
400                 if (mode == '|')                /* input pipe */
401                         mode = LE;      /* arbitrary flag */
402                 fp = openfile(mode, getsval(x));
403                 tempfree(x);
404                 if (fp == NULL)
405                         n = -1;
406                 else
407                         n = readrec(&buf, &bufsize, fp);
408                 if (n <= 0) {
409                         ;
410                 } else if (a[0] != NULL) {      /* getline var <file */
411                         x = execute(a[0]);
412                         setsval(x, buf);
413                         tempfree(x);
414                 } else {                        /* getline <file */
415                         setsval(fldtab[0], buf);
416                         if (is_number(fldtab[0]->sval)) {
417                                 fldtab[0]->fval = atof(fldtab[0]->sval);
418                                 fldtab[0]->tval |= NUM;
419                         }
420                 }
421         } else {                        /* bare getline; use current input */
422                 if (a[0] == NULL)       /* getline */
423                         n = getrec(&record, &recsize, 1);
424                 else {                  /* getline var */
425                         n = getrec(&buf, &bufsize, 0);
426                         x = execute(a[0]);
427                         setsval(x, buf);
428                         tempfree(x);
429                 }
430         }
431         setfval(r, (Awkfloat) n);
432         free(buf);
433         return r;
434 }
435
436 Cell *getnf(Node **a, int n)    /* get NF */
437 {
438         if (donefld == 0)
439                 fldbld();
440         return (Cell *) a[0];
441 }
442
443 Cell *array(Node **a, int n)    /* a[0] is symtab, a[1] is list of subscripts */
444 {
445         Cell *x, *y, *z;
446         char *s;
447         Node *np;
448         char *buf;
449         int bufsz = recsize;
450         int nsub = strlen(*SUBSEP);
451
452         if ((buf = (char *) malloc(bufsz)) == NULL)
453                 FATAL("out of memory in array");
454
455         x = execute(a[0]);      /* Cell* for symbol table */
456         buf[0] = 0;
457         for (np = a[1]; np; np = np->nnext) {
458                 y = execute(np);        /* subscript */
459                 s = getsval(y);
460                 if (!adjbuf(&buf, &bufsz, strlen(buf)+strlen(s)+nsub+1, recsize, 0, 0))
461                         FATAL("out of memory for %s[%s...]", x->nval, buf);
462                 strcat(buf, s);
463                 if (np->nnext)
464                         strcat(buf, *SUBSEP);
465                 tempfree(y);
466         }
467         if (!isarr(x)) {
468                    dprintf( ("making %s into an array\n", x->nval) );
469                 if (freeable(x))
470                         xfree(x->sval);
471                 x->tval &= ~(STR|NUM|DONTFREE);
472                 x->tval |= ARR;
473                 x->sval = (char *) makesymtab(NSYMTAB);
474         }
475         z = setsymtab(buf, "", 0.0, STR|NUM, (Array *) x->sval);
476         z->ctype = OCELL;
477         z->csub = CVAR;
478         tempfree(x);
479         free(buf);
480         return(z);
481 }
482
483 Cell *awkdelete(Node **a, int n)        /* a[0] is symtab, a[1] is list of subscripts */
484 {
485         Cell *x, *y;
486         Node *np;
487         char *s;
488         int nsub = strlen(*SUBSEP);
489
490         x = execute(a[0]);      /* Cell* for symbol table */
491         if (!isarr(x))
492                 return True;
493         if (a[1] == 0) {        /* delete the elements, not the table */
494                 freesymtab(x);
495                 x->tval &= ~STR;
496                 x->tval |= ARR;
497                 x->sval = (char *) makesymtab(NSYMTAB);
498         } else {
499                 int bufsz = recsize;
500                 char *buf;
501                 if ((buf = (char *) malloc(bufsz)) == NULL)
502                         FATAL("out of memory in adelete");
503                 buf[0] = 0;
504                 for (np = a[1]; np; np = np->nnext) {
505                         y = execute(np);        /* subscript */
506                         s = getsval(y);
507                         if (!adjbuf(&buf, &bufsz, strlen(buf)+strlen(s)+nsub+1, recsize, 0, 0))
508                                 FATAL("out of memory deleting %s[%s...]", x->nval, buf);
509                         strcat(buf, s); 
510                         if (np->nnext)
511                                 strcat(buf, *SUBSEP);
512                         tempfree(y);
513                 }
514                 freeelem(x, buf);
515                 free(buf);
516         }
517         tempfree(x);
518         return True;
519 }
520
521 Cell *intest(Node **a, int n)   /* a[0] is index (list), a[1] is symtab */
522 {
523         Cell *x, *ap, *k;
524         Node *p;
525         char *buf;
526         char *s;
527         int bufsz = recsize;
528         int nsub = strlen(*SUBSEP);
529
530         ap = execute(a[1]);     /* array name */
531         if (!isarr(ap)) {
532                    dprintf( ("making %s into an array\n", ap->nval) );
533                 if (freeable(ap))
534                         xfree(ap->sval);
535                 ap->tval &= ~(STR|NUM|DONTFREE);
536                 ap->tval |= ARR;
537                 ap->sval = (char *) makesymtab(NSYMTAB);
538         }
539         if ((buf = (char *) malloc(bufsz)) == NULL) {
540                 FATAL("out of memory in intest");
541         }
542         buf[0] = 0;
543         for (p = a[0]; p; p = p->nnext) {
544                 x = execute(p); /* expr */
545                 s = getsval(x);
546                 if (!adjbuf(&buf, &bufsz, strlen(buf)+strlen(s)+nsub+1, recsize, 0, 0))
547                         FATAL("out of memory deleting %s[%s...]", x->nval, buf);
548                 strcat(buf, s);
549                 tempfree(x);
550                 if (p->nnext)
551                         strcat(buf, *SUBSEP);
552         }
553         k = lookup(buf, (Array *) ap->sval);
554         tempfree(ap);
555         free(buf);
556         if (k == NULL)
557                 return(False);
558         else
559                 return(True);
560 }
561
562
563 Cell *matchop(Node **a, int n)  /* ~ and match() */
564 {
565         Cell *x, *y;
566         char *s, *t;
567         int i;
568         void *p;
569
570         x = execute(a[1]);      /* a[1] = target text */
571         s = getsval(x);
572         if (a[0] == 0)          /* a[1] == 0: already-compiled reg expr */
573                 p = (void *) a[2];
574         else {
575                 y = execute(a[2]);      /* a[2] = regular expr */
576                 t = getsval(y);
577                 p = compre(t);
578                 tempfree(y);
579         }
580         if (n == MATCHFCN)
581                 i = pmatch(p, s, s);
582         else
583                 i = match(p, s, s);
584         tempfree(x);
585         if (n == MATCHFCN) {
586                 int start = countposn(s, patbeg-s)+1;
587                 if (patlen < 0)
588                         start = 0;
589                 setfval(rstartloc, (Awkfloat) start);
590                 setfval(rlengthloc, (Awkfloat) countposn(patbeg, patlen));
591                 x = gettemp();
592                 x->tval = NUM;
593                 x->fval = start;
594                 return x;
595         } else if ((n == MATCH && i == 1) || (n == NOTMATCH && i == 0))
596                 return(True);
597         else
598                 return(False);
599 }
600
601
602 Cell *boolop(Node **a, int n)   /* a[0] || a[1], a[0] && a[1], !a[0] */
603 {
604         Cell *x, *y;
605         int i;
606
607         x = execute(a[0]);
608         i = istrue(x);
609         tempfree(x);
610         switch (n) {
611         case BOR:
612                 if (i) return(True);
613                 y = execute(a[1]);
614                 i = istrue(y);
615                 tempfree(y);
616                 if (i) return(True);
617                 else return(False);
618         case AND:
619                 if ( !i ) return(False);
620                 y = execute(a[1]);
621                 i = istrue(y);
622                 tempfree(y);
623                 if (i) return(True);
624                 else return(False);
625         case NOT:
626                 if (i) return(False);
627                 else return(True);
628         default:        /* can't happen */
629                 FATAL("unknown boolean operator %d", n);
630         }
631         return 0;       /*NOTREACHED*/
632 }
633
634 Cell *relop(Node **a, int n)    /* a[0 < a[1], etc. */
635 {
636         int i;
637         Cell *x, *y;
638         Awkfloat j;
639
640         x = execute(a[0]);
641         y = execute(a[1]);
642         if (x->tval&NUM && y->tval&NUM) {
643                 j = x->fval - y->fval;
644                 i = j<0? -1: (j>0? 1: 0);
645         } else {
646                 i = strcmp(getsval(x), getsval(y));
647         }
648         tempfree(x);
649         tempfree(y);
650         switch (n) {
651         case LT:        if (i<0) return(True);
652                         else return(False);
653         case LE:        if (i<=0) return(True);
654                         else return(False);
655         case NE:        if (i!=0) return(True);
656                         else return(False);
657         case EQ:        if (i == 0) return(True);
658                         else return(False);
659         case GE:        if (i>=0) return(True);
660                         else return(False);
661         case GT:        if (i>0) return(True);
662                         else return(False);
663         default:        /* can't happen */
664                 FATAL("unknown relational operator %d", n);
665         }
666         return 0;       /*NOTREACHED*/
667 }
668
669 void tfree(Cell *a)     /* free a tempcell */
670 {
671         if (freeable(a)) {
672                    dprintf( ("freeing %s %s %o\n", a->nval, a->sval, a->tval) );
673                 xfree(a->sval);
674         }
675         if (a == tmps)
676                 FATAL("tempcell list is curdled");
677         a->cnext = tmps;
678         tmps = a;
679 }
680
681 Cell *gettemp(void)     /* get a tempcell */
682 {       int i;
683         Cell *x;
684
685         if (!tmps) {
686                 tmps = (Cell *) calloc(100, sizeof(Cell));
687                 if (!tmps)
688                         FATAL("out of space for temporaries");
689                 for(i = 1; i < 100; i++)
690                         tmps[i-1].cnext = &tmps[i];
691                 tmps[i-1].cnext = 0;
692         }
693         x = tmps;
694         tmps = x->cnext;
695         *x = tempcell;
696         return(x);
697 }
698
699 Cell *indirect(Node **a, int n) /* $( a[0] ) */
700 {
701         Cell *x;
702         int m;
703         char *s;
704
705         x = execute(a[0]);
706         m = (int) getfval(x);
707         if (m == 0 && !is_number(s = getsval(x)))       /* suspicion! */
708                 FATAL("illegal field $(%s), name \"%s\"", s, x->nval);
709                 /* BUG: can x->nval ever be null??? */
710         tempfree(x);
711         x = fieldadr(m);
712         x->ctype = OCELL;       /* BUG?  why are these needed? */
713         x->csub = CFLD;
714         return(x);
715 }
716
717 Cell *substr(Node **a, int nnn)         /* substr(a[0], a[1], a[2]) */
718 {
719         int k, m, n;
720         char *s, *p;
721         int temp;
722         Cell *x, *y, *z = 0;
723
724         x = execute(a[0]);
725         y = execute(a[1]);
726         if (a[2] != 0)
727                 z = execute(a[2]);
728         s = getsval(x);
729         k = countposn(s, strlen(s)) + 1;
730         if (k <= 1) {
731                 tempfree(x);
732                 tempfree(y);
733                 if (a[2] != 0)
734                         tempfree(z);
735                 x = gettemp();
736                 setsval(x, "");
737                 return(x);
738         }
739         m = (int) getfval(y);
740         if (m <= 0)
741                 m = 1;
742         else if (m > k)
743                 m = k;
744         tempfree(y);
745         if (a[2] != 0) {
746                 n = (int) getfval(z);
747                 tempfree(z);
748         } else
749                 n = k - 1;
750         if (n < 0)
751                 n = 0;
752         else if (n > k - m)
753                 n = k - m;
754            dprintf( ("substr: m=%d, n=%d, s=%s\n", m, n, s) );
755         y = gettemp();
756         while (*s && --m)
757                  s += mblen(s, k);
758         for (p = s; *p && n--; p += mblen(p, k))
759                         ;
760         temp = *p;      /* with thanks to John Linderman */
761         *p = '\0';
762         setsval(y, s);
763         *p = temp;
764         tempfree(x);
765         return(y);
766 }
767
768 Cell *sindex(Node **a, int nnn)         /* index(a[0], a[1]) */
769 {
770         Cell *x, *y, *z;
771         char *s1, *s2, *p1, *p2, *q;
772         Awkfloat v = 0.0;
773
774         x = execute(a[0]);
775         s1 = getsval(x);
776         y = execute(a[1]);
777         s2 = getsval(y);
778
779         z = gettemp();
780         for (p1 = s1; *p1 != '\0'; p1++) {
781                 for (q=p1, p2=s2; *p2 != '\0' && *q == *p2; q++, p2++)
782                         ;
783                 if (*p2 == '\0') {
784                         v = (Awkfloat) countposn(s1, p1-s1) + 1;        /* origin 1 */
785                         break;
786                 }
787         }
788         tempfree(x);
789         tempfree(y);
790         setfval(z, v);
791         return(z);
792 }
793
794 #define MAXNUMSIZE      50
795
796 int format(char **pbuf, int *pbufsize, char *s, Node *a)        /* printf-like conversions */
797 {
798         char *fmt;
799         char *p, *t, *os;
800         Cell *x;
801         int flag = 0, n;
802         int fmtwd; /* format width */
803         int fmtsz = recsize;
804         char *buf = *pbuf;
805         int bufsize = *pbufsize;
806
807         os = s;
808         p = buf;
809         if ((fmt = (char *) malloc(fmtsz)) == NULL)
810                 FATAL("out of memory in format()");
811         while (*s) {
812                 adjbuf(&buf, &bufsize, MAXNUMSIZE+1+p-buf, recsize, &p, "format");
813                 if (*s != '%') {
814                         *p++ = *s++;
815                         continue;
816                 }
817                 if (*(s+1) == '%') {
818                         *p++ = '%';
819                         s += 2;
820                         continue;
821                 }
822                 /* have to be real careful in case this is a huge number, eg, %100000d */
823                 fmtwd = atoi(s+1);
824                 if (fmtwd < 0)
825                         fmtwd = -fmtwd;
826                 adjbuf(&buf, &bufsize, fmtwd+1+p-buf, recsize, &p, "format");
827                 for (t = fmt; (*t++ = *s) != '\0'; s++) {
828                         if (!adjbuf(&fmt, &fmtsz, MAXNUMSIZE+1+t-fmt, recsize, &t, 0))
829                                 FATAL("format item %.30s... ran format() out of memory", os);
830                         if (isalpha(*s) && *s != 'l' && *s != 'h' && *s != 'L')
831                                 break;  /* the ansi panoply */
832                         if (*s == '*') {
833                                 x = execute(a);
834                                 a = a->nnext;
835                                 sprintf(t-1, "%d", fmtwd=(int) getfval(x));
836                                 if (fmtwd < 0)
837                                         fmtwd = -fmtwd;
838                                 adjbuf(&buf, &bufsize, fmtwd+1+p-buf, recsize, &p, "format");
839                                 t = fmt + strlen(fmt);
840                                 tempfree(x);
841                         }
842                 }
843                 *t = '\0';
844                 if (fmtwd < 0)
845                         fmtwd = -fmtwd;
846                 adjbuf(&buf, &bufsize, fmtwd+1+p-buf, recsize, &p, "format");
847
848                 switch (*s) {
849                 case 'f': case 'e': case 'g': case 'E': case 'G':
850                         flag = 1;
851                         break;
852                 case 'd': case 'i':
853                         flag = 2;
854                         if(*(s-1) == 'l') break;
855                         *(t-1) = 'l';
856                         *t = 'd';
857                         *++t = '\0';
858                         break;
859                 case 'o': case 'x': case 'X': case 'u':
860                         flag = *(s-1) == 'l' ? 2 : 3;
861                         break;
862                 case 's':
863                         flag = 4;
864                         break;
865                 case 'c':
866                         flag = 5;
867                         break;
868                 default:
869                         WARNING("weird printf conversion %s", fmt);
870                         flag = 0;
871                         break;
872                 }
873                 if (a == NULL)
874                         FATAL("not enough args in printf(%s)", os);
875                 x = execute(a);
876                 a = a->nnext;
877                 n = MAXNUMSIZE;
878                 if (fmtwd > n)
879                         n = fmtwd;
880                 adjbuf(&buf, &bufsize, 1+n+p-buf, recsize, &p, "format");
881                 switch (flag) {
882                 case 0: sprintf(p, "%s", fmt);  /* unknown, so dump it too */
883                         t = getsval(x);
884                         n = strlen(t);
885                         if (fmtwd > n)
886                                 n = fmtwd;
887                         adjbuf(&buf, &bufsize, 1+strlen(p)+n+p-buf, recsize, &p, "format");
888                         p += strlen(p);
889                         sprintf(p, "%s", t);
890                         break;
891                 case 1: sprintf(p, fmt, getfval(x)); break;
892                 case 2: sprintf(p, fmt, (long) getfval(x)); break;
893                 case 3: sprintf(p, fmt, (int) getfval(x)); break;
894                 case 4:
895                         t = getsval(x);
896                         n = strlen(t);
897                         if (fmtwd > n)
898                                 n = fmtwd;
899                         if (!adjbuf(&buf, &bufsize, 1+n+p-buf, recsize, &p, 0))
900                                 FATAL("huge string/format (%d chars) in printf %.30s... ran format() out of memory", n, t);
901                         sprintf(p, fmt, t);
902                         break;
903                 case 5:
904                         if (isnum(x)) {
905                                 if (getfval(x))
906                                         sprintf(p, fmt, (int) getfval(x));
907                                 else{
908                                         *p++ = '\0';
909                                         *p = '\0';
910                                 }
911                         } else
912                                 sprintf(p, fmt, getsval(x)[0]);
913                         break;
914                 }
915                 tempfree(x);
916                 p += strlen(p);
917                 s++;
918         }
919         *p = '\0';
920         free(fmt);
921         for ( ; a; a = a->nnext)                /* evaluate any remaining args */
922                 execute(a);
923         *pbuf = buf;
924         *pbufsize = bufsize;
925         return p - buf;
926 }
927
928 Cell *awksprintf(Node **a, int n)               /* sprintf(a[0]) */
929 {
930         Cell *x;
931         Node *y;
932         char *buf;
933         int bufsz=3*recsize;
934
935         if ((buf = (char *) malloc(bufsz)) == NULL)
936                 FATAL("out of memory in awksprintf");
937         y = a[0]->nnext;
938         x = execute(a[0]);
939         if (format(&buf, &bufsz, getsval(x), y) == -1)
940                 FATAL("sprintf string %.30s... too long.  can't happen.", buf);
941         tempfree(x);
942         x = gettemp();
943         x->sval = buf;
944         x->tval = STR;
945         return(x);
946 }
947
948 Cell *awkprintf(Node **a, int n)                /* printf */
949 {       /* a[0] is list of args, starting with format string */
950         /* a[1] is redirection operator, a[2] is redirection file */
951         FILE *fp;
952         Cell *x;
953         Node *y;
954         char *buf;
955         int len;
956         int bufsz=3*recsize;
957
958         if ((buf = (char *) malloc(bufsz)) == NULL)
959                 FATAL("out of memory in awkprintf");
960         y = a[0]->nnext;
961         x = execute(a[0]);
962         if ((len = format(&buf, &bufsz, getsval(x), y)) == -1)
963                 FATAL("printf string %.30s... too long.  can't happen.", buf);
964         tempfree(x);
965         if (a[1] == NULL) {
966                 /* fputs(buf, stdout); */
967                 fwrite(buf, len, 1, stdout);
968                 if (ferror(stdout))
969                         FATAL("write error on stdout");
970         } else {
971                 fp = redirect(ptoi(a[1]), a[2]);
972                 /* fputs(buf, fp); */
973                 fwrite(buf, len, 1, fp);
974                 fflush(fp);
975                 if (ferror(fp))
976                         FATAL("write error on %s", filename(fp));
977         }
978         free(buf);
979         return(True);
980 }
981
982 Cell *arith(Node **a, int n)    /* a[0] + a[1], etc.  also -a[0] */
983 {
984         Awkfloat i, j = 0;
985         double v;
986         Cell *x, *y, *z;
987
988         x = execute(a[0]);
989         i = getfval(x);
990         tempfree(x);
991         if (n != UMINUS) {
992                 y = execute(a[1]);
993                 j = getfval(y);
994                 tempfree(y);
995         }
996         z = gettemp();
997         switch (n) {
998         case ADD:
999                 i += j;
1000                 break;
1001         case MINUS:
1002                 i -= j;
1003                 break;
1004         case MULT:
1005                 i *= j;
1006                 break;
1007         case DIVIDE:
1008                 if (j == 0)
1009                         FATAL("division by zero");
1010                 i /= j;
1011                 break;
1012         case MOD:
1013                 if (j == 0)
1014                         FATAL("division by zero in mod");
1015                 modf(i/j, &v);
1016                 i = i - j * v;
1017                 break;
1018         case UMINUS:
1019                 i = -i;
1020                 break;
1021         case POWER:
1022                 if (j >= 0 && modf(j, &v) == 0.0)       /* pos integer exponent */
1023                         i = ipow(i, (int) j);
1024                 else
1025                         i = errcheck(pow(i, j), "pow");
1026                 break;
1027         default:        /* can't happen */
1028                 FATAL("illegal arithmetic operator %d", n);
1029         }
1030         setfval(z, i);
1031         return(z);
1032 }
1033
1034 double ipow(double x, int n)    /* x**n.  ought to be done by pow, but isn't always */
1035 {
1036         double v;
1037
1038         if (n <= 0)
1039                 return 1;
1040         v = ipow(x, n/2);
1041         if (n % 2 == 0)
1042                 return v * v;
1043         else
1044                 return x * v * v;
1045 }
1046
1047 Cell *incrdecr(Node **a, int n)         /* a[0]++, etc. */
1048 {
1049         Cell *x, *z;
1050         int k;
1051         Awkfloat xf;
1052
1053         x = execute(a[0]);
1054         xf = getfval(x);
1055         k = (n == PREINCR || n == POSTINCR) ? 1 : -1;
1056         if (n == PREINCR || n == PREDECR) {
1057                 setfval(x, xf + k);
1058                 return(x);
1059         }
1060         z = gettemp();
1061         setfval(z, xf);
1062         setfval(x, xf + k);
1063         tempfree(x);
1064         return(z);
1065 }
1066
1067 Cell *assign(Node **a, int n)   /* a[0] = a[1], a[0] += a[1], etc. */
1068 {               /* this is subtle; don't muck with it. */
1069         Cell *x, *y;
1070         Awkfloat xf, yf;
1071         double v;
1072
1073         y = execute(a[1]);
1074         x = execute(a[0]);
1075         if (n == ASSIGN) {      /* ordinary assignment */
1076                 if (x == y && !(x->tval & (FLD|REC)))   /* self-assignment: */
1077                         ;               /* leave alone unless it's a field */
1078                 else if ((y->tval & (STR|NUM)) == (STR|NUM)) {
1079                         setsval(x, getsval(y));
1080                         x->fval = getfval(y);
1081                         x->tval |= NUM;
1082                 }
1083                 else if (isstr(y))
1084                         setsval(x, getsval(y));
1085                 else if (isnum(y))
1086                         setfval(x, getfval(y));
1087                 else
1088                         funnyvar(y, "read value of");
1089                 tempfree(y);
1090                 return(x);
1091         }
1092         xf = getfval(x);
1093         yf = getfval(y);
1094         switch (n) {
1095         case ADDEQ:
1096                 xf += yf;
1097                 break;
1098         case SUBEQ:
1099                 xf -= yf;
1100                 break;
1101         case MULTEQ:
1102                 xf *= yf;
1103                 break;
1104         case DIVEQ:
1105                 if (yf == 0)
1106                         FATAL("division by zero in /=");
1107                 xf /= yf;
1108                 break;
1109         case MODEQ:
1110                 if (yf == 0)
1111                         FATAL("division by zero in %%=");
1112                 modf(xf/yf, &v);
1113                 xf = xf - yf * v;
1114                 break;
1115         case POWEQ:
1116                 if (yf >= 0 && modf(yf, &v) == 0.0)     /* pos integer exponent */
1117                         xf = ipow(xf, (int) yf);
1118                 else
1119                         xf = errcheck(pow(xf, yf), "pow");
1120                 break;
1121         default:
1122                 FATAL("illegal assignment operator %d", n);
1123                 break;
1124         }
1125         tempfree(y);
1126         setfval(x, xf);
1127         return(x);
1128 }
1129
1130 Cell *cat(Node **a, int q)      /* a[0] cat a[1] */
1131 {
1132         Cell *x, *y, *z;
1133         int n1, n2;
1134         char *s;
1135
1136         x = execute(a[0]);
1137         y = execute(a[1]);
1138         getsval(x);
1139         getsval(y);
1140         n1 = strlen(x->sval);
1141         n2 = strlen(y->sval);
1142         s = (char *) malloc(n1 + n2 + 1);
1143         if (s == NULL)
1144                 FATAL("out of space concatenating %.15s... and %.15s...",
1145                         x->sval, y->sval);
1146         strcpy(s, x->sval);
1147         strcpy(s+n1, y->sval);
1148         tempfree(y);
1149         z = gettemp();
1150         z->sval = s;
1151         z->tval = STR;
1152         tempfree(x);
1153         return(z);
1154 }
1155
1156 Cell *pastat(Node **a, int n)   /* a[0] { a[1] } */
1157 {
1158         Cell *x;
1159
1160         if (a[0] == 0)
1161                 x = execute(a[1]);
1162         else {
1163                 x = execute(a[0]);
1164                 if (istrue(x)) {
1165                         tempfree(x);
1166                         x = execute(a[1]);
1167                 }
1168         }
1169         return x;
1170 }
1171
1172 Cell *dopa2(Node **a, int n)    /* a[0], a[1] { a[2] } */
1173 {
1174         Cell *x;
1175         int pair;
1176
1177         pair = ptoi(a[3]);
1178         if (pairstack[pair] == 0) {
1179                 x = execute(a[0]);
1180                 if (istrue(x))
1181                         pairstack[pair] = 1;
1182                 tempfree(x);
1183         }
1184         if (pairstack[pair] == 1) {
1185                 x = execute(a[1]);
1186                 if (istrue(x))
1187                         pairstack[pair] = 0;
1188                 tempfree(x);
1189                 x = execute(a[2]);
1190                 return(x);
1191         }
1192         return(False);
1193 }
1194
1195 Cell *split(Node **a, int nnn)  /* split(a[0], a[1], a[2]); a[3] is type */
1196 {
1197         Cell *x = 0, *y, *ap;
1198         char *s, *t, *fs = 0;
1199         char temp, num[50];
1200         int n, nb, sep, tempstat, arg3type;
1201
1202         y = execute(a[0]);      /* source string */
1203         s = getsval(y);
1204         arg3type = ptoi(a[3]);
1205         if (a[2] == 0)          /* fs string */
1206                 fs = *FS;
1207         else if (arg3type == STRING) {  /* split(str,arr,"string") */
1208                 x = execute(a[2]);
1209                 fs = getsval(x);
1210         } else if (arg3type == REGEXPR)
1211                 fs = "(regexpr)";       /* split(str,arr,/regexpr/) */
1212         else
1213                 FATAL("illegal type of split");
1214         sep = *fs;
1215         ap = execute(a[1]);     /* array name */
1216         n = y->tval;
1217         y->tval |= DONTFREE;    /* split(a[x], a); */
1218         freesymtab(ap);
1219         y->tval = n;
1220            dprintf( ("split: s=|%s|, a=%s, sep=|%s|\n", s, ap->nval, fs) );
1221         ap->tval &= ~STR;
1222         ap->tval |= ARR;
1223         ap->sval = (char *) makesymtab(NSYMTAB);
1224
1225         n = 0;
1226         if ((*s != '\0' && strlen(fs) > 1) || arg3type == REGEXPR) {    /* reg expr */
1227                 void *p;
1228                 if (arg3type == REGEXPR) {      /* it's ready already */
1229                         p = (void *) a[2];
1230                 } else {
1231                         p = compre(fs);
1232                 }
1233                 t = s;
1234                 if (nematch(p,s,t)) {
1235                         do {
1236                                 n++;
1237                                 sprintf(num, "%d", n);
1238                                 temp = *patbeg;
1239                                 *patbeg = '\0';
1240                                 if (is_number(t))
1241                                         setsymtab(num, t, atof(t), STR|NUM, (Array *) ap->sval);
1242                                 else
1243                                         setsymtab(num, t, 0.0, STR, (Array *) ap->sval);
1244                                 *patbeg = temp;
1245                                 t = patbeg + patlen;
1246                                 if (t[-1] == 0 || *t == 0) {
1247                                         n++;
1248                                         sprintf(num, "%d", n);
1249                                         setsymtab(num, "", 0.0, STR, (Array *) ap->sval);
1250                                         goto spdone;
1251                                 }
1252                         } while (nematch(p,s,t));
1253                 }
1254                 n++;
1255                 sprintf(num, "%d", n);
1256                 if (is_number(t))
1257                         setsymtab(num, t, atof(t), STR|NUM, (Array *) ap->sval);
1258                 else
1259                         setsymtab(num, t, 0.0, STR, (Array *) ap->sval);
1260   spdone:
1261                 p = NULL;
1262         } else if (sep == ' ') {
1263                 for (n = 0; ; ) {
1264                         while (*s == ' ' || *s == '\t' || *s == '\n')
1265                                 s++;
1266                         if (*s == 0)
1267                                 break;
1268                         n++;
1269                         t = s;
1270                         do
1271                                 s++;
1272                         while (*s!=' ' && *s!='\t' && *s!='\n' && *s!='\0');
1273                         temp = *s;
1274                         *s = '\0';
1275                         sprintf(num, "%d", n);
1276                         if (is_number(t))
1277                                 setsymtab(num, t, atof(t), STR|NUM, (Array *) ap->sval);
1278                         else
1279                                 setsymtab(num, t, 0.0, STR, (Array *) ap->sval);
1280                         *s = temp;
1281                         if (*s != 0)
1282                                 s++;
1283                 }
1284         } else if (sep == 0) {  /* new: split(s, a, "") => 1 char/elem */
1285                 for (n = 0; *s != 0; s += nb) {
1286                         Rune r;
1287                         char buf[UTFmax+1];
1288
1289                         n++;
1290                         snprintf(num, sizeof num, "%d", n);
1291                         nb = chartorune(&r, s);
1292                         memmove(buf, s, nb);
1293                         buf[nb] = '\0';
1294                         if (isdigit(buf[0]))
1295                                 setsymtab(num, buf, atof(buf), STR|NUM, (Array *) ap->sval);
1296                         else
1297                                 setsymtab(num, buf, 0.0, STR, (Array *) ap->sval);
1298                 }
1299         } else if (*s != 0) {
1300                 for (;;) {
1301                         n++;
1302                         t = s;
1303                         while (*s != sep && *s != '\n' && *s != '\0')
1304                                 s++;
1305                         temp = *s;
1306                         *s = '\0';
1307                         sprintf(num, "%d", n);
1308                         if (is_number(t))
1309                                 setsymtab(num, t, atof(t), STR|NUM, (Array *) ap->sval);
1310                         else
1311                                 setsymtab(num, t, 0.0, STR, (Array *) ap->sval);
1312                         *s = temp;
1313                         if (*s++ == 0)
1314                                 break;
1315                 }
1316         }
1317         tempfree(ap);
1318         tempfree(y);
1319         if (a[2] != 0 && arg3type == STRING)
1320                 tempfree(x);
1321         x = gettemp();
1322         x->tval = NUM;
1323         x->fval = n;
1324         return(x);
1325 }
1326
1327 Cell *condexpr(Node **a, int n) /* a[0] ? a[1] : a[2] */
1328 {
1329         Cell *x;
1330
1331         x = execute(a[0]);
1332         if (istrue(x)) {
1333                 tempfree(x);
1334                 x = execute(a[1]);
1335         } else {
1336                 tempfree(x);
1337                 x = execute(a[2]);
1338         }
1339         return(x);
1340 }
1341
1342 Cell *ifstat(Node **a, int n)   /* if (a[0]) a[1]; else a[2] */
1343 {
1344         Cell *x;
1345
1346         x = execute(a[0]);
1347         if (istrue(x)) {
1348                 tempfree(x);
1349                 x = execute(a[1]);
1350         } else if (a[2] != 0) {
1351                 tempfree(x);
1352                 x = execute(a[2]);
1353         }
1354         return(x);
1355 }
1356
1357 Cell *whilestat(Node **a, int n)        /* while (a[0]) a[1] */
1358 {
1359         Cell *x;
1360
1361         for (;;) {
1362                 x = execute(a[0]);
1363                 if (!istrue(x))
1364                         return(x);
1365                 tempfree(x);
1366                 x = execute(a[1]);
1367                 if (isbreak(x)) {
1368                         x = True;
1369                         return(x);
1370                 }
1371                 if (isnext(x) || isexit(x) || isret(x))
1372                         return(x);
1373                 tempfree(x);
1374         }
1375 }
1376
1377 Cell *dostat(Node **a, int n)   /* do a[0]; while(a[1]) */
1378 {
1379         Cell *x;
1380
1381         for (;;) {
1382                 x = execute(a[0]);
1383                 if (isbreak(x))
1384                         return True;
1385                 if (isnext(x) || isnextfile(x) || isexit(x) || isret(x))
1386                         return(x);
1387                 tempfree(x);
1388                 x = execute(a[1]);
1389                 if (!istrue(x))
1390                         return(x);
1391                 tempfree(x);
1392         }
1393 }
1394
1395 Cell *forstat(Node **a, int n)  /* for (a[0]; a[1]; a[2]) a[3] */
1396 {
1397         Cell *x;
1398
1399         x = execute(a[0]);
1400         tempfree(x);
1401         for (;;) {
1402                 if (a[1]!=0) {
1403                         x = execute(a[1]);
1404                         if (!istrue(x)) return(x);
1405                         else tempfree(x);
1406                 }
1407                 x = execute(a[3]);
1408                 if (isbreak(x))         /* turn off break */
1409                         return True;
1410                 if (isnext(x) || isexit(x) || isret(x))
1411                         return(x);
1412                 tempfree(x);
1413                 x = execute(a[2]);
1414                 tempfree(x);
1415         }
1416 }
1417
1418 Cell *instat(Node **a, int n)   /* for (a[0] in a[1]) a[2] */
1419 {
1420         Cell *x, *vp, *arrayp, *cp, *ncp;
1421         Array *tp;
1422         int i;
1423
1424         vp = execute(a[0]);
1425         arrayp = execute(a[1]);
1426         if (!isarr(arrayp)) {
1427                 return True;
1428         }
1429         tp = (Array *) arrayp->sval;
1430         tempfree(arrayp);
1431         for (i = 0; i < tp->size; i++) {        /* this routine knows too much */
1432                 for (cp = tp->tab[i]; cp != NULL; cp = ncp) {
1433                         setsval(vp, cp->nval);
1434                         ncp = cp->cnext;
1435                         x = execute(a[2]);
1436                         if (isbreak(x)) {
1437                                 tempfree(vp);
1438                                 return True;
1439                         }
1440                         if (isnext(x) || isexit(x) || isret(x)) {
1441                                 tempfree(vp);
1442                                 return(x);
1443                         }
1444                         tempfree(x);
1445                 }
1446         }
1447         return True;
1448 }
1449
1450 Cell *bltin(Node **a, int n)    /* builtin functions. a[0] is type, a[1] is arg list */
1451 {
1452         Cell *x, *y;
1453         Awkfloat u;
1454         int t;
1455         wchar_t wc;
1456         char *p, *buf;
1457         char mbc[50];
1458         Node *nextarg;
1459         FILE *fp;
1460         void flush_all(void);
1461
1462         t = ptoi(a[0]);
1463         x = execute(a[1]);
1464         nextarg = a[1]->nnext;
1465         switch (t) {
1466         case FLENGTH:
1467                 if (isarr(x))
1468                         u = ((Array *) x->sval)->nelem; /* GROT. should be function*/
1469                 else {
1470                         p = getsval(x);
1471                         u = (Awkfloat) countposn(p, strlen(p));
1472                 }
1473                 break;
1474         case FLOG:
1475                 u = errcheck(log(getfval(x)), "log"); break;
1476         case FINT:
1477                 modf(getfval(x), &u); break;
1478         case FEXP:
1479                 u = errcheck(exp(getfval(x)), "exp"); break;
1480         case FSQRT:
1481                 u = errcheck(sqrt(getfval(x)), "sqrt"); break;
1482         case FSIN:
1483                 u = sin(getfval(x)); break;
1484         case FCOS:
1485                 u = cos(getfval(x)); break;
1486         case FATAN:
1487                 if (nextarg == 0) {
1488                         WARNING("atan2 requires two arguments; returning 1.0");
1489                         u = 1.0;
1490                 } else {
1491                         y = execute(a[1]->nnext);
1492                         u = atan2(getfval(x), getfval(y));
1493                         tempfree(y);
1494                         nextarg = nextarg->nnext;
1495                 }
1496                 break;
1497         case FSYSTEM:
1498                 fflush(stdout);         /* in case something is buffered already */
1499                 u = (Awkfloat) system(getsval(x)) / 256;   /* 256 is unix-dep */
1500                 break;
1501         case FRAND:
1502                 /* in principle, rand() returns something in 0..RAND_MAX */
1503                 u = (Awkfloat) (rand() % RAND_MAX) / RAND_MAX;
1504                 break;
1505         case FSRAND:
1506                 if (isrec(x))   /* no argument provided */
1507                         u = time((time_t *)0);
1508                 else
1509                         u = getfval(x);
1510                 srand((unsigned int) u);
1511                 break;
1512         case FTOUPPER:
1513         case FTOLOWER:
1514                 buf = tostring(getsval(x));
1515                 if (t == FTOUPPER) {
1516                         for (p = buf; *p; p++)
1517                                 if (islower(*p))
1518                                         *p = toupper(*p);
1519                 } else {
1520                         for (p = buf; *p; p++)
1521                                 if (isupper(*p))
1522                                         *p = tolower(*p);
1523                 }
1524                 tempfree(x);
1525                 x = gettemp();
1526                 setsval(x, buf);
1527                 free(buf);
1528                 return x;
1529         case FFLUSH:
1530                 if (isrec(x) || strlen(getsval(x)) == 0) {
1531                         flush_all();    /* fflush() or fflush("") -> all */
1532                         u = 0;
1533                 } else if ((fp = openfile(FFLUSH, getsval(x))) == NULL)
1534                         u = EOF;
1535                 else
1536                         u = fflush(fp);
1537                 break;
1538         case FUTF:
1539                 wc = (int)getfval(x);
1540                 mbc[wctomb(mbc, wc)] = 0;
1541                 tempfree(x);
1542                 x = gettemp();
1543                 setsval(x, mbc);
1544                 return x;
1545         default:        /* can't happen */
1546                 FATAL("illegal function type %d", t);
1547                 break;
1548         }
1549         tempfree(x);
1550         x = gettemp();
1551         setfval(x, u);
1552         if (nextarg != 0) {
1553                 WARNING("warning: function has too many arguments");
1554                 for ( ; nextarg; nextarg = nextarg->nnext)
1555                         execute(nextarg);
1556         }
1557         return(x);
1558 }
1559
1560 Cell *printstat(Node **a, int n)        /* print a[0] */
1561 {
1562         int r;
1563         Node *x;
1564         Cell *y;
1565         FILE *fp;
1566
1567         if (a[1] == 0)  /* a[1] is redirection operator, a[2] is file */
1568                 fp = stdout;
1569         else
1570                 fp = redirect(ptoi(a[1]), a[2]);
1571         for (x = a[0]; x != NULL; x = x->nnext) {
1572                 y = execute(x);
1573                 fputs(getsval(y), fp);
1574                 tempfree(y);
1575                 if (x->nnext == NULL)
1576                         r = fputs(*ORS, fp);
1577                 else
1578                         r = fputs(*OFS, fp);
1579                 if (r == EOF)
1580                         FATAL("write error on %s", filename(fp));
1581         }
1582         if (a[1] != 0)
1583                 if (fflush(fp) == EOF)
1584                         FATAL("write error on %s", filename(fp));
1585         return(True);
1586 }
1587
1588 Cell *nullproc(Node **a, int n)
1589 {
1590         n = n;
1591         a = a;
1592         return 0;
1593 }
1594
1595
1596 FILE *redirect(int a, Node *b)  /* set up all i/o redirections */
1597 {
1598         FILE *fp;
1599         Cell *x;
1600         char *fname;
1601
1602         x = execute(b);
1603         fname = getsval(x);
1604         fp = openfile(a, fname);
1605         if (fp == NULL)
1606                 FATAL("can't open file %s", fname);
1607         tempfree(x);
1608         return fp;
1609 }
1610
1611 struct files {
1612         FILE    *fp;
1613         char    *fname;
1614         int     mode;   /* '|', 'a', 'w' => LE/LT, GT */
1615 } files[FOPEN_MAX] ={
1616         { NULL,  "/dev/stdin",  LT },   /* watch out: don't free this! */
1617         { NULL, "/dev/stdout", GT },
1618         { NULL, "/dev/stderr", GT }
1619 };
1620
1621 void stdinit(void)      /* in case stdin, etc., are not constants */
1622 {
1623         files[0].fp = stdin;
1624         files[1].fp = stdout;
1625         files[2].fp = stderr;
1626 }
1627
1628 FILE *openfile(int a, char *us)
1629 {
1630         char *s = us;
1631         int i, m;
1632         FILE *fp = 0;
1633
1634         if (*s == '\0')
1635                 FATAL("null file name in print or getline");
1636         for (i=0; i < FOPEN_MAX; i++)
1637                 if (files[i].fname && strcmp(s, files[i].fname) == 0) {
1638                         if (a == files[i].mode || (a==APPEND && files[i].mode==GT))
1639                                 return files[i].fp;
1640                         if (a == FFLUSH)
1641                                 return files[i].fp;
1642                 }
1643         if (a == FFLUSH)        /* didn't find it, so don't create it! */
1644                 return NULL;
1645
1646         for (i=0; i < FOPEN_MAX; i++)
1647                 if (files[i].fp == 0)
1648                         break;
1649         if (i >= FOPEN_MAX)
1650                 FATAL("%s makes too many open files", s);
1651         fflush(stdout); /* force a semblance of order */
1652         m = a;
1653         if (a == GT) {
1654                 fp = fopen(s, "w");
1655         } else if (a == APPEND) {
1656                 fp = fopen(s, "a");
1657                 m = GT; /* so can mix > and >> */
1658         } else if (a == '|') {  /* output pipe */
1659                 fp = popen(s, "w");
1660         } else if (a == LE) {   /* input pipe */
1661                 fp = popen(s, "r");
1662         } else if (a == LT) {   /* getline <file */
1663                 fp = strcmp(s, "-") == 0 ? stdin : fopen(s, "r");       /* "-" is stdin */
1664         } else  /* can't happen */
1665                 FATAL("illegal redirection %d", a);
1666         if (fp != NULL) {
1667                 files[i].fname = tostring(s);
1668                 files[i].fp = fp;
1669                 files[i].mode = m;
1670         }
1671         return fp;
1672 }
1673
1674 char *filename(FILE *fp)
1675 {
1676         int i;
1677
1678         for (i = 0; i < FOPEN_MAX; i++)
1679                 if (fp == files[i].fp)
1680                         return files[i].fname;
1681         return "???";
1682 }
1683
1684 Cell *closefile(Node **a, int n)
1685 {
1686         Cell *x;
1687         int i, stat;
1688
1689         n = n;
1690         x = execute(a[0]);
1691         getsval(x);
1692         for (i = 0; i < FOPEN_MAX; i++)
1693                 if (files[i].fname && strcmp(x->sval, files[i].fname) == 0) {
1694                         if (ferror(files[i].fp))
1695                                 WARNING( "i/o error occurred on %s", files[i].fname );
1696                         if (files[i].mode == '|' || files[i].mode == LE)
1697                                 stat = pclose(files[i].fp);
1698                         else
1699                                 stat = fclose(files[i].fp);
1700                         if (stat == EOF)
1701                                 WARNING( "i/o error occurred closing %s", files[i].fname );
1702                         if (i > 2)      /* don't do /dev/std... */
1703                                 xfree(files[i].fname);
1704                         files[i].fname = NULL;  /* watch out for ref thru this */
1705                         files[i].fp = NULL;
1706                 }
1707         tempfree(x);
1708         return(True);
1709 }
1710
1711 void closeall(void)
1712 {
1713         int i, stat;
1714
1715         for (i = 0; i < FOPEN_MAX; i++)
1716                 if (files[i].fp) {
1717                         if (ferror(files[i].fp))
1718                                 WARNING( "i/o error occurred on %s", files[i].fname );
1719                         if (files[i].mode == '|' || files[i].mode == LE)
1720                                 stat = pclose(files[i].fp);
1721                         else
1722                                 stat = fclose(files[i].fp);
1723                         if (stat == EOF)
1724                                 WARNING( "i/o error occurred while closing %s", files[i].fname );
1725                 }
1726 }
1727
1728 void flush_all(void)
1729 {
1730         int i;
1731
1732         for (i = 0; i < FOPEN_MAX; i++)
1733                 if (files[i].fp)
1734                         fflush(files[i].fp);
1735 }
1736
1737 void backsub(char **pb_ptr, char **sptr_ptr);
1738
1739 Cell *sub(Node **a, int nnn)    /* substitute command */
1740 {
1741         char *sptr, *pb, *q;
1742         Cell *x, *y, *result;
1743         char *t, *buf;
1744         void *p;
1745         int bufsz = recsize;
1746
1747         if ((buf = (char *) malloc(bufsz)) == NULL)
1748                 FATAL("out of memory in sub");
1749         x = execute(a[3]);      /* target string */
1750         t = getsval(x);
1751         if (a[0] == 0)          /* 0 => a[1] is already-compiled regexpr */
1752                 p = (void *) a[1];      /* regular expression */
1753         else {
1754                 y = execute(a[1]);
1755                 p = compre(getsval(y));
1756                 tempfree(y);
1757         }
1758         y = execute(a[2]);      /* replacement string */
1759         result = False;
1760         if (pmatch(p, t, t)) {
1761                 sptr = t;
1762                 adjbuf(&buf, &bufsz, 1+patbeg-sptr, recsize, 0, "sub");
1763                 pb = buf;
1764                 while (sptr < patbeg)
1765                         *pb++ = *sptr++;
1766                 sptr = getsval(y);
1767                 while (*sptr != 0) {
1768                         adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "sub");
1769                         if (*sptr == '\\') {
1770                                 backsub(&pb, &sptr);
1771                         } else if (*sptr == '&') {
1772                                 sptr++;
1773                                 adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "sub");
1774                                 for (q = patbeg; q < patbeg+patlen; )
1775                                         *pb++ = *q++;
1776                         } else
1777                                 *pb++ = *sptr++;
1778                 }
1779                 *pb = '\0';
1780                 if (pb > buf + bufsz)
1781                         FATAL("sub result1 %.30s too big; can't happen", buf);
1782                 sptr = patbeg + patlen;
1783                 if ((patlen == 0 && *patbeg) || (patlen && *(sptr-1))) {
1784                         adjbuf(&buf, &bufsz, 1+strlen(sptr)+pb-buf, 0, &pb, "sub");
1785                         while ((*pb++ = *sptr++) != 0)
1786                                 ;
1787                 }
1788                 if (pb > buf + bufsz)
1789                         FATAL("sub result2 %.30s too big; can't happen", buf);
1790                 setsval(x, buf);        /* BUG: should be able to avoid copy */
1791                 result = True;;
1792         }
1793         tempfree(x);
1794         tempfree(y);
1795         free(buf);
1796         return result;
1797 }
1798
1799 Cell *gsub(Node **a, int nnn)   /* global substitute */
1800 {
1801         Cell *x, *y;
1802         char *rptr, *sptr, *t, *pb, *c;
1803         char *buf;
1804         void *p;
1805         int mflag, num;
1806         int bufsz = recsize;
1807
1808         if ((buf = (char *)malloc(bufsz)) == NULL)
1809                 FATAL("out of memory in gsub");
1810         mflag = 0;      /* if mflag == 0, can replace empty string */
1811         num = 0;
1812         x = execute(a[3]);      /* target string */
1813         c = t = getsval(x);
1814         if (a[0] == 0)          /* 0 => a[1] is already-compiled regexpr */
1815                 p = (void *) a[1];      /* regular expression */
1816         else {
1817                 y = execute(a[1]);
1818                 p = compre(getsval(y));
1819                 tempfree(y);
1820         }
1821         y = execute(a[2]);      /* replacement string */
1822         if (pmatch(p, t, c)) {
1823                 pb = buf;
1824                 rptr = getsval(y);
1825                 do {
1826                         if (patlen == 0 && *patbeg != 0) {      /* matched empty string */
1827                                 if (mflag == 0) {       /* can replace empty */
1828                                         num++;
1829                                         sptr = rptr;
1830                                         while (*sptr != 0) {
1831                                                 adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "gsub");
1832                                                 if (*sptr == '\\') {
1833                                                         backsub(&pb, &sptr);
1834                                                 } else if (*sptr == '&') {
1835                                                         char *q;
1836                                                         sptr++;
1837                                                         adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "gsub");
1838                                                         for (q = patbeg; q < patbeg+patlen; )
1839                                                                 *pb++ = *q++;
1840                                                 } else
1841                                                         *pb++ = *sptr++;
1842                                         }
1843                                 }
1844                                 if (*c == 0)    /* at end */
1845                                         goto done;
1846                                 adjbuf(&buf, &bufsz, 2+pb-buf, recsize, &pb, "gsub");
1847                                 *pb++ = *c++;
1848                                 if (pb > buf + bufsz)   /* BUG: not sure of this test */
1849                                         FATAL("gsub result0 %.30s too big; can't happen", buf);
1850                                 mflag = 0;
1851                         }
1852                         else {  /* matched nonempty string */
1853                                 num++;
1854                                 sptr = c;
1855                                 adjbuf(&buf, &bufsz, 1+(patbeg-sptr)+pb-buf, recsize, &pb, "gsub");
1856                                 while (sptr < patbeg)
1857                                         *pb++ = *sptr++;
1858                                 sptr = rptr;
1859                                 while (*sptr != 0) {
1860                                         adjbuf(&buf, &bufsz, 5+pb-buf, recsize, &pb, "gsub");
1861                                         if (*sptr == '\\') {
1862                                                 backsub(&pb, &sptr);
1863                                         } else if (*sptr == '&') {
1864                                                 char *q;
1865                                                 sptr++;
1866                                                 adjbuf(&buf, &bufsz, 1+patlen+pb-buf, recsize, &pb, "gsub");
1867                                                 for (q = patbeg; q < patbeg+patlen; )
1868                                                         *pb++ = *q++;
1869                                         } else
1870                                                 *pb++ = *sptr++;
1871                                 }
1872                                 c = patbeg + patlen;
1873                                 if ((c[-1] == 0) || (*c == 0))
1874                                         goto done;
1875                                 if (pb > buf + bufsz)
1876                                         FATAL("gsub result1 %.30s too big; can't happen", buf);
1877                                 mflag = 1;
1878                         }
1879                 } while (pmatch(p, t, c));
1880                 sptr = c;
1881                 adjbuf(&buf, &bufsz, 1+strlen(sptr)+pb-buf, 0, &pb, "gsub");
1882                 while ((*pb++ = *sptr++) != 0)
1883                         ;
1884         done:   if (pb > buf + bufsz)
1885                         FATAL("gsub result2 %.30s too big; can't happen", buf);
1886                 *pb = '\0';
1887                 setsval(x, buf);        /* BUG: should be able to avoid copy + free */
1888         }
1889         tempfree(x);
1890         tempfree(y);
1891         x = gettemp();
1892         x->tval = NUM;
1893         x->fval = num;
1894         free(buf);
1895         return(x);
1896 }
1897
1898 void backsub(char **pb_ptr, char **sptr_ptr)    /* handle \\& variations */
1899 {                                               /* sptr[0] == '\\' */
1900         char *pb = *pb_ptr, *sptr = *sptr_ptr;
1901
1902         if (sptr[1] == '\\') {
1903                 if (sptr[2] == '\\' && sptr[3] == '&') { /* \\\& -> \& */
1904                         *pb++ = '\\';
1905                         *pb++ = '&';
1906                         sptr += 4;
1907                 } else if (sptr[2] == '&') {    /* \\& -> \ + matched */
1908                         *pb++ = '\\';
1909                         sptr += 2;
1910                 } else {                        /* \\x -> \\x */
1911                         *pb++ = *sptr++;
1912                         *pb++ = *sptr++;
1913                 }
1914         } else if (sptr[1] == '&') {    /* literal & */
1915                 sptr++;
1916                 *pb++ = *sptr++;
1917         } else                          /* literal \ */
1918                 *pb++ = *sptr++;
1919
1920         *pb_ptr = pb;
1921         *sptr_ptr = sptr;
1922 }