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