perl 3.0 patch #7 (combined patch)
[perl.git] / eval.c
1 /* $Header: eval.c,v 3.0.1.2 89/11/17 15:19:34 lwall Locked $
2  *
3  *    Copyright (c) 1989, Larry Wall
4  *
5  *    You may distribute under the terms of the GNU General Public License
6  *    as specified in the README file that comes with the perl 3.0 kit.
7  *
8  * $Log:        eval.c,v $
9  * Revision 3.0.1.2  89/11/17  15:19:34  lwall
10  * patch5: simplified a too-complex expression for some machine or other
11  * 
12  * Revision 3.0.1.1  89/11/11  04:31:51  lwall
13  * patch2: mkdir and rmdir needed to quote argument when passed to shell
14  * patch2: mkdir and rmdir now return better error codes
15  * patch2: fileno, seekdir, rewinddir and closedir now disallow defaults
16  * 
17  * Revision 3.0  89/10/18  15:17:04  lwall
18  * 3.0 baseline
19  * 
20  */
21
22 #include "EXTERN.h"
23 #include "perl.h"
24
25 #include <signal.h>
26 #include <errno.h>
27
28 #ifdef I_VFORK
29 #   include <vfork.h>
30 #endif
31
32 extern int errno;
33
34 #ifdef VOIDSIG
35 static void (*ihand)();
36 static void (*qhand)();
37 #else
38 static int (*ihand)();
39 static int (*qhand)();
40 #endif
41
42 ARG *debarg;
43 STR str_args;
44 static STAB *stab2;
45 static STIO *stio;
46 static struct lstring *lstr;
47 static char old_record_separator;
48
49 double sin(), cos(), atan2(), pow();
50
51 char *getlogin();
52
53 extern int sys_nerr;
54 extern char *sys_errlist[];
55
56 int
57 eval(arg,gimme,sp)
58 register ARG *arg;
59 int gimme;
60 register int sp;
61 {
62     register STR *str;
63     register int anum;
64     register int optype;
65     register STR **st;
66     int maxarg;
67     double value;
68     register char *tmps;
69     char *tmps2;
70     int argflags;
71     int argtype;
72     union argptr argptr;
73     int arglast[8];     /* highest sp for arg--valid only for non-O_LIST args */
74     unsigned long tmplong;
75     long when;
76     FILE *fp;
77     STR *tmpstr;
78     FCMD *form;
79     STAB *stab;
80     ARRAY *ary;
81     bool assigning = FALSE;
82     double exp(), log(), sqrt(), modf();
83     char *crypt(), *getenv();
84     extern void grow_dlevel();
85
86     if (!arg)
87         goto say_undef;
88     optype = arg->arg_type;
89     maxarg = arg->arg_len;
90     arglast[0] = sp;
91     str = arg->arg_ptr.arg_str;
92     if (sp + maxarg > stack->ary_max)
93         astore(stack, sp + maxarg, Nullstr);
94     st = stack->ary_array;
95
96 #ifdef DEBUGGING
97     if (debug) {
98         if (debug & 8) {
99             deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
100         }
101         debname[dlevel] = opname[optype][0];
102         debdelim[dlevel] = ':';
103         if (++dlevel >= dlmax)
104             grow_dlevel();
105     }
106 #endif
107
108 #include "evalargs.xc"
109
110     st += arglast[0];
111     switch (optype) {
112     case O_RCAT:
113         STABSET(str);
114         break;
115     case O_ITEM:
116         if (gimme == G_ARRAY)
117             goto array_return;
118         STR_SSET(str,st[1]);
119         STABSET(str);
120         break;
121     case O_ITEM2:
122         if (gimme == G_ARRAY)
123             goto array_return;
124         --anum;
125         STR_SSET(str,st[arglast[anum]-arglast[0]]);
126         STABSET(str);
127         break;
128     case O_ITEM3:
129         if (gimme == G_ARRAY)
130         goto array_return;
131         --anum;
132         STR_SSET(str,st[arglast[anum]-arglast[0]]);
133         STABSET(str);
134         break;
135     case O_CONCAT:
136         STR_SSET(str,st[1]);
137         str_scat(str,st[2]);
138         STABSET(str);
139         break;
140     case O_REPEAT:
141         STR_SSET(str,st[1]);
142         anum = (int)str_gnum(st[2]);
143         if (anum >= 1) {
144             tmpstr = Str_new(50,0);
145             str_sset(tmpstr,str);
146             while (--anum > 0)
147                 str_scat(str,tmpstr);
148         }
149         else
150             str_sset(str,&str_no);
151         STABSET(str);
152         break;
153     case O_MATCH:
154         sp = do_match(str,arg,
155           gimme,arglast);
156         if (gimme == G_ARRAY)
157             goto array_return;
158         STABSET(str);
159         break;
160     case O_NMATCH:
161         sp = do_match(str,arg,
162           gimme,arglast);
163         if (gimme == G_ARRAY)
164             goto array_return;
165         str_sset(str, str_true(str) ? &str_no : &str_yes);
166         STABSET(str);
167         break;
168     case O_SUBST:
169         sp = do_subst(str,arg,arglast[0]);
170         goto array_return;
171     case O_NSUBST:
172         sp = do_subst(str,arg,arglast[0]);
173         str = arg->arg_ptr.arg_str;
174         str_set(str, str_true(str) ? No : Yes);
175         goto array_return;
176     case O_ASSIGN:
177         if (arg[1].arg_flags & AF_ARYOK) {
178             if (arg->arg_len == 1) {
179                 arg->arg_type = O_LOCAL;
180                 goto local;
181             }
182             else {
183                 arg->arg_type = O_AASSIGN;
184                 goto aassign;
185             }
186         }
187         else {
188             arg->arg_type = O_SASSIGN;
189             goto sassign;
190         }
191     case O_LOCAL:
192       local:
193         arglast[2] = arglast[1];        /* push a null array */
194         /* FALL THROUGH */
195     case O_AASSIGN:
196       aassign:
197         sp = do_assign(arg,
198           gimme,arglast);
199         goto array_return;
200     case O_SASSIGN:
201       sassign:
202         STR_SSET(str, st[2]);
203         STABSET(str);
204         break;
205     case O_CHOP:
206         st -= arglast[0];
207         str = arg->arg_ptr.arg_str;
208         for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
209             do_chop(str,st[sp]);
210         st += arglast[0];
211         break;
212     case O_DEFINED:
213         if (arg[1].arg_type & A_DONT) {
214             sp = do_defined(str,arg,
215                   gimme,arglast);
216             goto array_return;
217         }
218         else if (str->str_pok || str->str_nok)
219             goto say_yes;
220         goto say_no;
221     case O_UNDEF:
222         if (arg[1].arg_type & A_DONT) {
223             sp = do_undef(str,arg,
224               gimme,arglast);
225             goto array_return;
226         }
227         else if (str != stab_val(defstab)) {
228             str->str_pok = str->str_nok = 0;
229             STABSET(str);
230         }
231         goto say_undef;
232     case O_STUDY:
233         sp = do_study(str,arg,
234           gimme,arglast);
235         goto array_return;
236     case O_POW:
237         value = str_gnum(st[1]);
238         value = pow(value,str_gnum(st[2]));
239         goto donumset;
240     case O_MULTIPLY:
241         value = str_gnum(st[1]);
242         value *= str_gnum(st[2]);
243         goto donumset;
244     case O_DIVIDE:
245         if ((value = str_gnum(st[2])) == 0.0)
246             fatal("Illegal division by zero");
247         value = str_gnum(st[1]) / value;
248         goto donumset;
249     case O_MODULO:
250         tmplong = (long) str_gnum(st[2]);
251         if (tmplong == 0L)
252             fatal("Illegal modulus zero");
253         when = (long)str_gnum(st[1]);
254 #ifndef lint
255         if (when >= 0)
256             value = (double)(when % tmplong);
257         else
258             value = (double)(tmplong - (-when % tmplong));
259 #endif
260         goto donumset;
261     case O_ADD:
262         value = str_gnum(st[1]);
263         value += str_gnum(st[2]);
264         goto donumset;
265     case O_SUBTRACT:
266         value = str_gnum(st[1]);
267         value -= str_gnum(st[2]);
268         goto donumset;
269     case O_LEFT_SHIFT:
270         value = str_gnum(st[1]);
271         anum = (int)str_gnum(st[2]);
272 #ifndef lint
273         value = (double)(((long)value) << anum);
274 #endif
275         goto donumset;
276     case O_RIGHT_SHIFT:
277         value = str_gnum(st[1]);
278         anum = (int)str_gnum(st[2]);
279 #ifndef lint
280         value = (double)(((long)value) >> anum);
281 #endif
282         goto donumset;
283     case O_LT:
284         value = str_gnum(st[1]);
285         value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
286         goto donumset;
287     case O_GT:
288         value = str_gnum(st[1]);
289         value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
290         goto donumset;
291     case O_LE:
292         value = str_gnum(st[1]);
293         value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
294         goto donumset;
295     case O_GE:
296         value = str_gnum(st[1]);
297         value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
298         goto donumset;
299     case O_EQ:
300         if (dowarn) {
301             if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
302                 (!st[2]->str_nok && !looks_like_number(st[2])) )
303                 warn("Possible use of == on string value");
304         }
305         value = str_gnum(st[1]);
306         value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
307         goto donumset;
308     case O_NE:
309         value = str_gnum(st[1]);
310         value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
311         goto donumset;
312     case O_BIT_AND:
313         if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
314             value = str_gnum(st[1]);
315 #ifndef lint
316             value = (double)(((long)value) & (long)str_gnum(st[2]));
317 #endif
318             goto donumset;
319         }
320         else
321             do_vop(optype,str,st[1],st[2]);
322         break;
323     case O_XOR:
324         if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
325             value = str_gnum(st[1]);
326 #ifndef lint
327             value = (double)(((long)value) ^ (long)str_gnum(st[2]));
328 #endif
329             goto donumset;
330         }
331         else
332             do_vop(optype,str,st[1],st[2]);
333         break;
334     case O_BIT_OR:
335         if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
336             value = str_gnum(st[1]);
337 #ifndef lint
338             value = (double)(((long)value) | (long)str_gnum(st[2]));
339 #endif
340             goto donumset;
341         }
342         else
343             do_vop(optype,str,st[1],st[2]);
344         break;
345 /* use register in evaluating str_true() */
346     case O_AND:
347         if (str_true(st[1])) {
348             anum = 2;
349             optype = O_ITEM2;
350             argflags = arg[anum].arg_flags;
351             if (gimme == G_ARRAY)
352                 argflags |= AF_ARYOK;
353             argtype = arg[anum].arg_type & A_MASK;
354             argptr = arg[anum].arg_ptr;
355             maxarg = anum = 1;
356             sp = arglast[0];
357             st -= sp;
358             goto re_eval;
359         }
360         else {
361             if (assigning) {
362                 str_sset(str, st[1]);
363                 STABSET(str);
364             }
365             else
366                 str = st[1];
367             break;
368         }
369     case O_OR:
370         if (str_true(st[1])) {
371             if (assigning) {
372                 str_sset(str, st[1]);
373                 STABSET(str);
374             }
375             else
376                 str = st[1];
377             break;
378         }
379         else {
380             anum = 2;
381             optype = O_ITEM2;
382             argflags = arg[anum].arg_flags;
383             if (gimme == G_ARRAY)
384                 argflags |= AF_ARYOK;
385             argtype = arg[anum].arg_type & A_MASK;
386             argptr = arg[anum].arg_ptr;
387             maxarg = anum = 1;
388             sp = arglast[0];
389             st -= sp;
390             goto re_eval;
391         }
392     case O_COND_EXPR:
393         anum = (str_true(st[1]) ? 2 : 3);
394         optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
395         argflags = arg[anum].arg_flags;
396         if (gimme == G_ARRAY)
397             argflags |= AF_ARYOK;
398         argtype = arg[anum].arg_type & A_MASK;
399         argptr = arg[anum].arg_ptr;
400         maxarg = anum = 1;
401         sp = arglast[0];
402         st -= sp;
403         goto re_eval;
404     case O_COMMA:
405         if (gimme == G_ARRAY)
406             goto array_return;
407         str = st[2];
408         break;
409     case O_NEGATE:
410         value = -str_gnum(st[1]);
411         goto donumset;
412     case O_NOT:
413         value = (double) !str_true(st[1]);
414         goto donumset;
415     case O_COMPLEMENT:
416 #ifndef lint
417         value = (double) ~(long)str_gnum(st[1]);
418 #endif
419         goto donumset;
420     case O_SELECT:
421         tmps = stab_name(defoutstab);
422         if (maxarg > 0) {
423             if ((arg[1].arg_type & A_MASK) == A_WORD)
424                 defoutstab = arg[1].arg_ptr.arg_stab;
425             else
426                 defoutstab = stabent(str_get(st[1]),TRUE);
427             if (!stab_io(defoutstab))
428                 stab_io(defoutstab) = stio_new();
429             curoutstab = defoutstab;
430         }
431         str_set(str, tmps);
432         STABSET(str);
433         break;
434     case O_WRITE:
435         if (maxarg == 0)
436             stab = defoutstab;
437         else if ((arg[1].arg_type & A_MASK) == A_WORD) {
438             if (!(stab = arg[1].arg_ptr.arg_stab))
439                 stab = defoutstab;
440         }
441         else
442             stab = stabent(str_get(st[1]),TRUE);
443         if (!stab_io(stab)) {
444             str_set(str, No);
445             STABSET(str);
446             break;
447         }
448         curoutstab = stab;
449         fp = stab_io(stab)->ofp;
450         debarg = arg;
451         if (stab_io(stab)->fmt_stab)
452             form = stab_form(stab_io(stab)->fmt_stab);
453         else
454             form = stab_form(stab);
455         if (!form || !fp) {
456             if (dowarn) {
457                 if (form)
458                     warn("No format for filehandle");
459                 else {
460                     if (stab_io(stab)->ifp)
461                         warn("Filehandle only opened for input");
462                     else
463                         warn("Write on closed filehandle");
464                 }
465             }
466             str_set(str, No);
467             STABSET(str);
468             break;
469         }
470         format(&outrec,form,sp);
471         do_write(&outrec,stab_io(stab),sp);
472         if (stab_io(stab)->flags & IOF_FLUSH)
473             (void)fflush(fp);
474         str_set(str, Yes);
475         STABSET(str);
476         break;
477     case O_DBMOPEN:
478 #ifdef SOME_DBM
479         if ((arg[1].arg_type & A_MASK) == A_WORD)
480             stab = arg[1].arg_ptr.arg_stab;
481         else
482             stab = stabent(str_get(st[1]),TRUE);
483         anum = (int)str_gnum(st[3]);
484         value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
485         goto donumset;
486 #else
487         fatal("No dbm or ndbm on this machine");
488 #endif
489     case O_DBMCLOSE:
490 #ifdef SOME_DBM
491         if ((arg[1].arg_type & A_MASK) == A_WORD)
492             stab = arg[1].arg_ptr.arg_stab;
493         else
494             stab = stabent(str_get(st[1]),TRUE);
495         hdbmclose(stab_hash(stab));
496         goto say_yes;
497 #else
498         fatal("No dbm or ndbm on this machine");
499 #endif
500     case O_OPEN:
501         if ((arg[1].arg_type & A_MASK) == A_WORD)
502             stab = arg[1].arg_ptr.arg_stab;
503         else
504             stab = stabent(str_get(st[1]),TRUE);
505         if (do_open(stab,str_get(st[2]))) {
506             value = (double)forkprocess;
507             stab_io(stab)->lines = 0;
508             goto donumset;
509         }
510         else
511             goto say_undef;
512         break;
513     case O_TRANS:
514         value = (double) do_trans(str,arg);
515         str = arg->arg_ptr.arg_str;
516         goto donumset;
517     case O_NTRANS:
518         str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
519         str = arg->arg_ptr.arg_str;
520         break;
521     case O_CLOSE:
522         if (maxarg == 0)
523             stab = defoutstab;
524         else if ((arg[1].arg_type & A_MASK) == A_WORD)
525             stab = arg[1].arg_ptr.arg_stab;
526         else
527             stab = stabent(str_get(st[1]),TRUE);
528         str_set(str, do_close(stab,TRUE) ? Yes : No );
529         STABSET(str);
530         break;
531     case O_EACH:
532         sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
533           gimme,arglast);
534         goto array_return;
535     case O_VALUES:
536     case O_KEYS:
537         sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
538           gimme,arglast);
539         goto array_return;
540     case O_LARRAY:
541         str->str_nok = str->str_pok = 0;
542         str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
543         str->str_state = SS_ARY;
544         break;
545     case O_ARRAY:
546         ary = stab_array(arg[1].arg_ptr.arg_stab);
547         maxarg = ary->ary_fill + 1;
548         if (gimme == G_ARRAY) { /* array wanted */
549             sp = arglast[0];
550             st -= sp;
551             if (maxarg > 0 && sp + maxarg > stack->ary_max) {
552                 astore(stack,sp + maxarg, Nullstr);
553                 st = stack->ary_array;
554             }
555             Copy(ary->ary_array, &st[sp+1], maxarg, STR*);
556             sp += maxarg;
557             goto array_return;
558         }
559         else
560             str = afetch(ary,maxarg - 1,FALSE);
561         break;
562     case O_AELEM:
563         anum = ((int)str_gnum(st[2])) - arybase;
564         str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
565         if (!str)
566             goto say_undef;
567         break;
568     case O_DELETE:
569         tmpstab = arg[1].arg_ptr.arg_stab;
570         tmps = str_get(st[2]);
571         str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
572         if (tmpstab == envstab)
573             setenv(tmps,Nullch);
574         if (!str)
575             goto say_undef;
576         break;
577     case O_LHASH:
578         str->str_nok = str->str_pok = 0;
579         str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
580         str->str_state = SS_HASH;
581         break;
582     case O_HASH:
583         if (gimme == G_ARRAY) { /* array wanted */
584             sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
585                 gimme,arglast);
586             goto array_return;
587         }
588         else {
589             tmpstab = arg[1].arg_ptr.arg_stab;
590             sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
591                 stab_hash(tmpstab)->tbl_max+1);
592             str_set(str,buf);
593         }
594         break;
595     case O_HELEM:
596         tmpstab = arg[1].arg_ptr.arg_stab;
597         tmps = str_get(st[2]);
598         str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
599         if (!str)
600             goto say_undef;
601         break;
602     case O_LAELEM:
603         anum = ((int)str_gnum(st[2])) - arybase;
604         str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
605         if (!str)
606             fatal("Assignment to non-creatable value, subscript %d",anum);
607         break;
608     case O_LHELEM:
609         tmpstab = arg[1].arg_ptr.arg_stab;
610         tmps = str_get(st[2]);
611         anum = st[2]->str_cur;
612         str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
613         if (!str)
614             fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
615         if (tmpstab == envstab)         /* heavy wizardry going on here */
616             str_magic(str, tmpstab, 'E', tmps, anum);   /* str is now magic */
617                                         /* he threw the brick up into the air */
618         else if (tmpstab == sigstab)
619             str_magic(str, tmpstab, 'S', tmps, anum);
620 #ifdef SOME_DBM
621         else if (stab_hash(tmpstab)->tbl_dbm)
622             str_magic(str, tmpstab, 'D', tmps, anum);
623 #endif
624         break;
625     case O_ASLICE:
626         anum = TRUE;
627         argtype = FALSE;
628         goto do_slice_already;
629     case O_HSLICE:
630         anum = FALSE;
631         argtype = FALSE;
632         goto do_slice_already;
633     case O_LASLICE:
634         anum = TRUE;
635         argtype = TRUE;
636         goto do_slice_already;
637     case O_LHSLICE:
638         anum = FALSE;
639         argtype = TRUE;
640       do_slice_already:
641         sp = do_slice(arg[1].arg_ptr.arg_stab,anum,argtype,
642             gimme,arglast);
643         goto array_return;
644     case O_PUSH:
645         if (arglast[2] - arglast[1] != 1)
646             str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
647         else {
648             str = Str_new(51,0);                /* must copy the STR */
649             str_sset(str,st[2]);
650             (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
651         }
652         break;
653     case O_POP:
654         str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
655         goto staticalization;
656     case O_SHIFT:
657         str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
658       staticalization:
659         if (!str)
660             goto say_undef;
661         if (ary->ary_flags & ARF_REAL)
662             (void)str_2static(str);
663         break;
664     case O_UNPACK:
665         sp = do_unpack(str,gimme,arglast);
666         goto array_return;
667     case O_SPLIT:
668         value = str_gnum(st[3]);
669         sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
670           gimme,arglast);
671         goto array_return;
672     case O_LENGTH:
673         if (maxarg < 1)
674             value = (double)str_len(stab_val(defstab));
675         else
676             value = (double)str_len(st[1]);
677         goto donumset;
678     case O_SPRINTF:
679         do_sprintf(str, sp-arglast[0], st+1);
680         break;
681     case O_SUBSTR:
682         anum = ((int)str_gnum(st[2])) - arybase;        /* anum=where to start*/
683         tmps = str_get(st[1]);          /* force conversion to string */
684         if (argtype = (str == st[1]))
685             str = arg->arg_ptr.arg_str;
686         if (anum < 0)
687             anum += st[1]->str_cur + arybase;
688         if (anum < 0 || anum > st[1]->str_cur)
689             str_nset(str,"",0);
690         else {
691             optype = (int)str_gnum(st[3]);
692             if (optype < 0)
693                 optype = 0;
694             tmps += anum;
695             anum = st[1]->str_cur - anum;       /* anum=how many bytes left*/
696             if (anum > optype)
697                 anum = optype;
698             str_nset(str, tmps, anum);
699             if (argtype) {                      /* it's an lvalue! */
700                 lstr = (struct lstring*)str;
701                 str->str_magic = st[1];
702                 st[1]->str_rare = 's';
703                 lstr->lstr_offset = tmps - str_get(st[1]); 
704                 lstr->lstr_len = anum; 
705             }
706         }
707         break;
708     case O_PACK:
709         (void)do_pack(str,arglast);
710         break;
711     case O_GREP:
712         sp = do_grep(arg,str,gimme,arglast);
713         goto array_return;
714     case O_JOIN:
715         do_join(str,arglast);
716         break;
717     case O_SLT:
718         tmps = str_get(st[1]);
719         value = (double) (str_cmp(st[1],st[2]) < 0);
720         goto donumset;
721     case O_SGT:
722         tmps = str_get(st[1]);
723         value = (double) (str_cmp(st[1],st[2]) > 0);
724         goto donumset;
725     case O_SLE:
726         tmps = str_get(st[1]);
727         value = (double) (str_cmp(st[1],st[2]) <= 0);
728         goto donumset;
729     case O_SGE:
730         tmps = str_get(st[1]);
731         value = (double) (str_cmp(st[1],st[2]) >= 0);
732         goto donumset;
733     case O_SEQ:
734         tmps = str_get(st[1]);
735         value = (double) str_eq(st[1],st[2]);
736         goto donumset;
737     case O_SNE:
738         tmps = str_get(st[1]);
739         value = (double) !str_eq(st[1],st[2]);
740         goto donumset;
741     case O_SUBR:
742         sp = do_subr(arg,gimme,arglast);
743         st = stack->ary_array + arglast[0];             /* maybe realloced */
744         goto array_return;
745     case O_DBSUBR:
746         sp = do_dbsubr(arg,gimme,arglast);
747         st = stack->ary_array + arglast[0];             /* maybe realloced */
748         goto array_return;
749     case O_SORT:
750         if ((arg[1].arg_type & A_MASK) == A_WORD)
751             stab = arg[1].arg_ptr.arg_stab;
752         else
753             stab = stabent(str_get(st[1]),TRUE);
754         if (!stab)
755             stab = defoutstab;
756         sp = do_sort(str,stab,
757           gimme,arglast);
758         goto array_return;
759     case O_REVERSE:
760         sp = do_reverse(str,
761           gimme,arglast);
762         goto array_return;
763     case O_WARN:
764         if (arglast[2] - arglast[1] != 1) {
765             do_join(str,arglast);
766             tmps = str_get(st[1]);
767         }
768         else {
769             str = st[2];
770             tmps = str_get(st[2]);
771         }
772         if (!tmps || !*tmps)
773             tmps = "Warning: something's wrong";
774         warn("%s",tmps);
775         goto say_yes;
776     case O_DIE:
777         if (arglast[2] - arglast[1] != 1) {
778             do_join(str,arglast);
779             tmps = str_get(st[1]);
780         }
781         else {
782             str = st[2];
783             tmps = str_get(st[2]);
784         }
785         if (!tmps || !*tmps)
786             exit(1);
787         fatal("%s",tmps);
788         goto say_zero;
789     case O_PRTF:
790     case O_PRINT:
791         if ((arg[1].arg_type & A_MASK) == A_WORD)
792             stab = arg[1].arg_ptr.arg_stab;
793         else
794             stab = stabent(str_get(st[1]),TRUE);
795         if (!stab)
796             stab = defoutstab;
797         if (!stab_io(stab)) {
798             if (dowarn)
799                 warn("Filehandle never opened");
800             goto say_zero;
801         }
802         if (!(fp = stab_io(stab)->ofp)) {
803             if (dowarn)  {
804                 if (stab_io(stab)->ifp)
805                     warn("Filehandle opened only for input");
806                 else
807                     warn("Print on closed filehandle");
808             }
809             goto say_zero;
810         }
811         else {
812             if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
813                 value = (double)do_aprint(arg,fp,arglast);
814             else {
815                 value = (double)do_print(st[2],fp);
816                 if (orslen && optype == O_PRINT)
817                     if (fwrite(ors, 1, orslen, fp) == 0)
818                         goto say_zero;
819             }
820             if (stab_io(stab)->flags & IOF_FLUSH)
821                 if (fflush(fp) == EOF)
822                     goto say_zero;
823         }
824         goto donumset;
825     case O_CHDIR:
826         if (maxarg < 1)
827             tmps = str_get(stab_val(defstab));
828         else
829             tmps = str_get(st[1]);
830         if (!tmps || !*tmps) {
831             tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
832             if (tmpstr)
833                 tmps = str_get(tmpstr);
834         }
835         if (!tmps || !*tmps) {
836             tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
837             if (tmpstr)
838                 tmps = str_get(tmpstr);
839         }
840 #ifdef TAINT
841         taintproper("Insecure dependency in chdir");
842 #endif
843         value = (double)(chdir(tmps) >= 0);
844         goto donumset;
845     case O_EXIT:
846         if (maxarg < 1)
847             anum = 0;
848         else
849             anum = (int)str_gnum(st[1]);
850         exit(anum);
851         goto say_zero;
852     case O_RESET:
853         if (maxarg < 1)
854             tmps = "";
855         else
856             tmps = str_get(st[1]);
857         str_reset(tmps,arg[2].arg_ptr.arg_hash);
858         value = 1.0;
859         goto donumset;
860     case O_LIST:
861         if (gimme == G_ARRAY)
862             goto array_return;
863         if (maxarg > 0)
864             str = st[sp - arglast[0]];  /* unwanted list, return last item */
865         else
866             str = &str_undef;
867         break;
868     case O_EOF:
869         if (maxarg <= 0)
870             stab = last_in_stab;
871         else if ((arg[1].arg_type & A_MASK) == A_WORD)
872             stab = arg[1].arg_ptr.arg_stab;
873         else
874             stab = stabent(str_get(st[1]),TRUE);
875         str_set(str, do_eof(stab) ? Yes : No);
876         STABSET(str);
877         break;
878     case O_GETC:
879         if (maxarg <= 0)
880             stab = stdinstab;
881         else if ((arg[1].arg_type & A_MASK) == A_WORD)
882             stab = arg[1].arg_ptr.arg_stab;
883         else
884             stab = stabent(str_get(st[1]),TRUE);
885         if (do_eof(stab))       /* make sure we have fp with something */
886             str_set(str, No);
887         else {
888 #ifdef TAINT
889             tainted = 1;
890 #endif
891             str_set(str," ");
892             *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
893         }
894         STABSET(str);
895         break;
896     case O_TELL:
897         if (maxarg <= 0)
898             stab = last_in_stab;
899         else if ((arg[1].arg_type & A_MASK) == A_WORD)
900             stab = arg[1].arg_ptr.arg_stab;
901         else
902             stab = stabent(str_get(st[1]),TRUE);
903 #ifndef lint
904         value = (double)do_tell(stab);
905 #else
906         (void)do_tell(stab);
907 #endif
908         goto donumset;
909     case O_RECV:
910     case O_READ:
911         if ((arg[1].arg_type & A_MASK) == A_WORD)
912             stab = arg[1].arg_ptr.arg_stab;
913         else
914             stab = stabent(str_get(st[1]),TRUE);
915         tmps = str_get(st[2]);
916         anum = (int)str_gnum(st[3]);
917         STR_GROW(st[2], anum+1), (tmps = str_get(st[2]));       /* sneaky */
918         errno = 0;
919         if (!stab_io(stab) || !stab_io(stab)->ifp)
920             goto say_zero;
921 #ifdef SOCKET
922         else if (optype == O_RECV) {
923             argtype = sizeof buf;
924             optype = (int)str_gnum(st[4]);
925             anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, optype,
926                 buf, &argtype);
927             if (anum >= 0) {
928                 st[2]->str_cur = anum;
929                 st[2]->str_ptr[anum] = '\0';
930                 str_nset(str,buf,argtype);
931             }
932             else
933                 str_sset(str,&str_undef);
934             break;
935         }
936         else if (stab_io(stab)->type == 's') {
937             argtype = sizeof buf;
938             anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, 0,
939                 buf, &argtype);
940         }
941 #else
942         else if (optype == O_RECV)
943             goto badsock;
944 #endif
945         else
946             anum = fread(tmps, 1, anum, stab_io(stab)->ifp);
947         if (anum < 0)
948             goto say_undef;
949         st[2]->str_cur = anum;
950         st[2]->str_ptr[anum] = '\0';
951         value = (double)anum;
952         goto donumset;
953     case O_SEND:
954 #ifdef SOCKET
955         if ((arg[1].arg_type & A_MASK) == A_WORD)
956             stab = arg[1].arg_ptr.arg_stab;
957         else
958             stab = stabent(str_get(st[1]),TRUE);
959         tmps = str_get(st[2]);
960         anum = (int)str_gnum(st[3]);
961         optype = sp - arglast[0];
962         errno = 0;
963         if (optype > 4)
964             warn("Too many args on send");
965         if (optype >= 4) {
966             tmps2 = str_get(st[4]);
967             anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
968               anum, tmps2, st[4]->str_cur);
969         }
970         else
971             anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
972         if (anum < 0)
973             goto say_undef;
974         value = (double)anum;
975         goto donumset;
976 #else
977         goto badsock;
978 #endif
979     case O_SEEK:
980         if ((arg[1].arg_type & A_MASK) == A_WORD)
981             stab = arg[1].arg_ptr.arg_stab;
982         else
983             stab = stabent(str_get(st[1]),TRUE);
984         value = str_gnum(st[2]);
985         str_set(str, do_seek(stab,
986           (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
987         STABSET(str);
988         break;
989     case O_RETURN:
990         tmps = "SUB";           /* just fake up a "last SUB" */
991         optype = O_LAST;
992         if (gimme == G_ARRAY) {
993             lastretstr = Nullstr;
994             lastspbase = arglast[1];
995             lastsize = arglast[2] - arglast[1];
996         }
997         else
998             lastretstr = str_static(st[arglast[2] - arglast[0]]);
999         goto dopop;
1000     case O_REDO:
1001     case O_NEXT:
1002     case O_LAST:
1003         if (maxarg > 0) {
1004             tmps = str_get(arg[1].arg_ptr.arg_str);
1005           dopop:
1006             while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
1007               strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
1008 #ifdef DEBUGGING
1009                 if (debug & 4) {
1010                     deb("(Skipping label #%d %s)\n",loop_ptr,
1011                         loop_stack[loop_ptr].loop_label);
1012                 }
1013 #endif
1014                 loop_ptr--;
1015             }
1016 #ifdef DEBUGGING
1017             if (debug & 4) {
1018                 deb("(Found label #%d %s)\n",loop_ptr,
1019                     loop_stack[loop_ptr].loop_label);
1020             }
1021 #endif
1022         }
1023         if (loop_ptr < 0)
1024             fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
1025         if (!lastretstr && optype == O_LAST && lastsize) {
1026             st -= arglast[0];
1027             st += lastspbase + 1;
1028             optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
1029             if (optype) {
1030                 for (anum = lastsize; anum > 0; anum--,st++)
1031                     st[optype] = str_static(st[0]);
1032             }
1033             longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
1034         }
1035         longjmp(loop_stack[loop_ptr].loop_env, optype);
1036     case O_DUMP:
1037     case O_GOTO:/* shudder */
1038         goto_targ = str_get(arg[1].arg_ptr.arg_str);
1039         if (!*goto_targ)
1040             goto_targ = Nullch;         /* just restart from top */
1041         if (optype == O_DUMP) {
1042             do_undump = 1;
1043             abort();
1044         }
1045         longjmp(top_env, 1);
1046     case O_INDEX:
1047         tmps = str_get(st[1]);
1048 #ifndef lint
1049         if (!(tmps2 = fbminstr((unsigned char*)tmps,
1050           (unsigned char*)tmps + st[1]->str_cur, st[2])))
1051 #else
1052         if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
1053 #endif
1054             value = (double)(-1 + arybase);
1055         else
1056             value = (double)(tmps2 - tmps + arybase);
1057         goto donumset;
1058     case O_RINDEX:
1059         tmps = str_get(st[1]);
1060         tmps2 = str_get(st[2]);
1061 #ifndef lint
1062         if (!(tmps2 = rninstr(tmps,  tmps  + st[1]->str_cur,
1063                               tmps2, tmps2 + st[2]->str_cur)))
1064 #else
1065         if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
1066 #endif
1067             value = (double)(-1 + arybase);
1068         else
1069             value = (double)(tmps2 - tmps + arybase);
1070         goto donumset;
1071     case O_TIME:
1072 #ifndef lint
1073         value = (double) time(Null(long*));
1074 #endif
1075         goto donumset;
1076     case O_TMS:
1077         sp = do_tms(str,gimme,arglast);
1078         goto array_return;
1079     case O_LOCALTIME:
1080         if (maxarg < 1)
1081             (void)time(&when);
1082         else
1083             when = (long)str_gnum(st[1]);
1084         sp = do_time(str,localtime(&when),
1085           gimme,arglast);
1086         goto array_return;
1087     case O_GMTIME:
1088         if (maxarg < 1)
1089             (void)time(&when);
1090         else
1091             when = (long)str_gnum(st[1]);
1092         sp = do_time(str,gmtime(&when),
1093           gimme,arglast);
1094         goto array_return;
1095     case O_LSTAT:
1096     case O_STAT:
1097         sp = do_stat(str,arg,
1098           gimme,arglast);
1099         goto array_return;
1100     case O_CRYPT:
1101 #ifdef CRYPT
1102         tmps = str_get(st[1]);
1103 #ifdef FCRYPT
1104         str_set(str,fcrypt(tmps,str_get(st[2])));
1105 #else
1106         str_set(str,crypt(tmps,str_get(st[2])));
1107 #endif
1108 #else
1109         fatal(
1110           "The crypt() function is unimplemented due to excessive paranoia.");
1111 #endif
1112         break;
1113     case O_ATAN2:
1114         value = str_gnum(st[1]);
1115         value = atan2(value,str_gnum(st[2]));
1116         goto donumset;
1117     case O_SIN:
1118         if (maxarg < 1)
1119             value = str_gnum(stab_val(defstab));
1120         else
1121             value = str_gnum(st[1]);
1122         value = sin(value);
1123         goto donumset;
1124     case O_COS:
1125         if (maxarg < 1)
1126             value = str_gnum(stab_val(defstab));
1127         else
1128             value = str_gnum(st[1]);
1129         value = cos(value);
1130         goto donumset;
1131     case O_RAND:
1132         if (maxarg < 1)
1133             value = 1.0;
1134         else
1135             value = str_gnum(st[1]);
1136         if (value == 0.0)
1137             value = 1.0;
1138 #if RANDBITS == 31
1139         value = rand() * value / 2147483648.0;
1140 #else
1141 #if RANDBITS == 16
1142         value = rand() * value / 65536.0;
1143 #else
1144 #if RANDBITS == 15
1145         value = rand() * value / 32768.0;
1146 #else
1147         value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1148 #endif
1149 #endif
1150 #endif
1151         goto donumset;
1152     case O_SRAND:
1153         if (maxarg < 1) {
1154             (void)time(&when);
1155             anum = when;
1156         }
1157         else
1158             anum = (int)str_gnum(st[1]);
1159         (void)srand(anum);
1160         goto say_yes;
1161     case O_EXP:
1162         if (maxarg < 1)
1163             value = str_gnum(stab_val(defstab));
1164         else
1165             value = str_gnum(st[1]);
1166         value = exp(value);
1167         goto donumset;
1168     case O_LOG:
1169         if (maxarg < 1)
1170             value = str_gnum(stab_val(defstab));
1171         else
1172             value = str_gnum(st[1]);
1173         value = log(value);
1174         goto donumset;
1175     case O_SQRT:
1176         if (maxarg < 1)
1177             value = str_gnum(stab_val(defstab));
1178         else
1179             value = str_gnum(st[1]);
1180         value = sqrt(value);
1181         goto donumset;
1182     case O_INT:
1183         if (maxarg < 1)
1184             value = str_gnum(stab_val(defstab));
1185         else
1186             value = str_gnum(st[1]);
1187         if (value >= 0.0)
1188             (void)modf(value,&value);
1189         else {
1190             (void)modf(-value,&value);
1191             value = -value;
1192         }
1193         goto donumset;
1194     case O_ORD:
1195         if (maxarg < 1)
1196             tmps = str_get(stab_val(defstab));
1197         else
1198             tmps = str_get(st[1]);
1199 #ifndef I286
1200         value = (double) *tmps;
1201 #else
1202         anum = (int) *tmps;
1203         value = (double) anum;
1204 #endif
1205         goto donumset;
1206     case O_SLEEP:
1207         if (maxarg < 1)
1208             tmps = Nullch;
1209         else
1210             tmps = str_get(st[1]);
1211         (void)time(&when);
1212         if (!tmps || !*tmps)
1213             sleep((32767<<16)+32767);
1214         else
1215             sleep((unsigned int)atoi(tmps));
1216 #ifndef lint
1217         value = (double)when;
1218         (void)time(&when);
1219         value = ((double)when) - value;
1220 #endif
1221         goto donumset;
1222     case O_RANGE:
1223         sp = do_range(gimme,arglast);
1224         goto array_return;
1225     case O_F_OR_R:
1226         if (gimme == G_ARRAY) {         /* it's a range */
1227             /* can we optimize to constant array? */
1228             if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
1229               (arg[2].arg_type & A_MASK) == A_SINGLE) {
1230                 st[2] = arg[2].arg_ptr.arg_str;
1231                 sp = do_range(gimme,arglast);
1232                 st = stack->ary_array;
1233                 maxarg = sp - arglast[0];
1234                 str_free(arg[1].arg_ptr.arg_str);
1235                 str_free(arg[2].arg_ptr.arg_str);
1236                 arg->arg_type = O_ARRAY;
1237                 arg[1].arg_type = A_STAB|A_DONT;
1238                 arg->arg_len = 1;
1239                 stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
1240                 ary = stab_array(stab);
1241                 afill(ary,maxarg - 1);
1242                 st += arglast[0]+1;
1243                 while (maxarg-- > 0)
1244                     ary->ary_array[maxarg] = str_smake(st[maxarg]);
1245                 goto array_return;
1246             }
1247             arg->arg_type = optype = O_RANGE;
1248             maxarg = arg->arg_len = 2;
1249             anum = 2;
1250             arg[anum].arg_flags &= ~AF_ARYOK;
1251             argflags = arg[anum].arg_flags;
1252             argtype = arg[anum].arg_type & A_MASK;
1253             arg[anum].arg_type = argtype;
1254             argptr = arg[anum].arg_ptr;
1255             sp = arglast[0];
1256             st -= sp;
1257             sp++;
1258             goto re_eval;
1259         }
1260         arg->arg_type = O_FLIP;
1261         /* FALL THROUGH */
1262     case O_FLIP:
1263         if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
1264           last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
1265           :
1266           str_true(st[1]) ) {
1267             str_numset(str,0.0);
1268             anum = 2;
1269             arg->arg_type = optype = O_FLOP;
1270             arg[2].arg_type &= ~A_DONT;
1271             arg[1].arg_type |= A_DONT;
1272             argflags = arg[2].arg_flags;
1273             argtype = arg[2].arg_type & A_MASK;
1274             argptr = arg[2].arg_ptr;
1275             sp = arglast[0];
1276             st -= sp;
1277             goto re_eval;
1278         }
1279         str_set(str,"");
1280         break;
1281     case O_FLOP:
1282         str_inc(str);
1283         if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
1284           last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
1285           :
1286           str_true(st[2]) ) {
1287             arg->arg_type = O_FLIP;
1288             arg[1].arg_type &= ~A_DONT;
1289             arg[2].arg_type |= A_DONT;
1290             str_cat(str,"E0");
1291         }
1292         break;
1293     case O_FORK:
1294         anum = fork();
1295         if (!anum && (tmpstab = stabent("$",allstabs)))
1296             str_numset(STAB_STR(tmpstab),(double)getpid());
1297         value = (double)anum;
1298         goto donumset;
1299     case O_WAIT:
1300 #ifndef lint
1301         ihand = signal(SIGINT, SIG_IGN);
1302         qhand = signal(SIGQUIT, SIG_IGN);
1303         anum = wait(&argflags);
1304         if (anum > 0)
1305             pidgone(anum,argflags);
1306         value = (double)anum;
1307 #else
1308         ihand = qhand = 0;
1309 #endif
1310         (void)signal(SIGINT, ihand);
1311         (void)signal(SIGQUIT, qhand);
1312         statusvalue = (unsigned short)argflags;
1313         goto donumset;
1314     case O_SYSTEM:
1315 #ifdef TAINT
1316         if (arglast[2] - arglast[1] == 1) {
1317             taintenv();
1318             tainted |= st[2]->str_tainted;
1319             taintproper("Insecure dependency in system");
1320         }
1321 #endif
1322         while ((anum = vfork()) == -1) {
1323             if (errno != EAGAIN) {
1324                 value = -1.0;
1325                 goto donumset;
1326             }
1327             sleep(5);
1328         }
1329         if (anum > 0) {
1330 #ifndef lint
1331             ihand = signal(SIGINT, SIG_IGN);
1332             qhand = signal(SIGQUIT, SIG_IGN);
1333             while ((argtype = wait(&argflags)) != anum && argtype >= 0)
1334                 pidgone(argtype,argflags);
1335 #else
1336             ihand = qhand = 0;
1337 #endif
1338             (void)signal(SIGINT, ihand);
1339             (void)signal(SIGQUIT, qhand);
1340             statusvalue = (unsigned short)argflags;
1341             if (argtype == -1)
1342                 value = -1.0;
1343             else {
1344                 value = (double)((unsigned int)argflags & 0xffff);
1345             }
1346             goto donumset;
1347         }
1348         if ((arg[1].arg_type & A_MASK) == A_STAB)
1349             value = (double)do_aexec(st[1],arglast);
1350         else if (arglast[2] - arglast[1] != 1)
1351             value = (double)do_aexec(Nullstr,arglast);
1352         else {
1353             value = (double)do_exec(str_get(str_static(st[2])));
1354         }
1355         _exit(-1);
1356     case O_EXEC:
1357         if ((arg[1].arg_type & A_MASK) == A_STAB)
1358             value = (double)do_aexec(st[1],arglast);
1359         else if (arglast[2] - arglast[1] != 1)
1360             value = (double)do_aexec(Nullstr,arglast);
1361         else {
1362             value = (double)do_exec(str_get(str_static(st[2])));
1363         }
1364         goto donumset;
1365     case O_HEX:
1366         argtype = 4;
1367         goto snarfnum;
1368
1369     case O_OCT:
1370         argtype = 3;
1371
1372       snarfnum:
1373         anum = 0;
1374         if (maxarg < 1)
1375             tmps = str_get(stab_val(defstab));
1376         else
1377             tmps = str_get(st[1]);
1378         for (;;) {
1379             switch (*tmps) {
1380             default:
1381                 goto out;
1382             case '8': case '9':
1383                 if (argtype != 4)
1384                     goto out;
1385                 /* FALL THROUGH */
1386             case '0': case '1': case '2': case '3': case '4':
1387             case '5': case '6': case '7':
1388                 anum <<= argtype;
1389                 anum += *tmps++ & 15;
1390                 break;
1391             case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1392             case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
1393                 if (argtype != 4)
1394                     goto out;
1395                 anum <<= 4;
1396                 anum += (*tmps++ & 7) + 9;
1397                 break;
1398             case 'x':
1399                 argtype = 4;
1400                 tmps++;
1401                 break;
1402             }
1403         }
1404       out:
1405         value = (double)anum;
1406         goto donumset;
1407     case O_CHMOD:
1408     case O_CHOWN:
1409     case O_KILL:
1410     case O_UNLINK:
1411     case O_UTIME:
1412         value = (double)apply(optype,arglast);
1413         goto donumset;
1414     case O_UMASK:
1415         if (maxarg < 1) {
1416             anum = umask(0);
1417             (void)umask(anum);
1418         }
1419         else
1420             anum = umask((int)str_gnum(st[1]));
1421         value = (double)anum;
1422 #ifdef TAINT
1423         taintproper("Insecure dependency in umask");
1424 #endif
1425         goto donumset;
1426     case O_RENAME:
1427         tmps = str_get(st[1]);
1428         tmps2 = str_get(st[2]);
1429 #ifdef TAINT
1430         taintproper("Insecure dependency in rename");
1431 #endif
1432 #ifdef RENAME
1433         value = (double)(rename(tmps,tmps2) >= 0);
1434 #else
1435         if (euid || stat(tmps2,&statbuf) < 0 ||
1436           (statbuf.st_mode & S_IFMT) != S_IFDIR )
1437             (void)UNLINK(tmps2);        /* avoid unlinking a directory */
1438         if (!(anum = link(tmps,tmps2)))
1439             anum = UNLINK(tmps);
1440         value = (double)(anum >= 0);
1441 #endif
1442         goto donumset;
1443     case O_LINK:
1444         tmps = str_get(st[1]);
1445         tmps2 = str_get(st[2]);
1446 #ifdef TAINT
1447         taintproper("Insecure dependency in link");
1448 #endif
1449         value = (double)(link(tmps,tmps2) >= 0);
1450         goto donumset;
1451     case O_MKDIR:
1452         tmps = str_get(st[1]);
1453         anum = (int)str_gnum(st[2]);
1454 #ifdef TAINT
1455         taintproper("Insecure dependency in mkdir");
1456 #endif
1457 #ifdef MKDIR
1458         value = (double)(mkdir(tmps,anum) >= 0);
1459         goto donumset;
1460 #else
1461         (void)strcpy(buf,"mkdir ");
1462 #endif
1463 #if !defined(MKDIR) || !defined(RMDIR)
1464       one_liner:
1465         for (tmps2 = buf+6; *tmps; ) {
1466             *tmps2++ = '\\';
1467             *tmps2++ = *tmps++;
1468         }
1469         (void)strcpy(tmps2," 2>&1");
1470         rsfp = mypopen(buf,"r");
1471         if (rsfp) {
1472             *buf = '\0';
1473             tmps2 = fgets(buf,sizeof buf,rsfp);
1474             (void)mypclose(rsfp);
1475             if (tmps2 != Nullch) {
1476                 for (errno = 1; errno < sys_nerr; errno++) {
1477                     if (instr(buf,sys_errlist[errno]))  /* you don't see this */
1478                         goto say_zero;
1479                 }
1480                 errno = 0;
1481 #ifndef EACCES
1482 #define EACCES EPERM
1483 #endif
1484                 if (instr(buf,"cannot make"))
1485                     errno = EEXIST;
1486                 else if (instr(buf,"non-exist"))
1487                     errno = ENOENT;
1488                 else if (instr(buf,"not empty"))
1489                     errno = EBUSY;
1490                 else if (instr(buf,"cannot access"))
1491                     errno = EACCES;
1492                 else
1493                     errno = EPERM;
1494                 goto say_zero;
1495             }
1496             else {      /* some mkdirs return no failure indication */
1497                 tmps = str_get(st[1]);
1498                 anum = (stat(tmps,&statbuf) >= 0);
1499                 if (optype == O_RMDIR)
1500                     anum = !anum;
1501                 if (anum)
1502                     errno = 0;
1503                 else
1504                     errno = EACCES;     /* a guess */
1505                 value = (double)anum;
1506             }
1507             goto donumset;
1508         }
1509         else
1510             goto say_zero;
1511 #endif
1512     case O_RMDIR:
1513         if (maxarg < 1)
1514             tmps = str_get(stab_val(defstab));
1515         else
1516             tmps = str_get(st[1]);
1517 #ifdef TAINT
1518         taintproper("Insecure dependency in rmdir");
1519 #endif
1520 #ifdef RMDIR
1521         value = (double)(rmdir(tmps) >= 0);
1522         goto donumset;
1523 #else
1524         (void)strcpy(buf,"rmdir ");
1525         goto one_liner;         /* see above in MKDIR */
1526 #endif
1527     case O_GETPPID:
1528         value = (double)getppid();
1529         goto donumset;
1530     case O_GETPGRP:
1531 #ifdef GETPGRP
1532         if (maxarg < 1)
1533             anum = 0;
1534         else
1535             anum = (int)str_gnum(st[1]);
1536         value = (double)getpgrp(anum);
1537         goto donumset;
1538 #else
1539         fatal("The getpgrp() function is unimplemented on this machine");
1540         break;
1541 #endif
1542     case O_SETPGRP:
1543 #ifdef SETPGRP
1544         argtype = (int)str_gnum(st[1]);
1545         anum = (int)str_gnum(st[2]);
1546 #ifdef TAINT
1547         taintproper("Insecure dependency in setpgrp");
1548 #endif
1549         value = (double)(setpgrp(argtype,anum) >= 0);
1550         goto donumset;
1551 #else
1552         fatal("The setpgrp() function is unimplemented on this machine");
1553         break;
1554 #endif
1555     case O_GETPRIORITY:
1556 #ifdef GETPRIORITY
1557         argtype = (int)str_gnum(st[1]);
1558         anum = (int)str_gnum(st[2]);
1559         value = (double)getpriority(argtype,anum);
1560         goto donumset;
1561 #else
1562         fatal("The getpriority() function is unimplemented on this machine");
1563         break;
1564 #endif
1565     case O_SETPRIORITY:
1566 #ifdef SETPRIORITY
1567         argtype = (int)str_gnum(st[1]);
1568         anum = (int)str_gnum(st[2]);
1569         optype = (int)str_gnum(st[3]);
1570 #ifdef TAINT
1571         taintproper("Insecure dependency in setpriority");
1572 #endif
1573         value = (double)(setpriority(argtype,anum,optype) >= 0);
1574         goto donumset;
1575 #else
1576         fatal("The setpriority() function is unimplemented on this machine");
1577         break;
1578 #endif
1579     case O_CHROOT:
1580         if (maxarg < 1)
1581             tmps = str_get(stab_val(defstab));
1582         else
1583             tmps = str_get(st[1]);
1584 #ifdef TAINT
1585         taintproper("Insecure dependency in chroot");
1586 #endif
1587         value = (double)(chroot(tmps) >= 0);
1588         goto donumset;
1589     case O_FCNTL:
1590     case O_IOCTL:
1591         if (maxarg <= 0)
1592             stab = last_in_stab;
1593         else if ((arg[1].arg_type & A_MASK) == A_WORD)
1594             stab = arg[1].arg_ptr.arg_stab;
1595         else
1596             stab = stabent(str_get(st[1]),TRUE);
1597         argtype = (int)str_gnum(st[2]);
1598 #ifdef TAINT
1599         taintproper("Insecure dependency in ioctl");
1600 #endif
1601         anum = do_ctl(optype,stab,argtype,st[3]);
1602         if (anum == -1)
1603             goto say_undef;
1604         if (anum != 0)
1605             goto donumset;
1606         str_set(str,"0 but true");
1607         STABSET(str);
1608         break;
1609     case O_FLOCK:
1610 #ifdef FLOCK
1611         if (maxarg <= 0)
1612             stab = last_in_stab;
1613         else if ((arg[1].arg_type & A_MASK) == A_WORD)
1614             stab = arg[1].arg_ptr.arg_stab;
1615         else
1616             stab = stabent(str_get(st[1]),TRUE);
1617         if (stab && stab_io(stab))
1618             fp = stab_io(stab)->ifp;
1619         else
1620             fp = Nullfp;
1621         if (fp) {
1622             argtype = (int)str_gnum(st[2]);
1623             value = (double)(flock(fileno(fp),argtype) >= 0);
1624         }
1625         else
1626             value = 0;
1627         goto donumset;
1628 #else
1629         fatal("The flock() function is unimplemented on this machine");
1630         break;
1631 #endif
1632     case O_UNSHIFT:
1633         ary = stab_array(arg[1].arg_ptr.arg_stab);
1634         if (arglast[2] - arglast[1] != 1)
1635             do_unshift(ary,arglast);
1636         else {
1637             str = Str_new(52,0);                /* must copy the STR */
1638             str_sset(str,st[2]);
1639             aunshift(ary,1);
1640             (void)astore(ary,0,str);
1641         }
1642         value = (double)(ary->ary_fill + 1);
1643         break;
1644     case O_DOFILE:
1645     case O_EVAL:
1646         if (maxarg < 1)
1647             tmpstr = stab_val(defstab);
1648         else
1649             tmpstr =
1650               (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
1651 #ifdef TAINT
1652         tainted |= tmpstr->str_tainted;
1653         taintproper("Insecure dependency in eval");
1654 #endif
1655         sp = do_eval(tmpstr, optype, arg[2].arg_ptr.arg_hash,
1656             gimme,arglast);
1657         goto array_return;
1658
1659     case O_FTRREAD:
1660         argtype = 0;
1661         anum = S_IREAD;
1662         goto check_perm;
1663     case O_FTRWRITE:
1664         argtype = 0;
1665         anum = S_IWRITE;
1666         goto check_perm;
1667     case O_FTREXEC:
1668         argtype = 0;
1669         anum = S_IEXEC;
1670         goto check_perm;
1671     case O_FTEREAD:
1672         argtype = 1;
1673         anum = S_IREAD;
1674         goto check_perm;
1675     case O_FTEWRITE:
1676         argtype = 1;
1677         anum = S_IWRITE;
1678         goto check_perm;
1679     case O_FTEEXEC:
1680         argtype = 1;
1681         anum = S_IEXEC;
1682       check_perm:
1683         if (mystat(arg,st[1]) < 0)
1684             goto say_undef;
1685         if (cando(anum,argtype,&statcache))
1686             goto say_yes;
1687         goto say_no;
1688
1689     case O_FTIS:
1690         if (mystat(arg,st[1]) < 0)
1691             goto say_undef;
1692         goto say_yes;
1693     case O_FTEOWNED:
1694     case O_FTROWNED:
1695         if (mystat(arg,st[1]) < 0)
1696             goto say_undef;
1697         if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
1698             goto say_yes;
1699         goto say_no;
1700     case O_FTZERO:
1701         if (mystat(arg,st[1]) < 0)
1702             goto say_undef;
1703         if (!statcache.st_size)
1704             goto say_yes;
1705         goto say_no;
1706     case O_FTSIZE:
1707         if (mystat(arg,st[1]) < 0)
1708             goto say_undef;
1709         if (statcache.st_size)
1710             goto say_yes;
1711         goto say_no;
1712
1713     case O_FTSOCK:
1714 #ifdef S_IFSOCK
1715         anum = S_IFSOCK;
1716         goto check_file_type;
1717 #else
1718         goto say_no;
1719 #endif
1720     case O_FTCHR:
1721         anum = S_IFCHR;
1722         goto check_file_type;
1723     case O_FTBLK:
1724         anum = S_IFBLK;
1725         goto check_file_type;
1726     case O_FTFILE:
1727         anum = S_IFREG;
1728         goto check_file_type;
1729     case O_FTDIR:
1730         anum = S_IFDIR;
1731       check_file_type:
1732         if (mystat(arg,st[1]) < 0)
1733             goto say_undef;
1734         if ((statcache.st_mode & S_IFMT) == anum )
1735             goto say_yes;
1736         goto say_no;
1737     case O_FTPIPE:
1738 #ifdef S_IFIFO
1739         anum = S_IFIFO;
1740         goto check_file_type;
1741 #else
1742         goto say_no;
1743 #endif
1744     case O_FTLINK:
1745 #ifdef LSTAT
1746         if (lstat(str_get(st[1]),&statcache) < 0)
1747             goto say_undef;
1748         if ((statcache.st_mode & S_IFMT) == S_IFLNK )
1749             goto say_yes;
1750 #endif
1751         goto say_no;
1752     case O_SYMLINK:
1753 #ifdef SYMLINK
1754         tmps = str_get(st[1]);
1755         tmps2 = str_get(st[2]);
1756 #ifdef TAINT
1757         taintproper("Insecure dependency in symlink");
1758 #endif
1759         value = (double)(symlink(tmps,tmps2) >= 0);
1760         goto donumset;
1761 #else
1762         fatal("Unsupported function symlink()");
1763 #endif
1764     case O_READLINK:
1765 #ifdef SYMLINK
1766         if (maxarg < 1)
1767             tmps = str_get(stab_val(defstab));
1768         else
1769             tmps = str_get(st[1]);
1770         anum = readlink(tmps,buf,sizeof buf);
1771         if (anum < 0)
1772             goto say_undef;
1773         str_nset(str,buf,anum);
1774         break;
1775 #else
1776         fatal("Unsupported function readlink()");
1777 #endif
1778     case O_FTSUID:
1779         anum = S_ISUID;
1780         goto check_xid;
1781     case O_FTSGID:
1782         anum = S_ISGID;
1783         goto check_xid;
1784     case O_FTSVTX:
1785         anum = S_ISVTX;
1786       check_xid:
1787         if (mystat(arg,st[1]) < 0)
1788             goto say_undef;
1789         if (statcache.st_mode & anum)
1790             goto say_yes;
1791         goto say_no;
1792     case O_FTTTY:
1793         if (arg[1].arg_type & A_DONT) {
1794             stab = arg[1].arg_ptr.arg_stab;
1795             tmps = "";
1796         }
1797         else
1798             stab = stabent(tmps = str_get(st[1]),FALSE);
1799         if (stab && stab_io(stab) && stab_io(stab)->ifp)
1800             anum = fileno(stab_io(stab)->ifp);
1801         else if (isdigit(*tmps))
1802             anum = atoi(tmps);
1803         else
1804             goto say_undef;
1805         if (isatty(anum))
1806             goto say_yes;
1807         goto say_no;
1808     case O_FTTEXT:
1809     case O_FTBINARY:
1810         str = do_fttext(arg,st[1]);
1811         break;
1812 #ifdef SOCKET
1813     case O_SOCKET:
1814         if ((arg[1].arg_type & A_MASK) == A_WORD)
1815             stab = arg[1].arg_ptr.arg_stab;
1816         else
1817             stab = stabent(str_get(st[1]),TRUE);
1818 #ifndef lint
1819         value = (double)do_socket(stab,arglast);
1820 #else
1821         (void)do_socket(stab,arglast);
1822 #endif
1823         goto donumset;
1824     case O_BIND:
1825         if ((arg[1].arg_type & A_MASK) == A_WORD)
1826             stab = arg[1].arg_ptr.arg_stab;
1827         else
1828             stab = stabent(str_get(st[1]),TRUE);
1829 #ifndef lint
1830         value = (double)do_bind(stab,arglast);
1831 #else
1832         (void)do_bind(stab,arglast);
1833 #endif
1834         goto donumset;
1835     case O_CONNECT:
1836         if ((arg[1].arg_type & A_MASK) == A_WORD)
1837             stab = arg[1].arg_ptr.arg_stab;
1838         else
1839             stab = stabent(str_get(st[1]),TRUE);
1840 #ifndef lint
1841         value = (double)do_connect(stab,arglast);
1842 #else
1843         (void)do_connect(stab,arglast);
1844 #endif
1845         goto donumset;
1846     case O_LISTEN:
1847         if ((arg[1].arg_type & A_MASK) == A_WORD)
1848             stab = arg[1].arg_ptr.arg_stab;
1849         else
1850             stab = stabent(str_get(st[1]),TRUE);
1851 #ifndef lint
1852         value = (double)do_listen(stab,arglast);
1853 #else
1854         (void)do_listen(stab,arglast);
1855 #endif
1856         goto donumset;
1857     case O_ACCEPT:
1858         if ((arg[1].arg_type & A_MASK) == A_WORD)
1859             stab = arg[1].arg_ptr.arg_stab;
1860         else
1861             stab = stabent(str_get(st[1]),TRUE);
1862         if ((arg[2].arg_type & A_MASK) == A_WORD)
1863             stab2 = arg[2].arg_ptr.arg_stab;
1864         else
1865             stab2 = stabent(str_get(st[2]),TRUE);
1866         do_accept(str,stab,stab2);
1867         STABSET(str);
1868         break;
1869     case O_GHBYNAME:
1870         if (maxarg < 1)
1871             goto say_undef;
1872     case O_GHBYADDR:
1873     case O_GHOSTENT:
1874         sp = do_ghent(optype,
1875           gimme,arglast);
1876         goto array_return;
1877     case O_GNBYNAME:
1878         if (maxarg < 1)
1879             goto say_undef;
1880     case O_GNBYADDR:
1881     case O_GNETENT:
1882         sp = do_gnent(optype,
1883           gimme,arglast);
1884         goto array_return;
1885     case O_GPBYNAME:
1886         if (maxarg < 1)
1887             goto say_undef;
1888     case O_GPBYNUMBER:
1889     case O_GPROTOENT:
1890         sp = do_gpent(optype,
1891           gimme,arglast);
1892         goto array_return;
1893     case O_GSBYNAME:
1894         if (maxarg < 1)
1895             goto say_undef;
1896     case O_GSBYPORT:
1897     case O_GSERVENT:
1898         sp = do_gsent(optype,
1899           gimme,arglast);
1900         goto array_return;
1901     case O_SHOSTENT:
1902         value = (double) sethostent((int)str_gnum(st[1]));
1903         goto donumset;
1904     case O_SNETENT:
1905         value = (double) setnetent((int)str_gnum(st[1]));
1906         goto donumset;
1907     case O_SPROTOENT:
1908         value = (double) setprotoent((int)str_gnum(st[1]));
1909         goto donumset;
1910     case O_SSERVENT:
1911         value = (double) setservent((int)str_gnum(st[1]));
1912         goto donumset;
1913     case O_EHOSTENT:
1914         value = (double) endhostent();
1915         goto donumset;
1916     case O_ENETENT:
1917         value = (double) endnetent();
1918         goto donumset;
1919     case O_EPROTOENT:
1920         value = (double) endprotoent();
1921         goto donumset;
1922     case O_ESERVENT:
1923         value = (double) endservent();
1924         goto donumset;
1925     case O_SSELECT:
1926         sp = do_select(gimme,arglast);
1927         goto array_return;
1928     case O_SOCKETPAIR:
1929         if ((arg[1].arg_type & A_MASK) == A_WORD)
1930             stab = arg[1].arg_ptr.arg_stab;
1931         else
1932             stab = stabent(str_get(st[1]),TRUE);
1933         if ((arg[2].arg_type & A_MASK) == A_WORD)
1934             stab2 = arg[2].arg_ptr.arg_stab;
1935         else
1936             stab2 = stabent(str_get(st[2]),TRUE);
1937 #ifndef lint
1938         value = (double)do_spair(stab,stab2,arglast);
1939 #else
1940         (void)do_spair(stab,stab2,arglast);
1941 #endif
1942         goto donumset;
1943     case O_SHUTDOWN:
1944         if ((arg[1].arg_type & A_MASK) == A_WORD)
1945             stab = arg[1].arg_ptr.arg_stab;
1946         else
1947             stab = stabent(str_get(st[1]),TRUE);
1948 #ifndef lint
1949         value = (double)do_shutdown(stab,arglast);
1950 #else
1951         (void)do_shutdown(stab,arglast);
1952 #endif
1953         goto donumset;
1954     case O_GSOCKOPT:
1955     case O_SSOCKOPT:
1956         if ((arg[1].arg_type & A_MASK) == A_WORD)
1957             stab = arg[1].arg_ptr.arg_stab;
1958         else
1959             stab = stabent(str_get(st[1]),TRUE);
1960         sp = do_sopt(optype,stab,arglast);
1961         goto array_return;
1962     case O_GETSOCKNAME:
1963     case O_GETPEERNAME:
1964         if ((arg[1].arg_type & A_MASK) == A_WORD)
1965             stab = arg[1].arg_ptr.arg_stab;
1966         else
1967             stab = stabent(str_get(st[1]),TRUE);
1968         sp = do_getsockname(optype,stab,arglast);
1969         goto array_return;
1970
1971 #else /* SOCKET not defined */
1972     case O_SOCKET:
1973     case O_BIND:
1974     case O_CONNECT:
1975     case O_LISTEN:
1976     case O_ACCEPT:
1977     case O_SSELECT:
1978     case O_SOCKETPAIR:
1979     case O_GHBYNAME:
1980     case O_GHBYADDR:
1981     case O_GHOSTENT:
1982     case O_GNBYNAME:
1983     case O_GNBYADDR:
1984     case O_GNETENT:
1985     case O_GPBYNAME:
1986     case O_GPBYNUMBER:
1987     case O_GPROTOENT:
1988     case O_GSBYNAME:
1989     case O_GSBYPORT:
1990     case O_GSERVENT:
1991     case O_SHOSTENT:
1992     case O_SNETENT:
1993     case O_SPROTOENT:
1994     case O_SSERVENT:
1995     case O_EHOSTENT:
1996     case O_ENETENT:
1997     case O_EPROTOENT:
1998     case O_ESERVENT:
1999     case O_SHUTDOWN:
2000     case O_GSOCKOPT:
2001     case O_SSOCKOPT:
2002     case O_GETSOCKNAME:
2003     case O_GETPEERNAME:
2004       badsock:
2005         fatal("Unsupported socket function");
2006 #endif /* SOCKET */
2007     case O_FILENO:
2008         if (maxarg < 1)
2009             goto say_undef;
2010         if ((arg[1].arg_type & A_MASK) == A_WORD)
2011             stab = arg[1].arg_ptr.arg_stab;
2012         else
2013             stab = stabent(str_get(st[1]),TRUE);
2014         if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
2015             goto say_undef;
2016         value = fileno(fp);
2017         goto donumset;
2018     case O_VEC:
2019         sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
2020         goto array_return;
2021     case O_GPWNAM:
2022     case O_GPWUID:
2023     case O_GPWENT:
2024         sp = do_gpwent(optype,
2025           gimme,arglast);
2026         goto array_return;
2027     case O_SPWENT:
2028         value = (double) setpwent();
2029         goto donumset;
2030     case O_EPWENT:
2031         value = (double) endpwent();
2032         goto donumset;
2033     case O_GGRNAM:
2034     case O_GGRGID:
2035     case O_GGRENT:
2036         sp = do_ggrent(optype,
2037           gimme,arglast);
2038         goto array_return;
2039     case O_SGRENT:
2040         value = (double) setgrent();
2041         goto donumset;
2042     case O_EGRENT:
2043         value = (double) endgrent();
2044         goto donumset;
2045     case O_GETLOGIN:
2046         if (!(tmps = getlogin()))
2047             goto say_undef;
2048         str_set(str,tmps);
2049         break;
2050     case O_OPENDIR:
2051     case O_READDIR:
2052     case O_TELLDIR:
2053     case O_SEEKDIR:
2054     case O_REWINDDIR:
2055     case O_CLOSEDIR:
2056         if (maxarg < 1)
2057             goto say_undef;
2058         if ((arg[1].arg_type & A_MASK) == A_WORD)
2059             stab = arg[1].arg_ptr.arg_stab;
2060         else
2061             stab = stabent(str_get(st[1]),TRUE);
2062         sp = do_dirop(optype,stab,gimme,arglast);
2063         goto array_return;
2064     case O_SYSCALL:
2065         value = (double)do_syscall(arglast);
2066         goto donumset;
2067     }
2068
2069   normal_return:
2070     st[1] = str;
2071 #ifdef DEBUGGING
2072     if (debug) {
2073         dlevel--;
2074         if (debug & 8)
2075             deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
2076     }
2077 #endif
2078     return arglast[0] + 1;
2079
2080 array_return:
2081 #ifdef DEBUGGING
2082     if (debug) {
2083         dlevel--;
2084         if (debug & 8)
2085             deb("%s RETURNS ARRAY OF %d ARGS\n",opname[optype],sp - arglast[0]);
2086     }
2087 #endif
2088     return sp;
2089
2090 say_yes:
2091     str = &str_yes;
2092     goto normal_return;
2093
2094 say_no:
2095     str = &str_no;
2096     goto normal_return;
2097
2098 say_undef:
2099     str = &str_undef;
2100     goto normal_return;
2101
2102 say_zero:
2103     value = 0.0;
2104     /* FALL THROUGH */
2105
2106 donumset:
2107     str_numset(str,value);
2108     STABSET(str);
2109     st[1] = str;
2110 #ifdef DEBUGGING
2111     if (debug) {
2112         dlevel--;
2113         if (debug & 8)
2114             deb("%s RETURNS \"%f\"\n",opname[optype],value);
2115     }
2116 #endif
2117     return arglast[0] + 1;
2118 }