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