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