perl 1.0 patch 9: 3 portability problems
[p5sagit/p5-mst-13.2.git] / arg.c
CommitLineData
d96024cf 1/* $Header: arg.c,v 1.0.1.5 88/01/30 08:53:16 root Exp $
8d063cd8 2 *
3 * $Log: arg.c,v $
d96024cf 4 * Revision 1.0.1.5 88/01/30 08:53:16 root
5 * patch9: fixed some missing right parens introduced (?) by patch 2
6 *
a559c259 7 * Revision 1.0.1.4 88/01/28 10:22:06 root
8 * patch8: added eval operator.
f9ad7436 9 *
135863df 10 * Revision 1.0.1.2 88/01/24 03:52:34 root
11 * patch 2: added STATBLKS dependencies.
12 *
36ce8bec 13 * Revision 1.0.1.1 88/01/21 21:27:10 root
14 * Now defines signal return values correctly using VOIDSIG.
15 *
8d063cd8 16 * Revision 1.0 87/12/18 13:04:33 root
17 * Initial revision
18 *
19 */
20
21#include <signal.h>
22#include "handy.h"
23#include "EXTERN.h"
24#include "search.h"
25#include "util.h"
26#include "perl.h"
27
28ARG *debarg;
29
30bool
31do_match(s,arg)
32register char *s;
33register ARG *arg;
34{
35 register SPAT *spat = arg[2].arg_ptr.arg_spat;
36 register char *d;
37 register char *t;
38
39 if (!spat || !s)
40 fatal("panic: do_match\n");
41 if (spat->spat_flags & SPAT_USED) {
42#ifdef DEBUGGING
43 if (debug & 8)
44 deb("2.SPAT USED\n");
45#endif
46 return FALSE;
47 }
48 if (spat->spat_runtime) {
49 t = str_get(eval(spat->spat_runtime,Null(STR***)));
50#ifdef DEBUGGING
51 if (debug & 8)
52 deb("2.SPAT /%s/\n",t);
53#endif
54 if (d = compile(&spat->spat_compex,t,TRUE,FALSE)) {
55#ifdef DEBUGGING
56 deb("/%s/: %s\n", t, d);
57#endif
58 return FALSE;
59 }
60 if (spat->spat_compex.complen <= 1 && curspat)
61 spat = curspat;
62 if (execute(&spat->spat_compex, s, TRUE, 0)) {
63 if (spat->spat_compex.numsubs)
64 curspat = spat;
65 return TRUE;
66 }
67 else
68 return FALSE;
69 }
70 else {
71#ifdef DEBUGGING
72 if (debug & 8) {
73 char ch;
74
75 if (spat->spat_flags & SPAT_USE_ONCE)
76 ch = '?';
77 else
78 ch = '/';
79 deb("2.SPAT %c%s%c\n",ch,spat->spat_compex.precomp,ch);
80 }
81#endif
82 if (spat->spat_compex.complen <= 1 && curspat)
83 spat = curspat;
84 if (spat->spat_first) {
85 if (spat->spat_flags & SPAT_SCANFIRST) {
86 str_free(spat->spat_first);
87 spat->spat_first = Nullstr; /* disable optimization */
88 }
89 else if (*spat->spat_first->str_ptr != *s ||
90 strnNE(spat->spat_first->str_ptr, s, spat->spat_flen) )
91 return FALSE;
92 }
93 if (execute(&spat->spat_compex, s, TRUE, 0)) {
94 if (spat->spat_compex.numsubs)
95 curspat = spat;
96 if (spat->spat_flags & SPAT_USE_ONCE)
97 spat->spat_flags |= SPAT_USED;
98 return TRUE;
99 }
100 else
101 return FALSE;
102 }
103 /*NOTREACHED*/
104}
105
106int
107do_subst(str,arg)
108STR *str;
109register ARG *arg;
110{
111 register SPAT *spat;
112 register STR *dstr;
113 register char *s;
114 register char *m;
115
116 spat = arg[2].arg_ptr.arg_spat;
117 s = str_get(str);
118 if (!spat || !s)
119 fatal("panic: do_subst\n");
120 else if (spat->spat_runtime) {
121 char *d;
122
123 m = str_get(eval(spat->spat_runtime,Null(STR***)));
124 if (d = compile(&spat->spat_compex,m,TRUE,FALSE)) {
125#ifdef DEBUGGING
126 deb("/%s/: %s\n", m, d);
127#endif
128 return 0;
129 }
130 }
131#ifdef DEBUGGING
132 if (debug & 8) {
133 deb("2.SPAT /%s/\n",spat->spat_compex.precomp);
134 }
135#endif
136 if (spat->spat_compex.complen <= 1 && curspat)
137 spat = curspat;
138 if (spat->spat_first) {
139 if (spat->spat_flags & SPAT_SCANFIRST) {
140 str_free(spat->spat_first);
141 spat->spat_first = Nullstr; /* disable optimization */
142 }
143 else if (*spat->spat_first->str_ptr != *s ||
144 strnNE(spat->spat_first->str_ptr, s, spat->spat_flen) )
145 return 0;
146 }
147 if (m = execute(&spat->spat_compex, s, TRUE, 1)) {
148 int iters = 0;
149
150 dstr = str_new(str_len(str));
151 if (spat->spat_compex.numsubs)
152 curspat = spat;
153 do {
154 if (iters++ > 10000)
155 fatal("Substitution loop?\n");
156 if (spat->spat_compex.numsubs)
157 s = spat->spat_compex.subbase;
158 str_ncat(dstr,s,m-s);
159 s = spat->spat_compex.subend[0];
160 str_scat(dstr,eval(spat->spat_repl,Null(STR***)));
161 if (spat->spat_flags & SPAT_USE_ONCE)
162 break;
163 } while (m = execute(&spat->spat_compex, s, FALSE, 1));
164 str_cat(dstr,s);
165 str_replace(str,dstr);
166 STABSET(str);
167 return iters;
168 }
169 return 0;
170}
171
172int
173do_trans(str,arg)
174STR *str;
175register ARG *arg;
176{
177 register char *tbl;
178 register char *s;
179 register int matches = 0;
180 register int ch;
181
182 tbl = arg[2].arg_ptr.arg_cval;
183 s = str_get(str);
184 if (!tbl || !s)
185 fatal("panic: do_trans\n");
186#ifdef DEBUGGING
187 if (debug & 8) {
188 deb("2.TBL\n");
189 }
190#endif
191 while (*s) {
192 if (ch = tbl[*s & 0377]) {
193 matches++;
194 *s = ch;
195 }
196 s++;
197 }
198 STABSET(str);
199 return matches;
200}
201
202int
203do_split(s,spat,retary)
204register char *s;
205register SPAT *spat;
206STR ***retary;
207{
208 register STR *dstr;
209 register char *m;
210 register ARRAY *ary;
211 static ARRAY *myarray = Null(ARRAY*);
212 int iters = 0;
213 STR **sarg;
214 register char *e;
215 int i;
216
217 if (!spat || !s)
218 fatal("panic: do_split\n");
219 else if (spat->spat_runtime) {
220 char *d;
221
222 m = str_get(eval(spat->spat_runtime,Null(STR***)));
223 if (d = compile(&spat->spat_compex,m,TRUE,FALSE)) {
224#ifdef DEBUGGING
225 deb("/%s/: %s\n", m, d);
226#endif
227 return FALSE;
228 }
229 }
230#ifdef DEBUGGING
231 if (debug & 8) {
232 deb("2.SPAT /%s/\n",spat->spat_compex.precomp);
233 }
234#endif
235 if (retary)
236 ary = myarray;
237 else
238 ary = spat->spat_repl[1].arg_ptr.arg_stab->stab_array;
239 if (!ary)
240 myarray = ary = anew();
241 ary->ary_fill = -1;
242 while (*s && (m = execute(&spat->spat_compex, s, (iters == 0), 1))) {
243 if (spat->spat_compex.numsubs)
244 s = spat->spat_compex.subbase;
245 dstr = str_new(m-s);
246 str_nset(dstr,s,m-s);
247 astore(ary, iters++, dstr);
248 if (iters > 10000)
249 fatal("Substitution loop?\n");
250 s = spat->spat_compex.subend[0];
251 }
252 if (*s) { /* ignore field after final "whitespace" */
253 dstr = str_new(0); /* if they interpolate, it's null anyway */
254 str_set(dstr,s);
255 astore(ary, iters++, dstr);
256 }
257 else {
258 while (iters > 0 && !*str_get(afetch(ary,iters-1)))
259 iters--;
260 }
261 if (retary) {
262 sarg = (STR**)safemalloc((iters+2)*sizeof(STR*));
263
264 sarg[0] = Nullstr;
265 sarg[iters+1] = Nullstr;
266 for (i = 1; i <= iters; i++)
267 sarg[i] = afetch(ary,i-1);
268 *retary = sarg;
269 }
270 return iters;
271}
272
273void
274do_join(arg,delim,str)
275register ARG *arg;
276register char *delim;
277register STR *str;
278{
279 STR **tmpary; /* must not be register */
280 register STR **elem;
281
282 (void)eval(arg[2].arg_ptr.arg_arg,&tmpary);
283 elem = tmpary+1;
284 if (*elem)
285 str_sset(str,*elem++);
286 for (; *elem; elem++) {
287 str_cat(str,delim);
288 str_scat(str,*elem);
289 }
290 STABSET(str);
291 safefree((char*)tmpary);
292}
293
294bool
295do_open(stab,name)
296STAB *stab;
297register char *name;
298{
299 FILE *fp;
300 int len = strlen(name);
301 register STIO *stio = stab->stab_io;
302
303 while (len && isspace(name[len-1]))
304 name[--len] = '\0';
305 if (!stio)
306 stio = stab->stab_io = stio_new();
307 if (stio->fp) {
308 if (stio->type == '|')
309 pclose(stio->fp);
310 else if (stio->type != '-')
311 fclose(stio->fp);
312 stio->fp = Nullfp;
313 }
314 stio->type = *name;
315 if (*name == '|') {
316 for (name++; isspace(*name); name++) ;
317 fp = popen(name,"w");
318 }
319 else if (*name == '>' && name[1] == '>') {
320 for (name += 2; isspace(*name); name++) ;
321 fp = fopen(name,"a");
322 }
323 else if (*name == '>') {
324 for (name++; isspace(*name); name++) ;
325 if (strEQ(name,"-")) {
326 fp = stdout;
327 stio->type = '-';
328 }
329 else
330 fp = fopen(name,"w");
331 }
332 else {
333 if (*name == '<') {
334 for (name++; isspace(*name); name++) ;
335 if (strEQ(name,"-")) {
336 fp = stdin;
337 stio->type = '-';
338 }
339 else
340 fp = fopen(name,"r");
341 }
342 else if (name[len-1] == '|') {
343 name[--len] = '\0';
344 while (len && isspace(name[len-1]))
345 name[--len] = '\0';
346 for (; isspace(*name); name++) ;
347 fp = popen(name,"r");
348 stio->type = '|';
349 }
350 else {
351 stio->type = '<';
352 for (; isspace(*name); name++) ;
353 if (strEQ(name,"-")) {
354 fp = stdin;
355 stio->type = '-';
356 }
357 else
358 fp = fopen(name,"r");
359 }
360 }
361 if (!fp)
362 return FALSE;
363 if (stio->type != '|' && stio->type != '-') {
364 if (fstat(fileno(fp),&statbuf) < 0) {
365 fclose(fp);
366 return FALSE;
367 }
368 if ((statbuf.st_mode & S_IFMT) != S_IFREG &&
369 (statbuf.st_mode & S_IFMT) != S_IFCHR) {
370 fclose(fp);
371 return FALSE;
372 }
373 }
374 stio->fp = fp;
375 return TRUE;
376}
377
378FILE *
379nextargv(stab)
380register STAB *stab;
381{
382 register STR *str;
383 char *oldname;
384
385 while (alen(stab->stab_array) >= 0L) {
386 str = ashift(stab->stab_array);
387 str_sset(stab->stab_val,str);
388 STABSET(stab->stab_val);
389 oldname = str_get(stab->stab_val);
390 if (do_open(stab,oldname)) {
391 if (inplace) {
392 if (*inplace) {
393 str_cat(str,inplace);
394#ifdef RENAME
395 rename(oldname,str->str_ptr);
396#else
397 UNLINK(str->str_ptr);
398 link(oldname,str->str_ptr);
399 UNLINK(oldname);
400#endif
401 }
402 sprintf(tokenbuf,">%s",oldname);
403 do_open(argvoutstab,tokenbuf);
404 defoutstab = argvoutstab;
405 }
406 str_free(str);
407 return stab->stab_io->fp;
408 }
409 else
410 fprintf(stderr,"Can't open %s\n",str_get(str));
411 str_free(str);
412 }
413 if (inplace) {
414 do_close(argvoutstab,FALSE);
415 defoutstab = stabent("stdout",TRUE);
416 }
417 return Nullfp;
418}
419
420bool
421do_close(stab,explicit)
422STAB *stab;
423bool explicit;
424{
425 bool retval = FALSE;
426 register STIO *stio = stab->stab_io;
427
428 if (!stio) /* never opened */
429 return FALSE;
430 if (stio->fp) {
431 if (stio->type == '|')
432 retval = (pclose(stio->fp) >= 0);
433 else if (stio->type == '-')
434 retval = TRUE;
435 else
436 retval = (fclose(stio->fp) != EOF);
437 stio->fp = Nullfp;
438 }
439 if (explicit)
440 stio->lines = 0;
441 stio->type = ' ';
442 return retval;
443}
444
445bool
446do_eof(stab)
447STAB *stab;
448{
449 register STIO *stio;
450 int ch;
451
452 if (!stab)
453 return TRUE;
454
455 stio = stab->stab_io;
456 if (!stio)
457 return TRUE;
458
459 while (stio->fp) {
460
461#ifdef STDSTDIO /* (the code works without this) */
462 if (stio->fp->_cnt) /* cheat a little, since */
463 return FALSE; /* this is the most usual case */
464#endif
465
466 ch = getc(stio->fp);
467 if (ch != EOF) {
468 ungetc(ch, stio->fp);
469 return FALSE;
470 }
471 if (stio->flags & IOF_ARGV) { /* not necessarily a real EOF yet? */
472 if (!nextargv(stab)) /* get another fp handy */
473 return TRUE;
474 }
475 else
476 return TRUE; /* normal fp, definitely end of file */
477 }
478 return TRUE;
479}
480
481long
482do_tell(stab)
483STAB *stab;
484{
485 register STIO *stio;
486 int ch;
487
488 if (!stab)
489 return -1L;
490
491 stio = stab->stab_io;
492 if (!stio || !stio->fp)
493 return -1L;
494
495 return ftell(stio->fp);
496}
497
498bool
499do_seek(stab, pos, whence)
500STAB *stab;
501long pos;
502int whence;
503{
504 register STIO *stio;
505
506 if (!stab)
507 return FALSE;
508
509 stio = stab->stab_io;
510 if (!stio || !stio->fp)
511 return FALSE;
512
513 return fseek(stio->fp, pos, whence) >= 0;
514}
515
516do_stat(arg,sarg,retary)
517register ARG *arg;
518register STR **sarg;
519STR ***retary;
520{
521 register ARRAY *ary;
522 static ARRAY *myarray = Null(ARRAY*);
523 int max = 13;
524 register int i;
525
526 ary = myarray;
527 if (!ary)
528 myarray = ary = anew();
529 ary->ary_fill = -1;
530 if (arg[1].arg_type == A_LVAL) {
531 tmpstab = arg[1].arg_ptr.arg_stab;
532 if (!tmpstab->stab_io ||
533 fstat(fileno(tmpstab->stab_io->fp),&statbuf) < 0) {
534 max = 0;
535 }
536 }
537 else
538 if (stat(str_get(sarg[1]),&statbuf) < 0)
539 max = 0;
540
541 if (retary) {
542 if (max) {
543 apush(ary,str_nmake((double)statbuf.st_dev));
544 apush(ary,str_nmake((double)statbuf.st_ino));
545 apush(ary,str_nmake((double)statbuf.st_mode));
546 apush(ary,str_nmake((double)statbuf.st_nlink));
547 apush(ary,str_nmake((double)statbuf.st_uid));
548 apush(ary,str_nmake((double)statbuf.st_gid));
549 apush(ary,str_nmake((double)statbuf.st_rdev));
550 apush(ary,str_nmake((double)statbuf.st_size));
551 apush(ary,str_nmake((double)statbuf.st_atime));
552 apush(ary,str_nmake((double)statbuf.st_mtime));
553 apush(ary,str_nmake((double)statbuf.st_ctime));
135863df 554#ifdef STATBLOCKS
8d063cd8 555 apush(ary,str_nmake((double)statbuf.st_blksize));
556 apush(ary,str_nmake((double)statbuf.st_blocks));
135863df 557#else
d96024cf 558 apush(ary,str_make(""));
559 apush(ary,str_make(""));
135863df 560#endif
8d063cd8 561 }
562 sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
563 sarg[0] = Nullstr;
564 sarg[max+1] = Nullstr;
565 for (i = 1; i <= max; i++)
566 sarg[i] = afetch(ary,i-1);
567 *retary = sarg;
568 }
569 return max;
570}
571
572do_tms(retary)
573STR ***retary;
574{
575 register ARRAY *ary;
576 static ARRAY *myarray = Null(ARRAY*);
577 register STR **sarg;
578 int max = 4;
579 register int i;
580
581 ary = myarray;
582 if (!ary)
583 myarray = ary = anew();
584 ary->ary_fill = -1;
585 if (times(&timesbuf) < 0)
586 max = 0;
587
588 if (retary) {
589 if (max) {
590 apush(ary,str_nmake(((double)timesbuf.tms_utime)/60.0));
591 apush(ary,str_nmake(((double)timesbuf.tms_stime)/60.0));
592 apush(ary,str_nmake(((double)timesbuf.tms_cutime)/60.0));
593 apush(ary,str_nmake(((double)timesbuf.tms_cstime)/60.0));
594 }
595 sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
596 sarg[0] = Nullstr;
597 sarg[max+1] = Nullstr;
598 for (i = 1; i <= max; i++)
599 sarg[i] = afetch(ary,i-1);
600 *retary = sarg;
601 }
602 return max;
603}
604
605do_time(tmbuf,retary)
606struct tm *tmbuf;
607STR ***retary;
608{
609 register ARRAY *ary;
610 static ARRAY *myarray = Null(ARRAY*);
611 register STR **sarg;
612 int max = 9;
613 register int i;
614 STR *str;
615
616 ary = myarray;
617 if (!ary)
618 myarray = ary = anew();
619 ary->ary_fill = -1;
620 if (!tmbuf)
621 max = 0;
622
623 if (retary) {
624 if (max) {
625 apush(ary,str_nmake((double)tmbuf->tm_sec));
626 apush(ary,str_nmake((double)tmbuf->tm_min));
627 apush(ary,str_nmake((double)tmbuf->tm_hour));
628 apush(ary,str_nmake((double)tmbuf->tm_mday));
629 apush(ary,str_nmake((double)tmbuf->tm_mon));
630 apush(ary,str_nmake((double)tmbuf->tm_year));
631 apush(ary,str_nmake((double)tmbuf->tm_wday));
632 apush(ary,str_nmake((double)tmbuf->tm_yday));
633 apush(ary,str_nmake((double)tmbuf->tm_isdst));
634 }
635 sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
636 sarg[0] = Nullstr;
637 sarg[max+1] = Nullstr;
638 for (i = 1; i <= max; i++)
639 sarg[i] = afetch(ary,i-1);
640 *retary = sarg;
641 }
642 return max;
643}
644
645void
646do_sprintf(str,len,sarg)
647register STR *str;
648register int len;
649register STR **sarg;
650{
651 register char *s;
652 register char *t;
653 bool dolong;
654 char ch;
f9ad7436 655 static STR *sargnull = &str_no;
8d063cd8 656
657 str_set(str,"");
658 len--; /* don't count pattern string */
659 sarg++;
f9ad7436 660 for (s = str_get(*(sarg++)); *s; len--) {
661 if (len <= 0 || !*sarg) {
662 sarg = &sargnull;
663 len = 0;
664 }
8d063cd8 665 dolong = FALSE;
666 for (t = s; *t && *t != '%'; t++) ;
667 if (!*t)
668 break; /* not enough % patterns, oh well */
669 for (t++; *sarg && *t && t != s; t++) {
670 switch (*t) {
671 case '\0':
672 break;
673 case '%':
674 ch = *(++t);
675 *t = '\0';
676 sprintf(buf,s);
677 s = t;
678 *(t--) = ch;
679 break;
680 case 'l':
681 dolong = TRUE;
682 break;
683 case 'D': case 'X': case 'O':
684 dolong = TRUE;
685 /* FALL THROUGH */
686 case 'd': case 'x': case 'o': case 'c':
687 ch = *(++t);
688 *t = '\0';
689 if (dolong)
690 sprintf(buf,s,(long)str_gnum(*(sarg++)));
691 else
692 sprintf(buf,s,(int)str_gnum(*(sarg++)));
693 s = t;
694 *(t--) = ch;
695 break;
696 case 'E': case 'e': case 'f': case 'G': case 'g':
697 ch = *(++t);
698 *t = '\0';
699 sprintf(buf,s,str_gnum(*(sarg++)));
700 s = t;
701 *(t--) = ch;
702 break;
703 case 's':
704 ch = *(++t);
705 *t = '\0';
706 sprintf(buf,s,str_get(*(sarg++)));
707 s = t;
708 *(t--) = ch;
709 break;
710 }
711 }
712 str_cat(str,buf);
713 }
714 if (*s)
715 str_cat(str,s);
716 STABSET(str);
717}
718
719bool
720do_print(s,fp)
721char *s;
722FILE *fp;
723{
724 if (!fp || !s)
725 return FALSE;
726 fputs(s,fp);
727 return TRUE;
728}
729
730bool
731do_aprint(arg,fp)
732register ARG *arg;
733register FILE *fp;
734{
735 STR **tmpary; /* must not be register */
736 register STR **elem;
737 register bool retval;
738 double value;
739
740 (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
741 if (arg->arg_type == O_PRTF) {
742 do_sprintf(arg->arg_ptr.arg_str,32767,tmpary);
743 retval = do_print(str_get(arg->arg_ptr.arg_str),fp);
744 }
745 else {
746 retval = FALSE;
747 for (elem = tmpary+1; *elem; elem++) {
748 if (retval && ofs)
749 do_print(ofs, fp);
750 if (ofmt && fp) {
751 if ((*elem)->str_nok || str_gnum(*elem) != 0.0)
752 fprintf(fp, ofmt, str_gnum(*elem));
753 retval = TRUE;
754 }
755 else
756 retval = do_print(str_get(*elem), fp);
757 if (!retval)
758 break;
759 }
760 if (ors)
761 retval = do_print(ors, fp);
762 }
763 safefree((char*)tmpary);
764 return retval;
765}
766
767bool
768do_aexec(arg)
769register ARG *arg;
770{
771 STR **tmpary; /* must not be register */
772 register STR **elem;
773 register char **a;
774 register int i;
775 char **argv;
776
777 (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
778 i = 0;
779 for (elem = tmpary+1; *elem; elem++)
780 i++;
781 if (i) {
782 argv = (char**)safemalloc((i+1)*sizeof(char*));
783 a = argv;
784 for (elem = tmpary+1; *elem; elem++) {
785 *a++ = str_get(*elem);
786 }
787 *a = Nullch;
788 execvp(argv[0],argv);
789 safefree((char*)argv);
790 }
791 safefree((char*)tmpary);
792 return FALSE;
793}
794
795bool
796do_exec(cmd)
797char *cmd;
798{
799 STR **tmpary; /* must not be register */
800 register char **a;
801 register char *s;
802 char **argv;
803
804 /* see if there are shell metacharacters in it */
805
806 for (s = cmd; *s; s++) {
807 if (*s != ' ' && !isalpha(*s) && index("$&*(){}[]'\";\\|?<>~`",*s)) {
808 execl("/bin/sh","sh","-c",cmd,0);
809 return FALSE;
810 }
811 }
812 argv = (char**)safemalloc(((s - cmd) / 2 + 2)*sizeof(char*));
813
814 a = argv;
815 for (s = cmd; *s;) {
816 while (isspace(*s)) s++;
817 if (*s)
818 *(a++) = s;
819 while (*s && !isspace(*s)) s++;
820 if (*s)
821 *s++ = '\0';
822 }
823 *a = Nullch;
824 if (argv[0])
825 execvp(argv[0],argv);
826 safefree((char*)argv);
827 return FALSE;
828}
829
830STR *
831do_push(arg,ary)
832register ARG *arg;
833register ARRAY *ary;
834{
835 STR **tmpary; /* must not be register */
836 register STR **elem;
837 register STR *str = &str_no;
838
839 (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
840 for (elem = tmpary+1; *elem; elem++) {
841 str = str_new(0);
842 str_sset(str,*elem);
843 apush(ary,str);
844 }
845 safefree((char*)tmpary);
846 return str;
847}
848
849do_unshift(arg,ary)
850register ARG *arg;
851register ARRAY *ary;
852{
853 STR **tmpary; /* must not be register */
854 register STR **elem;
855 register STR *str = &str_no;
856 register int i;
857
858 (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
859 i = 0;
860 for (elem = tmpary+1; *elem; elem++)
861 i++;
862 aunshift(ary,i);
863 i = 0;
864 for (elem = tmpary+1; *elem; elem++) {
865 str = str_new(0);
866 str_sset(str,*elem);
867 astore(ary,i++,str);
868 }
869 safefree((char*)tmpary);
870}
871
872apply(type,arg,sarg)
873int type;
874register ARG *arg;
875STR **sarg;
876{
877 STR **tmpary; /* must not be register */
878 register STR **elem;
879 register int i;
880 register int val;
881 register int val2;
882
883 if (sarg)
884 tmpary = sarg;
885 else
886 (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
887 i = 0;
888 for (elem = tmpary+1; *elem; elem++)
889 i++;
890 switch (type) {
891 case O_CHMOD:
892 if (--i > 0) {
893 val = (int)str_gnum(tmpary[1]);
894 for (elem = tmpary+2; *elem; elem++)
895 if (chmod(str_get(*elem),val))
896 i--;
897 }
898 break;
899 case O_CHOWN:
900 if (i > 2) {
901 i -= 2;
902 val = (int)str_gnum(tmpary[1]);
903 val2 = (int)str_gnum(tmpary[2]);
904 for (elem = tmpary+3; *elem; elem++)
905 if (chown(str_get(*elem),val,val2))
906 i--;
907 }
908 else
909 i = 0;
910 break;
911 case O_KILL:
912 if (--i > 0) {
913 val = (int)str_gnum(tmpary[1]);
914 if (val < 0)
915 val = -val;
916 for (elem = tmpary+2; *elem; elem++)
917 if (kill(atoi(str_get(*elem)),val))
918 i--;
919 }
920 break;
921 case O_UNLINK:
922 for (elem = tmpary+1; *elem; elem++)
923 if (UNLINK(str_get(*elem)))
924 i--;
925 break;
926 }
927 if (!sarg)
928 safefree((char*)tmpary);
929 return i;
930}
931
932STR *
933do_subr(arg,sarg)
934register ARG *arg;
935register char **sarg;
936{
937 ARRAY *savearray;
938 STR *str;
939
940 savearray = defstab->stab_array;
941 defstab->stab_array = anew();
942 if (arg[1].arg_flags & AF_SPECIAL)
943 (void)do_push(arg,defstab->stab_array);
944 else if (arg[1].arg_type != A_NULL) {
945 str = str_new(0);
946 str_sset(str,sarg[1]);
947 apush(defstab->stab_array,str);
948 }
949 str = cmd_exec(arg[2].arg_ptr.arg_stab->stab_sub);
950 afree(defstab->stab_array); /* put back old $_[] */
951 defstab->stab_array = savearray;
952 return str;
953}
954
955void
956do_assign(retstr,arg)
957STR *retstr;
958register ARG *arg;
959{
960 STR **tmpary; /* must not be register */
961 register ARG *larg = arg[1].arg_ptr.arg_arg;
962 register STR **elem;
963 register STR *str;
964 register ARRAY *ary;
965 register int i;
966 register int lasti;
967 char *s;
968
969 (void)eval(arg[2].arg_ptr.arg_arg,&tmpary);
970
971 if (arg->arg_flags & AF_COMMON) {
972 if (*(tmpary+1)) {
973 for (elem=tmpary+2; *elem; elem++) {
974 *elem = str_static(*elem);
975 }
976 }
977 }
978 if (larg->arg_type == O_LIST) {
979 lasti = larg->arg_len;
980 for (i=1,elem=tmpary+1; i <= lasti; i++) {
981 if (*elem)
982 s = str_get(*(elem++));
983 else
984 s = "";
985 switch (larg[i].arg_type) {
986 case A_STAB:
987 case A_LVAL:
988 str = STAB_STR(larg[i].arg_ptr.arg_stab);
989 break;
990 case A_LEXPR:
991 str = eval(larg[i].arg_ptr.arg_arg,Null(STR***));
992 break;
993 }
994 str_set(str,s);
995 STABSET(str);
996 }
997 i = elem - tmpary - 1;
998 }
999 else { /* should be an array name */
1000 ary = larg[1].arg_ptr.arg_stab->stab_array;
1001 for (i=0,elem=tmpary+1; *elem; i++) {
1002 str = str_new(0);
1003 if (*elem)
1004 str_sset(str,*(elem++));
1005 astore(ary,i,str);
1006 }
1007 ary->ary_fill = i - 1; /* they can get the extra ones back by */
1008 } /* setting an element larger than old fill */
1009 str_numset(retstr,(double)i);
1010 STABSET(retstr);
1011 safefree((char*)tmpary);
1012}
1013
1014int
1015do_kv(hash,kv,sarg,retary)
1016HASH *hash;
1017int kv;
1018register STR **sarg;
1019STR ***retary;
1020{
1021 register ARRAY *ary;
1022 int max = 0;
1023 int i;
1024 static ARRAY *myarray = Null(ARRAY*);
1025 register HENT *entry;
1026
1027 ary = myarray;
1028 if (!ary)
1029 myarray = ary = anew();
1030 ary->ary_fill = -1;
1031
1032 hiterinit(hash);
1033 while (entry = hiternext(hash)) {
1034 max++;
1035 if (kv == O_KEYS)
1036 apush(ary,str_make(hiterkey(entry)));
1037 else
1038 apush(ary,str_make(str_get(hiterval(entry))));
1039 }
1040 if (retary) { /* array wanted */
1041 sarg = (STR**)saferealloc((char*)sarg,(max+2)*sizeof(STR*));
1042 sarg[0] = Nullstr;
1043 sarg[max+1] = Nullstr;
1044 for (i = 1; i <= max; i++)
1045 sarg[i] = afetch(ary,i-1);
1046 *retary = sarg;
1047 }
1048 return max;
1049}
1050
1051STR *
1052do_each(hash,sarg,retary)
1053HASH *hash;
1054register STR **sarg;
1055STR ***retary;
1056{
1057 static STR *mystr = Nullstr;
1058 STR *retstr;
1059 HENT *entry = hiternext(hash);
1060
1061 if (mystr) {
1062 str_free(mystr);
1063 mystr = Nullstr;
1064 }
1065
1066 if (retary) { /* array wanted */
1067 if (entry) {
1068 sarg = (STR**)saferealloc((char*)sarg,4*sizeof(STR*));
1069 sarg[0] = Nullstr;
1070 sarg[3] = Nullstr;
1071 sarg[1] = mystr = str_make(hiterkey(entry));
1072 retstr = sarg[2] = hiterval(entry);
1073 *retary = sarg;
1074 }
1075 else {
1076 sarg = (STR**)saferealloc((char*)sarg,2*sizeof(STR*));
1077 sarg[0] = Nullstr;
1078 sarg[1] = retstr = Nullstr;
1079 *retary = sarg;
1080 }
1081 }
1082 else
1083 retstr = hiterval(entry);
1084
1085 return retstr;
1086}
1087
1088init_eval()
1089{
1090 register int i;
1091
1092#define A(e1,e2,e3) (e1+(e2<<1)+(e3<<2))
1093 opargs[O_ITEM] = A(1,0,0);
1094 opargs[O_ITEM2] = A(0,0,0);
1095 opargs[O_ITEM3] = A(0,0,0);
1096 opargs[O_CONCAT] = A(1,1,0);
1097 opargs[O_MATCH] = A(1,0,0);
1098 opargs[O_NMATCH] = A(1,0,0);
1099 opargs[O_SUBST] = A(1,0,0);
1100 opargs[O_NSUBST] = A(1,0,0);
1101 opargs[O_ASSIGN] = A(1,1,0);
1102 opargs[O_MULTIPLY] = A(1,1,0);
1103 opargs[O_DIVIDE] = A(1,1,0);
1104 opargs[O_MODULO] = A(1,1,0);
1105 opargs[O_ADD] = A(1,1,0);
1106 opargs[O_SUBTRACT] = A(1,1,0);
1107 opargs[O_LEFT_SHIFT] = A(1,1,0);
1108 opargs[O_RIGHT_SHIFT] = A(1,1,0);
1109 opargs[O_LT] = A(1,1,0);
1110 opargs[O_GT] = A(1,1,0);
1111 opargs[O_LE] = A(1,1,0);
1112 opargs[O_GE] = A(1,1,0);
1113 opargs[O_EQ] = A(1,1,0);
1114 opargs[O_NE] = A(1,1,0);
1115 opargs[O_BIT_AND] = A(1,1,0);
1116 opargs[O_XOR] = A(1,1,0);
1117 opargs[O_BIT_OR] = A(1,1,0);
1118 opargs[O_AND] = A(1,0,0); /* don't eval arg 2 (yet) */
1119 opargs[O_OR] = A(1,0,0); /* don't eval arg 2 (yet) */
1120 opargs[O_COND_EXPR] = A(1,0,0); /* don't eval args 2 or 3 */
1121 opargs[O_COMMA] = A(1,1,0);
1122 opargs[O_NEGATE] = A(1,0,0);
1123 opargs[O_NOT] = A(1,0,0);
1124 opargs[O_COMPLEMENT] = A(1,0,0);
1125 opargs[O_WRITE] = A(1,0,0);
1126 opargs[O_OPEN] = A(1,1,0);
1127 opargs[O_TRANS] = A(1,0,0);
1128 opargs[O_NTRANS] = A(1,0,0);
1129 opargs[O_CLOSE] = A(0,0,0);
1130 opargs[O_ARRAY] = A(1,0,0);
1131 opargs[O_HASH] = A(1,0,0);
1132 opargs[O_LARRAY] = A(1,0,0);
1133 opargs[O_LHASH] = A(1,0,0);
1134 opargs[O_PUSH] = A(1,0,0);
1135 opargs[O_POP] = A(0,0,0);
1136 opargs[O_SHIFT] = A(0,0,0);
1137 opargs[O_SPLIT] = A(1,0,0);
1138 opargs[O_LENGTH] = A(1,0,0);
1139 opargs[O_SPRINTF] = A(1,0,0);
1140 opargs[O_SUBSTR] = A(1,1,1);
1141 opargs[O_JOIN] = A(1,0,0);
1142 opargs[O_SLT] = A(1,1,0);
1143 opargs[O_SGT] = A(1,1,0);
1144 opargs[O_SLE] = A(1,1,0);
1145 opargs[O_SGE] = A(1,1,0);
1146 opargs[O_SEQ] = A(1,1,0);
1147 opargs[O_SNE] = A(1,1,0);
1148 opargs[O_SUBR] = A(1,0,0);
1149 opargs[O_PRINT] = A(1,0,0);
1150 opargs[O_CHDIR] = A(1,0,0);
1151 opargs[O_DIE] = A(1,0,0);
1152 opargs[O_EXIT] = A(1,0,0);
1153 opargs[O_RESET] = A(1,0,0);
1154 opargs[O_LIST] = A(0,0,0);
1155 opargs[O_EOF] = A(0,0,0);
1156 opargs[O_TELL] = A(0,0,0);
1157 opargs[O_SEEK] = A(0,1,1);
1158 opargs[O_LAST] = A(1,0,0);
1159 opargs[O_NEXT] = A(1,0,0);
1160 opargs[O_REDO] = A(1,0,0);
1161 opargs[O_GOTO] = A(1,0,0);
1162 opargs[O_INDEX] = A(1,1,0);
1163 opargs[O_TIME] = A(0,0,0);
1164 opargs[O_TMS] = A(0,0,0);
1165 opargs[O_LOCALTIME] = A(1,0,0);
1166 opargs[O_GMTIME] = A(1,0,0);
1167 opargs[O_STAT] = A(1,0,0);
1168 opargs[O_CRYPT] = A(1,1,0);
1169 opargs[O_EXP] = A(1,0,0);
1170 opargs[O_LOG] = A(1,0,0);
1171 opargs[O_SQRT] = A(1,0,0);
1172 opargs[O_INT] = A(1,0,0);
1173 opargs[O_PRTF] = A(1,0,0);
1174 opargs[O_ORD] = A(1,0,0);
1175 opargs[O_SLEEP] = A(1,0,0);
1176 opargs[O_FLIP] = A(1,0,0);
1177 opargs[O_FLOP] = A(0,1,0);
1178 opargs[O_KEYS] = A(0,0,0);
1179 opargs[O_VALUES] = A(0,0,0);
1180 opargs[O_EACH] = A(0,0,0);
1181 opargs[O_CHOP] = A(1,0,0);
1182 opargs[O_FORK] = A(1,0,0);
1183 opargs[O_EXEC] = A(1,0,0);
1184 opargs[O_SYSTEM] = A(1,0,0);
1185 opargs[O_OCT] = A(1,0,0);
1186 opargs[O_HEX] = A(1,0,0);
1187 opargs[O_CHMOD] = A(1,0,0);
1188 opargs[O_CHOWN] = A(1,0,0);
1189 opargs[O_KILL] = A(1,0,0);
1190 opargs[O_RENAME] = A(1,1,0);
1191 opargs[O_UNLINK] = A(1,0,0);
1192 opargs[O_UMASK] = A(1,0,0);
1193 opargs[O_UNSHIFT] = A(1,0,0);
1194 opargs[O_LINK] = A(1,1,0);
1195 opargs[O_REPEAT] = A(1,1,0);
a559c259 1196 opargs[O_EVAL] = A(1,0,0);
8d063cd8 1197}
1198
36ce8bec 1199#ifdef VOIDSIG
1200static void (*ihand)();
1201static void (*qhand)();
1202#else
8d063cd8 1203static int (*ihand)();
1204static int (*qhand)();
36ce8bec 1205#endif
8d063cd8 1206
1207STR *
1208eval(arg,retary)
1209register ARG *arg;
1210STR ***retary; /* where to return an array to, null if nowhere */
1211{
1212 register STR *str;
1213 register int anum;
1214 register int optype;
1215 register int maxarg;
1216 double value;
1217 STR *quicksarg[5];
1218 register STR **sarg = quicksarg;
1219 register char *tmps;
1220 char *tmps2;
1221 int argflags;
1222 long tmplong;
1223 FILE *fp;
1224 STR *tmpstr;
1225 FCMD *form;
1226 STAB *stab;
1227 ARRAY *ary;
1228 bool assigning = FALSE;
1229 double exp(), log(), sqrt(), modf();
1230 char *crypt(), *getenv();
1231
1232 if (!arg)
1233 return &str_no;
1234 str = arg->arg_ptr.arg_str;
1235 optype = arg->arg_type;
1236 maxarg = arg->arg_len;
1237 if (maxarg > 3 || retary) {
1238 sarg = (STR **)safemalloc((maxarg+2) * sizeof(STR*));
1239 }
1240#ifdef DEBUGGING
1241 if (debug & 8) {
1242 deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
1243 }
1244 debname[dlevel] = opname[optype][0];
1245 debdelim[dlevel++] = ':';
1246#endif
1247 for (anum = 1; anum <= maxarg; anum++) {
1248 argflags = arg[anum].arg_flags;
1249 if (argflags & AF_SPECIAL)
1250 continue;
1251 re_eval:
1252 switch (arg[anum].arg_type) {
1253 default:
1254 sarg[anum] = &str_no;
1255#ifdef DEBUGGING
1256 tmps = "NULL";
1257#endif
1258 break;
1259 case A_EXPR:
1260#ifdef DEBUGGING
1261 if (debug & 8) {
1262 tmps = "EXPR";
1263 deb("%d.EXPR =>\n",anum);
1264 }
1265#endif
1266 sarg[anum] = eval(arg[anum].arg_ptr.arg_arg, Null(STR***));
1267 break;
1268 case A_CMD:
1269#ifdef DEBUGGING
1270 if (debug & 8) {
1271 tmps = "CMD";
1272 deb("%d.CMD (%lx) =>\n",anum,arg[anum].arg_ptr.arg_cmd);
1273 }
1274#endif
1275 sarg[anum] = cmd_exec(arg[anum].arg_ptr.arg_cmd);
1276 break;
1277 case A_STAB:
1278 sarg[anum] = STAB_STR(arg[anum].arg_ptr.arg_stab);
1279#ifdef DEBUGGING
1280 if (debug & 8) {
1281 sprintf(buf,"STAB $%s ==",arg[anum].arg_ptr.arg_stab->stab_name);
1282 tmps = buf;
1283 }
1284#endif
1285 break;
1286 case A_LEXPR:
1287#ifdef DEBUGGING
1288 if (debug & 8) {
1289 tmps = "LEXPR";
1290 deb("%d.LEXPR =>\n",anum);
1291 }
1292#endif
1293 str = eval(arg[anum].arg_ptr.arg_arg,Null(STR***));
1294 if (!str)
1295 fatal("panic: A_LEXPR\n");
1296 goto do_crement;
1297 case A_LVAL:
1298#ifdef DEBUGGING
1299 if (debug & 8) {
1300 sprintf(buf,"LVAL $%s ==",arg[anum].arg_ptr.arg_stab->stab_name);
1301 tmps = buf;
1302 }
1303#endif
1304 str = STAB_STR(arg[anum].arg_ptr.arg_stab);
1305 if (!str)
1306 fatal("panic: A_LVAL\n");
1307 do_crement:
1308 assigning = TRUE;
1309 if (argflags & AF_PRE) {
1310 if (argflags & AF_UP)
1311 str_inc(str);
1312 else
1313 str_dec(str);
1314 STABSET(str);
1315 sarg[anum] = str;
1316 str = arg->arg_ptr.arg_str;
1317 }
1318 else if (argflags & AF_POST) {
1319 sarg[anum] = str_static(str);
1320 if (argflags & AF_UP)
1321 str_inc(str);
1322 else
1323 str_dec(str);
1324 STABSET(str);
1325 str = arg->arg_ptr.arg_str;
1326 }
1327 else {
1328 sarg[anum] = str;
1329 }
1330 break;
1331 case A_ARYLEN:
1332 sarg[anum] = str_static(&str_no);
1333 str_numset(sarg[anum],
1334 (double)alen(arg[anum].arg_ptr.arg_stab->stab_array));
1335#ifdef DEBUGGING
1336 tmps = "ARYLEN";
1337#endif
1338 break;
1339 case A_SINGLE:
1340 sarg[anum] = arg[anum].arg_ptr.arg_str;
1341#ifdef DEBUGGING
1342 tmps = "SINGLE";
1343#endif
1344 break;
1345 case A_DOUBLE:
1346 (void) interp(str,str_get(arg[anum].arg_ptr.arg_str));
1347 sarg[anum] = str;
1348#ifdef DEBUGGING
1349 tmps = "DOUBLE";
1350#endif
1351 break;
1352 case A_BACKTICK:
1353 tmps = str_get(arg[anum].arg_ptr.arg_str);
1354 fp = popen(str_get(interp(str,tmps)),"r");
1355 tmpstr = str_new(80);
1356 str_set(str,"");
1357 if (fp) {
1358 while (str_gets(tmpstr,fp) != Nullch) {
1359 str_scat(str,tmpstr);
1360 }
1361 statusvalue = pclose(fp);
1362 }
1363 else
1364 statusvalue = -1;
1365 str_free(tmpstr);
1366
1367 sarg[anum] = str;
1368#ifdef DEBUGGING
1369 tmps = "BACK";
1370#endif
1371 break;
1372 case A_READ:
1373 fp = Nullfp;
1374 last_in_stab = arg[anum].arg_ptr.arg_stab;
1375 if (last_in_stab->stab_io) {
1376 fp = last_in_stab->stab_io->fp;
1377 if (!fp && (last_in_stab->stab_io->flags & IOF_ARGV)) {
1378 if (last_in_stab->stab_io->flags & IOF_START) {
1379 last_in_stab->stab_io->flags &= ~IOF_START;
1380 last_in_stab->stab_io->lines = 0;
1381 if (alen(last_in_stab->stab_array) < 0L) {
1382 tmpstr = str_make("-"); /* assume stdin */
1383 apush(last_in_stab->stab_array, tmpstr);
1384 }
1385 }
1386 fp = nextargv(last_in_stab);
1387 if (!fp) /* Note: fp != last_in_stab->stab_io->fp */
1388 do_close(last_in_stab,FALSE); /* now it does */
1389 }
1390 }
1391 keepgoing:
1392 if (!fp)
1393 sarg[anum] = &str_no;
1394 else if (!str_gets(str,fp)) {
1395 if (last_in_stab->stab_io->flags & IOF_ARGV) {
1396 fp = nextargv(last_in_stab);
1397 if (fp)
1398 goto keepgoing;
1399 do_close(last_in_stab,FALSE);
1400 last_in_stab->stab_io->flags |= IOF_START;
1401 }
1402 if (fp == stdin) {
1403 clearerr(fp);
1404 }
1405 sarg[anum] = &str_no;
1406 break;
1407 }
1408 else {
1409 last_in_stab->stab_io->lines++;
1410 sarg[anum] = str;
1411 }
1412#ifdef DEBUGGING
1413 tmps = "READ";
1414#endif
1415 break;
1416 }
1417#ifdef DEBUGGING
1418 if (debug & 8)
1419 deb("%d.%s = '%s'\n",anum,tmps,str_peek(sarg[anum]));
1420#endif
1421 }
1422 switch (optype) {
1423 case O_ITEM:
1424 if (str != sarg[1])
1425 str_sset(str,sarg[1]);
1426 STABSET(str);
1427 break;
1428 case O_ITEM2:
1429 if (str != sarg[2])
1430 str_sset(str,sarg[2]);
1431 STABSET(str);
1432 break;
1433 case O_ITEM3:
1434 if (str != sarg[3])
1435 str_sset(str,sarg[3]);
1436 STABSET(str);
1437 break;
1438 case O_CONCAT:
1439 if (str != sarg[1])
1440 str_sset(str,sarg[1]);
1441 str_scat(str,sarg[2]);
1442 STABSET(str);
1443 break;
1444 case O_REPEAT:
1445 if (str != sarg[1])
1446 str_sset(str,sarg[1]);
1447 anum = (long)str_gnum(sarg[2]);
1448 if (anum >= 1) {
1449 tmpstr = str_new(0);
1450 str_sset(tmpstr,str);
1451 for (anum--; anum; anum--)
1452 str_scat(str,tmpstr);
1453 }
1454 else
1455 str_sset(str,&str_no);
1456 STABSET(str);
1457 break;
1458 case O_MATCH:
1459 str_set(str, do_match(str_get(sarg[1]),arg) ? Yes : No);
1460 STABSET(str);
1461 break;
1462 case O_NMATCH:
1463 str_set(str, do_match(str_get(sarg[1]),arg) ? No : Yes);
1464 STABSET(str);
1465 break;
1466 case O_SUBST:
1467 value = (double) do_subst(str, arg);
1468 str = arg->arg_ptr.arg_str;
1469 goto donumset;
1470 case O_NSUBST:
1471 str_set(arg->arg_ptr.arg_str, do_subst(str, arg) ? No : Yes);
1472 str = arg->arg_ptr.arg_str;
1473 break;
1474 case O_ASSIGN:
1475 if (arg[2].arg_flags & AF_SPECIAL)
1476 do_assign(str,arg);
1477 else {
1478 if (str != sarg[2])
1479 str_sset(str, sarg[2]);
1480 STABSET(str);
1481 }
1482 break;
1483 case O_CHOP:
1484 tmps = str_get(str);
1485 tmps += str->str_cur - (str->str_cur != 0);
1486 str_set(arg->arg_ptr.arg_str,tmps); /* remember last char */
1487 *tmps = '\0'; /* wipe it out */
1488 str->str_cur = tmps - str->str_ptr;
1489 str->str_nok = 0;
1490 str = arg->arg_ptr.arg_str;
1491 break;
1492 case O_MULTIPLY:
1493 value = str_gnum(sarg[1]);
1494 value *= str_gnum(sarg[2]);
1495 goto donumset;
1496 case O_DIVIDE:
1497 value = str_gnum(sarg[1]);
1498 value /= str_gnum(sarg[2]);
1499 goto donumset;
1500 case O_MODULO:
1501 value = str_gnum(sarg[1]);
1502 value = (double)(((long)value) % (long)str_gnum(sarg[2]));
1503 goto donumset;
1504 case O_ADD:
1505 value = str_gnum(sarg[1]);
1506 value += str_gnum(sarg[2]);
1507 goto donumset;
1508 case O_SUBTRACT:
1509 value = str_gnum(sarg[1]);
1510 value -= str_gnum(sarg[2]);
1511 goto donumset;
1512 case O_LEFT_SHIFT:
1513 value = str_gnum(sarg[1]);
1514 value = (double)(((long)value) << (long)str_gnum(sarg[2]));
1515 goto donumset;
1516 case O_RIGHT_SHIFT:
1517 value = str_gnum(sarg[1]);
1518 value = (double)(((long)value) >> (long)str_gnum(sarg[2]));
1519 goto donumset;
1520 case O_LT:
1521 value = str_gnum(sarg[1]);
1522 value = (double)(value < str_gnum(sarg[2]));
1523 goto donumset;
1524 case O_GT:
1525 value = str_gnum(sarg[1]);
1526 value = (double)(value > str_gnum(sarg[2]));
1527 goto donumset;
1528 case O_LE:
1529 value = str_gnum(sarg[1]);
1530 value = (double)(value <= str_gnum(sarg[2]));
1531 goto donumset;
1532 case O_GE:
1533 value = str_gnum(sarg[1]);
1534 value = (double)(value >= str_gnum(sarg[2]));
1535 goto donumset;
1536 case O_EQ:
1537 value = str_gnum(sarg[1]);
1538 value = (double)(value == str_gnum(sarg[2]));
1539 goto donumset;
1540 case O_NE:
1541 value = str_gnum(sarg[1]);
1542 value = (double)(value != str_gnum(sarg[2]));
1543 goto donumset;
1544 case O_BIT_AND:
1545 value = str_gnum(sarg[1]);
1546 value = (double)(((long)value) & (long)str_gnum(sarg[2]));
1547 goto donumset;
1548 case O_XOR:
1549 value = str_gnum(sarg[1]);
1550 value = (double)(((long)value) ^ (long)str_gnum(sarg[2]));
1551 goto donumset;
1552 case O_BIT_OR:
1553 value = str_gnum(sarg[1]);
1554 value = (double)(((long)value) | (long)str_gnum(sarg[2]));
1555 goto donumset;
1556 case O_AND:
1557 if (str_true(sarg[1])) {
1558 anum = 2;
1559 optype = O_ITEM2;
1560 maxarg = 0;
1561 argflags = arg[anum].arg_flags;
1562 goto re_eval;
1563 }
1564 else {
1565 if (assigning) {
1566 str_sset(str, sarg[1]);
1567 STABSET(str);
1568 }
1569 else
1570 str = sarg[1];
1571 break;
1572 }
1573 case O_OR:
1574 if (str_true(sarg[1])) {
1575 if (assigning) {
1576 str_set(str, sarg[1]);
1577 STABSET(str);
1578 }
1579 else
1580 str = sarg[1];
1581 break;
1582 }
1583 else {
1584 anum = 2;
1585 optype = O_ITEM2;
1586 maxarg = 0;
1587 argflags = arg[anum].arg_flags;
1588 goto re_eval;
1589 }
1590 case O_COND_EXPR:
1591 anum = (str_true(sarg[1]) ? 2 : 3);
1592 optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
1593 maxarg = 0;
1594 argflags = arg[anum].arg_flags;
1595 goto re_eval;
1596 case O_COMMA:
1597 str = sarg[2];
1598 break;
1599 case O_NEGATE:
1600 value = -str_gnum(sarg[1]);
1601 goto donumset;
1602 case O_NOT:
1603 value = (double) !str_true(sarg[1]);
1604 goto donumset;
1605 case O_COMPLEMENT:
1606 value = (double) ~(long)str_gnum(sarg[1]);
1607 goto donumset;
1608 case O_SELECT:
1609 if (arg[1].arg_type == A_LVAL)
1610 defoutstab = arg[1].arg_ptr.arg_stab;
1611 else
1612 defoutstab = stabent(str_get(sarg[1]),TRUE);
1613 if (!defoutstab->stab_io)
1614 defoutstab->stab_io = stio_new();
1615 curoutstab = defoutstab;
1616 str_set(str,curoutstab->stab_io->fp ? Yes : No);
1617 STABSET(str);
1618 break;
1619 case O_WRITE:
1620 if (maxarg == 0)
1621 stab = defoutstab;
1622 else if (arg[1].arg_type == A_LVAL)
1623 stab = arg[1].arg_ptr.arg_stab;
1624 else
1625 stab = stabent(str_get(sarg[1]),TRUE);
1626 if (!stab->stab_io) {
1627 str_set(str, No);
1628 STABSET(str);
1629 break;
1630 }
1631 curoutstab = stab;
1632 fp = stab->stab_io->fp;
1633 debarg = arg;
1634 if (stab->stab_io->fmt_stab)
1635 form = stab->stab_io->fmt_stab->stab_form;
1636 else
1637 form = stab->stab_form;
1638 if (!form || !fp) {
1639 str_set(str, No);
1640 STABSET(str);
1641 break;
1642 }
1643 format(&outrec,form);
1644 do_write(&outrec,stab->stab_io);
1645 if (stab->stab_io->flags & IOF_FLUSH)
1646 fflush(fp);
1647 str_set(str, Yes);
1648 STABSET(str);
1649 break;
1650 case O_OPEN:
1651 if (do_open(arg[1].arg_ptr.arg_stab,str_get(sarg[2]))) {
1652 str_set(str, Yes);
1653 arg[1].arg_ptr.arg_stab->stab_io->lines = 0;
1654 }
1655 else
1656 str_set(str, No);
1657 STABSET(str);
1658 break;
1659 case O_TRANS:
1660 value = (double) do_trans(str,arg);
1661 str = arg->arg_ptr.arg_str;
1662 goto donumset;
1663 case O_NTRANS:
1664 str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
1665 str = arg->arg_ptr.arg_str;
1666 break;
1667 case O_CLOSE:
1668 str_set(str,
1669 do_close(arg[1].arg_ptr.arg_stab,TRUE) ? Yes : No );
1670 STABSET(str);
1671 break;
1672 case O_EACH:
1673 str_sset(str,do_each(arg[1].arg_ptr.arg_stab->stab_hash,sarg,retary));
1674 retary = Null(STR***); /* do_each already did retary */
1675 STABSET(str);
1676 break;
1677 case O_VALUES:
1678 case O_KEYS:
1679 value = (double) do_kv(arg[1].arg_ptr.arg_stab->stab_hash,
1680 optype,sarg,retary);
1681 retary = Null(STR***); /* do_keys already did retary */
1682 goto donumset;
1683 case O_ARRAY:
1684 if (maxarg == 1) {
1685 ary = arg[1].arg_ptr.arg_stab->stab_array;
1686 maxarg = ary->ary_fill;
1687 if (retary) { /* array wanted */
1688 sarg =
1689 (STR **)saferealloc((char*)sarg,(maxarg+3)*sizeof(STR*));
1690 for (anum = 0; anum <= maxarg; anum++) {
1691 sarg[anum+1] = str = afetch(ary,anum);
1692 }
1693 maxarg++;
1694 }
1695 else
1696 str = afetch(ary,maxarg);
1697 }
1698 else
1699 str = afetch(arg[2].arg_ptr.arg_stab->stab_array,
1700 ((int)str_gnum(sarg[1])) - arybase);
1701 if (!str)
1702 return &str_no;
1703 break;
1704 case O_HASH:
1705 tmpstab = arg[2].arg_ptr.arg_stab; /* XXX */
1706 str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
1707 if (!str)
1708 return &str_no;
1709 break;
1710 case O_LARRAY:
1711 anum = ((int)str_gnum(sarg[1])) - arybase;
1712 str = afetch(arg[2].arg_ptr.arg_stab->stab_array,anum);
1713 if (!str || str == &str_no) {
1714 str = str_new(0);
1715 astore(arg[2].arg_ptr.arg_stab->stab_array,anum,str);
1716 }
1717 break;
1718 case O_LHASH:
1719 tmpstab = arg[2].arg_ptr.arg_stab;
1720 str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
1721 if (!str) {
1722 str = str_new(0);
1723 hstore(tmpstab->stab_hash,str_get(sarg[1]),str);
1724 }
1725 if (tmpstab == envstab) { /* heavy wizardry going on here */
1726 str->str_link.str_magic = tmpstab;/* str is now magic */
1727 envname = savestr(str_get(sarg[1]));
1728 /* he threw the brick up into the air */
1729 }
1730 else if (tmpstab == sigstab) { /* same thing, only different */
1731 str->str_link.str_magic = tmpstab;
1732 signame = savestr(str_get(sarg[1]));
1733 }
1734 break;
1735 case O_PUSH:
1736 if (arg[1].arg_flags & AF_SPECIAL)
1737 str = do_push(arg,arg[2].arg_ptr.arg_stab->stab_array);
1738 else {
1739 str = str_new(0); /* must copy the STR */
1740 str_sset(str,sarg[1]);
1741 apush(arg[2].arg_ptr.arg_stab->stab_array,str);
1742 }
1743 break;
1744 case O_POP:
1745 str = apop(arg[1].arg_ptr.arg_stab->stab_array);
1746 if (!str)
1747 return &str_no;
1748#ifdef STRUCTCOPY
1749 *(arg->arg_ptr.arg_str) = *str;
1750#else
1751 bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
1752#endif
1753 safefree((char*)str);
1754 str = arg->arg_ptr.arg_str;
1755 break;
1756 case O_SHIFT:
1757 str = ashift(arg[1].arg_ptr.arg_stab->stab_array);
1758 if (!str)
1759 return &str_no;
1760#ifdef STRUCTCOPY
1761 *(arg->arg_ptr.arg_str) = *str;
1762#else
1763 bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
1764#endif
1765 safefree((char*)str);
1766 str = arg->arg_ptr.arg_str;
1767 break;
1768 case O_SPLIT:
1769 value = (double) do_split(str_get(sarg[1]),arg[2].arg_ptr.arg_spat,retary);
1770 retary = Null(STR***); /* do_split already did retary */
1771 goto donumset;
1772 case O_LENGTH:
1773 value = (double) str_len(sarg[1]);
1774 goto donumset;
1775 case O_SPRINTF:
1776 sarg[maxarg+1] = Nullstr;
1777 do_sprintf(str,arg->arg_len,sarg);
1778 break;
1779 case O_SUBSTR:
1780 anum = ((int)str_gnum(sarg[2])) - arybase;
1781 for (tmps = str_get(sarg[1]); *tmps && anum > 0; tmps++,anum--) ;
1782 anum = (int)str_gnum(sarg[3]);
1783 if (anum >= 0 && strlen(tmps) > anum)
1784 str_nset(str, tmps, anum);
1785 else
1786 str_set(str, tmps);
1787 break;
1788 case O_JOIN:
1789 if (arg[2].arg_flags & AF_SPECIAL && arg[2].arg_type == A_EXPR)
1790 do_join(arg,str_get(sarg[1]),str);
1791 else
1792 ajoin(arg[2].arg_ptr.arg_stab->stab_array,str_get(sarg[1]),str);
1793 break;
1794 case O_SLT:
1795 tmps = str_get(sarg[1]);
1796 value = (double) strLT(tmps,str_get(sarg[2]));
1797 goto donumset;
1798 case O_SGT:
1799 tmps = str_get(sarg[1]);
1800 value = (double) strGT(tmps,str_get(sarg[2]));
1801 goto donumset;
1802 case O_SLE:
1803 tmps = str_get(sarg[1]);
1804 value = (double) strLE(tmps,str_get(sarg[2]));
1805 goto donumset;
1806 case O_SGE:
1807 tmps = str_get(sarg[1]);
1808 value = (double) strGE(tmps,str_get(sarg[2]));
1809 goto donumset;
1810 case O_SEQ:
1811 tmps = str_get(sarg[1]);
1812 value = (double) strEQ(tmps,str_get(sarg[2]));
1813 goto donumset;
1814 case O_SNE:
1815 tmps = str_get(sarg[1]);
1816 value = (double) strNE(tmps,str_get(sarg[2]));
1817 goto donumset;
1818 case O_SUBR:
1819 str_sset(str,do_subr(arg,sarg));
1820 STABSET(str);
1821 break;
1822 case O_PRTF:
1823 case O_PRINT:
1824 if (maxarg <= 1)
1825 stab = defoutstab;
1826 else {
1827 stab = arg[2].arg_ptr.arg_stab;
1828 if (!stab)
1829 stab = defoutstab;
1830 }
1831 if (!stab->stab_io)
1832 value = 0.0;
1833 else if (arg[1].arg_flags & AF_SPECIAL)
1834 value = (double)do_aprint(arg,stab->stab_io->fp);
1835 else {
1836 value = (double)do_print(str_get(sarg[1]),stab->stab_io->fp);
1837 if (ors && optype == O_PRINT)
1838 do_print(ors, stab->stab_io->fp);
1839 }
1840 if (stab->stab_io->flags & IOF_FLUSH)
1841 fflush(stab->stab_io->fp);
1842 goto donumset;
1843 case O_CHDIR:
1844 tmps = str_get(sarg[1]);
1845 if (!tmps || !*tmps)
1846 tmps = getenv("HOME");
1847 if (!tmps || !*tmps)
1848 tmps = getenv("LOGDIR");
1849 value = (double)(chdir(tmps) >= 0);
1850 goto donumset;
1851 case O_DIE:
1852 tmps = str_get(sarg[1]);
1853 if (!tmps || !*tmps)
1854 exit(1);
1855 fatal("%s\n",str_get(sarg[1]));
1856 value = 0.0;
1857 goto donumset;
1858 case O_EXIT:
1859 exit((int)str_gnum(sarg[1]));
1860 value = 0.0;
1861 goto donumset;
1862 case O_RESET:
1863 str_reset(str_get(sarg[1]));
1864 value = 1.0;
1865 goto donumset;
1866 case O_LIST:
1867 if (maxarg > 0)
1868 str = sarg[maxarg]; /* unwanted list, return last item */
1869 else
1870 str = &str_no;
1871 break;
1872 case O_EOF:
1873 str_set(str, do_eof(maxarg > 0 ? arg[1].arg_ptr.arg_stab : last_in_stab) ? Yes : No);
1874 STABSET(str);
1875 break;
1876 case O_TELL:
1877 value = (double)do_tell(maxarg > 0 ? arg[1].arg_ptr.arg_stab : last_in_stab);
1878 goto donumset;
1879 break;
1880 case O_SEEK:
1881 value = str_gnum(sarg[2]);
1882 str_set(str, do_seek(arg[1].arg_ptr.arg_stab,
1883 (long)value, (int)str_gnum(sarg[3]) ) ? Yes : No);
1884 STABSET(str);
1885 break;
1886 case O_REDO:
1887 case O_NEXT:
1888 case O_LAST:
1889 if (maxarg > 0) {
1890 tmps = str_get(sarg[1]);
1891 while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
1892 strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
1893#ifdef DEBUGGING
1894 if (debug & 4) {
1895 deb("(Skipping label #%d %s)\n",loop_ptr,
1896 loop_stack[loop_ptr].loop_label);
1897 }
1898#endif
1899 loop_ptr--;
1900 }
1901#ifdef DEBUGGING
1902 if (debug & 4) {
1903 deb("(Found label #%d %s)\n",loop_ptr,
1904 loop_stack[loop_ptr].loop_label);
1905 }
1906#endif
1907 }
1908 if (loop_ptr < 0)
1909 fatal("Bad label: %s\n", maxarg > 0 ? tmps : "<null>");
1910 longjmp(loop_stack[loop_ptr].loop_env, optype);
1911 case O_GOTO:/* shudder */
1912 goto_targ = str_get(sarg[1]);
1913 longjmp(top_env, 1);
1914 case O_INDEX:
1915 tmps = str_get(sarg[1]);
1916 if (!(tmps2 = instr(tmps,str_get(sarg[2]))))
1917 value = (double)(-1 + arybase);
1918 else
1919 value = (double)(tmps2 - tmps + arybase);
1920 goto donumset;
1921 case O_TIME:
1922 value = (double) time(0);
1923 goto donumset;
1924 case O_TMS:
1925 value = (double) do_tms(retary);
1926 retary = Null(STR***); /* do_tms already did retary */
1927 goto donumset;
1928 case O_LOCALTIME:
1929 tmplong = (long) str_gnum(sarg[1]);
1930 value = (double) do_time(localtime(&tmplong),retary);
1931 retary = Null(STR***); /* do_localtime already did retary */
1932 goto donumset;
1933 case O_GMTIME:
1934 tmplong = (long) str_gnum(sarg[1]);
1935 value = (double) do_time(gmtime(&tmplong),retary);
1936 retary = Null(STR***); /* do_gmtime already did retary */
1937 goto donumset;
1938 case O_STAT:
1939 value = (double) do_stat(arg,sarg,retary);
1940 retary = Null(STR***); /* do_stat already did retary */
1941 goto donumset;
1942 case O_CRYPT:
1943 tmps = str_get(sarg[1]);
1944 str_set(str,crypt(tmps,str_get(sarg[2])));
1945 break;
1946 case O_EXP:
1947 value = exp(str_gnum(sarg[1]));
1948 goto donumset;
1949 case O_LOG:
1950 value = log(str_gnum(sarg[1]));
1951 goto donumset;
1952 case O_SQRT:
1953 value = sqrt(str_gnum(sarg[1]));
1954 goto donumset;
1955 case O_INT:
1956 modf(str_gnum(sarg[1]),&value);
1957 goto donumset;
1958 case O_ORD:
1959 value = (double) *str_get(sarg[1]);
1960 goto donumset;
1961 case O_SLEEP:
1962 tmps = str_get(sarg[1]);
1963 time(&tmplong);
1964 if (!tmps || !*tmps)
1965 sleep((32767<<16)+32767);
1966 else
1967 sleep(atoi(tmps));
1968 value = (double)tmplong;
1969 time(&tmplong);
1970 value = ((double)tmplong) - value;
1971 goto donumset;
1972 case O_FLIP:
1973 if (str_true(sarg[1])) {
1974 str_numset(str,0.0);
1975 anum = 2;
1976 arg->arg_type = optype = O_FLOP;
1977 maxarg = 0;
1978 arg[2].arg_flags &= ~AF_SPECIAL;
1979 arg[1].arg_flags |= AF_SPECIAL;
1980 argflags = arg[anum].arg_flags;
1981 goto re_eval;
1982 }
1983 str_set(str,"");
1984 break;
1985 case O_FLOP:
1986 str_inc(str);
1987 if (str_true(sarg[2])) {
1988 arg->arg_type = O_FLIP;
1989 arg[1].arg_flags &= ~AF_SPECIAL;
1990 arg[2].arg_flags |= AF_SPECIAL;
1991 str_cat(str,"E0");
1992 }
1993 break;
1994 case O_FORK:
1995 value = (double)fork();
1996 goto donumset;
1997 case O_SYSTEM:
1998 if (anum = vfork()) {
1999 ihand = signal(SIGINT, SIG_IGN);
2000 qhand = signal(SIGQUIT, SIG_IGN);
2001 while ((maxarg = wait(&argflags)) != anum && maxarg != -1)
2002 ;
2003 if (maxarg == -1)
2004 argflags = -1;
2005 signal(SIGINT, ihand);
2006 signal(SIGQUIT, qhand);
2007 value = (double)argflags;
2008 goto donumset;
2009 }
2010 /* FALL THROUGH */
2011 case O_EXEC:
2012 if (arg[1].arg_flags & AF_SPECIAL)
2013 value = (double)do_aexec(arg);
2014 else {
2015 value = (double)do_exec(str_get(sarg[1]));
2016 }
2017 goto donumset;
2018 case O_HEX:
2019 maxarg = 4;
2020 goto snarfnum;
2021
2022 case O_OCT:
2023 maxarg = 3;
2024
2025 snarfnum:
2026 anum = 0;
2027 tmps = str_get(sarg[1]);
2028 for (;;) {
2029 switch (*tmps) {
2030 default:
2031 goto out;
2032 case '8': case '9':
2033 if (maxarg != 4)
2034 goto out;
2035 /* FALL THROUGH */
2036 case '0': case '1': case '2': case '3': case '4':
2037 case '5': case '6': case '7':
2038 anum <<= maxarg;
2039 anum += *tmps++ & 15;
2040 break;
2041 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
2042 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
2043 if (maxarg != 4)
2044 goto out;
2045 anum <<= 4;
2046 anum += (*tmps++ & 7) + 9;
2047 break;
2048 case 'x':
2049 maxarg = 4;
2050 tmps++;
2051 break;
2052 }
2053 }
2054 out:
2055 value = (double)anum;
2056 goto donumset;
2057 case O_CHMOD:
2058 case O_CHOWN:
2059 case O_KILL:
2060 case O_UNLINK:
2061 if (arg[1].arg_flags & AF_SPECIAL)
2062 value = (double)apply(optype,arg,Null(STR**));
2063 else {
2064 sarg[2] = Nullstr;
2065 value = (double)apply(optype,arg,sarg);
2066 }
2067 goto donumset;
2068 case O_UMASK:
2069 value = (double)umask((int)str_gnum(sarg[1]));
2070 goto donumset;
2071 case O_RENAME:
2072 tmps = str_get(sarg[1]);
2073#ifdef RENAME
2074 value = (double)(rename(tmps,str_get(sarg[2])) >= 0);
2075#else
2076 tmps2 = str_get(sarg[2]);
2077 UNLINK(tmps2);
2078 if (!(anum = link(tmps,tmps2)))
2079 anum = UNLINK(tmps);
2080 value = (double)(anum >= 0);
2081#endif
2082 goto donumset;
2083 case O_LINK:
2084 tmps = str_get(sarg[1]);
2085 value = (double)(link(tmps,str_get(sarg[2])) >= 0);
2086 goto donumset;
2087 case O_UNSHIFT:
2088 ary = arg[2].arg_ptr.arg_stab->stab_array;
2089 if (arg[1].arg_flags & AF_SPECIAL)
2090 do_unshift(arg,ary);
2091 else {
2092 str = str_new(0); /* must copy the STR */
2093 str_sset(str,sarg[1]);
2094 aunshift(ary,1);
2095 astore(ary,0,str);
2096 }
2097 value = (double)(ary->ary_fill + 1);
2098 break;
a559c259 2099 case O_EVAL:
2100 str_sset(str,
2101 do_eval(arg[1].arg_type != A_NULL ? sarg[1] : defstab->stab_val) );
2102 STABSET(str);
2103 break;
8d063cd8 2104 }
2105#ifdef DEBUGGING
2106 dlevel--;
2107 if (debug & 8)
2108 deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
2109#endif
2110 goto freeargs;
2111
2112donumset:
2113 str_numset(str,value);
2114 STABSET(str);
2115#ifdef DEBUGGING
2116 dlevel--;
2117 if (debug & 8)
2118 deb("%s RETURNS \"%f\"\n",opname[optype],value);
2119#endif
2120
2121freeargs:
2122 if (sarg != quicksarg) {
2123 if (retary) {
2124 if (optype == O_LIST)
2125 sarg[0] = &str_no;
2126 else
2127 sarg[0] = Nullstr;
2128 sarg[maxarg+1] = Nullstr;
2129 *retary = sarg; /* up to them to free it */
2130 }
2131 else
2132 safefree(sarg);
2133 }
2134 return str;
2135
2136nullarray:
2137 maxarg = 0;
2138#ifdef DEBUGGING
2139 dlevel--;
2140 if (debug & 8)
2141 deb("%s RETURNS ()\n",opname[optype],value);
2142#endif
2143 goto freeargs;
2144}