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