perl 1.0 patch 2: Various portability fixes.
[p5sagit/p5-mst-13.2.git] / arg.c
CommitLineData
135863df 1/* $Header: arg.c,v 1.0.1.2 88/01/24 03:52:34 root Exp $
8d063cd8 2 *
3 * $Log: arg.c,v $
135863df 4 * Revision 1.0.1.2 88/01/24 03:52:34 root
5 * patch 2: added STATBLKS dependencies.
6 *
36ce8bec 7 * Revision 1.0.1.1 88/01/21 21:27:10 root
8 * Now defines signal return values correctly using VOIDSIG.
9 *
8d063cd8 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
22ARG *debarg;
23
24bool
25do_match(s,arg)
26register char *s;
27register 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
100int
101do_subst(str,arg)
102STR *str;
103register 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
166int
167do_trans(str,arg)
168STR *str;
169register 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
196int
197do_split(s,spat,retary)
198register char *s;
199register SPAT *spat;
200STR ***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
267void
268do_join(arg,delim,str)
269register ARG *arg;
270register char *delim;
271register 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
288bool
289do_open(stab,name)
290STAB *stab;
291register 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
372FILE *
373nextargv(stab)
374register 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
414bool
415do_close(stab,explicit)
416STAB *stab;
417bool 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
439bool
440do_eof(stab)
441STAB *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
475long
476do_tell(stab)
477STAB *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
492bool
493do_seek(stab, pos, whence)
494STAB *stab;
495long pos;
496int 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
510do_stat(arg,sarg,retary)
511register ARG *arg;
512register STR **sarg;
513STR ***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));
135863df 548#ifdef STATBLOCKS
8d063cd8 549 apush(ary,str_nmake((double)statbuf.st_blksize));
550 apush(ary,str_nmake((double)statbuf.st_blocks));
135863df 551#else
552 apush(ary,str_make("");
553 apush(ary,str_make("");
554#endif
8d063cd8 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
566do_tms(retary)
567STR ***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
599do_time(tmbuf,retary)
600struct tm *tmbuf;
601STR ***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
639void
640do_sprintf(str,len,sarg)
641register STR *str;
642register int len;
643register 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
708bool
709do_print(s,fp)
710char *s;
711FILE *fp;
712{
713 if (!fp || !s)
714 return FALSE;
715 fputs(s,fp);
716 return TRUE;
717}
718
719bool
720do_aprint(arg,fp)
721register ARG *arg;
722register 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
756bool
757do_aexec(arg)
758register 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
784bool
785do_exec(cmd)
786char *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
819STR *
820do_push(arg,ary)
821register ARG *arg;
822register 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
838do_unshift(arg,ary)
839register ARG *arg;
840register 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
861apply(type,arg,sarg)
862int type;
863register ARG *arg;
864STR **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
921STR *
922do_subr(arg,sarg)
923register ARG *arg;
924register 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
944void
945do_assign(retstr,arg)
946STR *retstr;
947register 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
1003int
1004do_kv(hash,kv,sarg,retary)
1005HASH *hash;
1006int kv;
1007register STR **sarg;
1008STR ***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
1040STR *
1041do_each(hash,sarg,retary)
1042HASH *hash;
1043register STR **sarg;
1044STR ***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
1077init_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
36ce8bec 1187#ifdef VOIDSIG
1188static void (*ihand)();
1189static void (*qhand)();
1190#else
8d063cd8 1191static int (*ihand)();
1192static int (*qhand)();
36ce8bec 1193#endif
8d063cd8 1194
1195STR *
1196eval(arg,retary)
1197register ARG *arg;
1198STR ***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
2095donumset:
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
2104freeargs:
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
2119nullarray:
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}