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