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