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