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