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