projects / unix-history / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
BSD 4_4_Lite2 development
[unix-history] / usr / src / contrib / perl-4.036 / eval.c
CommitLineData
ca2dddd6
C		 1/* $RCSfile: eval.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 13:20:20 $
2 *
3 * Copyright (c) 1991, Larry Wall
4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
8 * $Log: eval.c,v $
9 * Revision 4.0.1.4 92/06/08 13:20:20 lwall
10 * patch20: added explicit time_t support
11 * patch20: fixed confusion between a *var's real name and its effective name
12 * patch20: added Atari ST portability
13 * patch20: new warning for use of x with non-numeric right operand
14 * patch20: modulus with highest bit in left operand set didn't always work
15 * patch20: dbmclose(%array) didn't work
16 * patch20: added ... as variant on ..
17 * patch20: O_PIPE conflicted with Atari
18 *
19 * Revision 4.0.1.3 91/11/05 17:15:21 lwall
20 * patch11: prepared for ctype implementations that don't define isascii()
21 * patch11: various portability fixes
22 * patch11: added sort {} LIST
23 * patch11: added eval {}
24 * patch11: sysread() in socket was substituting recv()
25 * patch11: a last statement outside any block caused occasional core dumps
26 * patch11: missing arguments caused core dump in -D8 code
27 * patch11: eval 'stuff' now optimized to eval {stuff}
28 *
29 * Revision 4.0.1.2 91/06/07 11:07:23 lwall
30 * patch4: new copyright notice
31 * patch4: length($`), length($&), length($') now optimized to avoid string copy
32 * patch4: assignment wasn't correctly de-tainting the assigned variable.
33 * patch4: default top-of-form format is now FILEHANDLE_TOP
34 * patch4: added $^P variable to control calling of perldb routines
35 * patch4: taintchecks could improperly modify parent in vfork()
36 * patch4: many, many itty-bitty portability fixes
37 *
38 * Revision 4.0.1.1 91/04/11 17:43:48 lwall
39 * patch1: fixed failed fork to return undef as documented
40 * patch1: reduced maximum branch distance in eval.c
41 *
42 * Revision 4.0 91/03/20 01:16:48 lwall
43 * 4.0 baseline.
44 *
45 */
46
47#include "EXTERN.h"
48#include "perl.h"
49
50#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
51#include <signal.h>
52#endif
53
54#ifdef I_FCNTL
55#include <fcntl.h>
56#endif
57#ifdef MSDOS
58/* I_FCNTL *MUST* not be defined for MS-DOS and OS/2
59 but fcntl.h is required for O_BINARY */
60#include <fcntl.h>
61#endif
62#ifdef I_SYS_FILE
63#include <sys/file.h>
64#endif
65#ifdef I_VFORK
66# include <vfork.h>
67#endif
68
69#ifdef VOIDSIG
70static void (*ihand)();
71static void (*qhand)();
72#else
73static int (*ihand)();
74static int (*qhand)();
75#endif
76
77ARG *debarg;
78STR str_args;
79static STAB *stab2;
80static STIO *stio;
81static struct lstring *lstr;
82static int old_rschar;
83static int old_rslen;
84
85double sin(), cos(), atan2(), pow();
86
87char *getlogin();
88
89int
90eval(arg,gimme,sp)
91register ARG *arg;
92int gimme;
93register int sp;
94{
95 register STR *str;
96 register int anum;
97 register int optype;
98 register STR **st;
99 int maxarg;
100 double value;
101 register char *tmps;
102 char *tmps2;
103 int argflags;
104 int argtype;
105 union argptr argptr;
106 int arglast[8]; /* highest sp for arg--valid only for non-O_LIST args */
107 unsigned long tmpulong;
108 long tmplong;
109 time_t when;
110 STRLEN tmplen;
111 FILE *fp;
112 STR *tmpstr;
113 FCMD *form;
114 STAB *stab;
115 ARRAY *ary;
116 bool assigning = FALSE;
117 double exp(), log(), sqrt(), modf();
118 char *crypt(), *getenv();
119 extern void grow_dlevel();
120
121 if (!arg)
122 goto say_undef;
123 optype = arg->arg_type;
124 maxarg = arg->arg_len;
125 arglast[0] = sp;
126 str = arg->arg_ptr.arg_str;
127 if (sp + maxarg > stack->ary_max)
128 astore(stack, sp + maxarg, Nullstr);
129 st = stack->ary_array;
130
131#ifdef DEBUGGING
132 if (debug) {
133 if (debug & 8) {
134 deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
135 }
136 debname[dlevel] = opname[optype][0];
137 debdelim[dlevel] = ':';
138 if (++dlevel >= dlmax)
139 grow_dlevel();
140 }
141#endif
142
143 for (anum = 1; anum <= maxarg; anum++) {
144 argflags = arg[anum].arg_flags;
145 argtype = arg[anum].arg_type;
146 argptr = arg[anum].arg_ptr;
147 re_eval:
148 switch (argtype) {
149 default:
150 st[++sp] = &str_undef;
151#ifdef DEBUGGING
152 tmps = "NULL";
153#endif
154 break;
155 case A_EXPR:
156#ifdef DEBUGGING
157 if (debug & 8) {
158 tmps = "EXPR";
159 deb("%d.EXPR =>\n",anum);
160 }
161#endif
162 sp = eval(argptr.arg_arg,
163 (argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp);
164 if (sp + (maxarg - anum) > stack->ary_max)
165 astore(stack, sp + (maxarg - anum), Nullstr);
166 st = stack->ary_array; /* possibly reallocated */
167 break;
168 case A_CMD:
169#ifdef DEBUGGING
170 if (debug & 8) {
171 tmps = "CMD";
172 deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
173 }
174#endif
175 sp = cmd_exec(argptr.arg_cmd, gimme, sp);
176 if (sp + (maxarg - anum) > stack->ary_max)
177 astore(stack, sp + (maxarg - anum), Nullstr);
178 st = stack->ary_array; /* possibly reallocated */
179 break;
180 case A_LARYSTAB:
181 ++sp;
182 switch (optype) {
183 case O_ITEM2: argtype = 2; break;
184 case O_ITEM3: argtype = 3; break;
185 default: argtype = anum; break;
186 }
187 str = afetch(stab_array(argptr.arg_stab),
188 arg[argtype].arg_len - arybase, TRUE);
189#ifdef DEBUGGING
190 if (debug & 8) {
191 (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
192 arg[argtype].arg_len);
193 tmps = buf;
194 }
195#endif
196 goto do_crement;
197 case A_ARYSTAB:
198 switch (optype) {
199 case O_ITEM2: argtype = 2; break;
200 case O_ITEM3: argtype = 3; break;
201 default: argtype = anum; break;
202 }
203 st[++sp] = afetch(stab_array(argptr.arg_stab),
204 arg[argtype].arg_len - arybase, FALSE);
205#ifdef DEBUGGING
206 if (debug & 8) {
207 (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
208 arg[argtype].arg_len);
209 tmps = buf;
210 }
211#endif
212 break;
213 case A_STAR:
214 stab = argptr.arg_stab;
215 st[++sp] = (STR*)stab;
216 if (!stab_xarray(stab))
217 aadd(stab);
218 if (!stab_xhash(stab))
219 hadd(stab);
220 if (!stab_io(stab))
221 stab_io(stab) = stio_new();
222#ifdef DEBUGGING
223 if (debug & 8) {
224 (void)sprintf(buf,"STAR *%s -> *%s",
225 stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
226 tmps = buf;
227 }
228#endif
229 break;
230 case A_LSTAR:
231 str = st[++sp] = (STR*)argptr.arg_stab;
232#ifdef DEBUGGING
233 if (debug & 8) {
234 (void)sprintf(buf,"LSTAR *%s -> *%s",
235 stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
236 tmps = buf;
237 }
238#endif
239 break;
240 case A_STAB:
241 st[++sp] = STAB_STR(argptr.arg_stab);
242#ifdef DEBUGGING
243 if (debug & 8) {
244 (void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab));
245 tmps = buf;
246 }
247#endif
248 break;
249 case A_LENSTAB:
250 str_numset(str, (double)STAB_LEN(argptr.arg_stab));
251 st[++sp] = str;
252#ifdef DEBUGGING
253 if (debug & 8) {
254 (void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab));
255 tmps = buf;
256 }
257#endif
258 break;
259 case A_LEXPR:
260#ifdef DEBUGGING
261 if (debug & 8) {
262 tmps = "LEXPR";
263 deb("%d.LEXPR =>\n",anum);
264 }
265#endif
266 if (argflags & AF_ARYOK) {
267 sp = eval(argptr.arg_arg, G_ARRAY, sp);
268 if (sp + (maxarg - anum) > stack->ary_max)
269 astore(stack, sp + (maxarg - anum), Nullstr);
270 st = stack->ary_array; /* possibly reallocated */
271 }
272 else {
273 sp = eval(argptr.arg_arg, G_SCALAR, sp);
274 st = stack->ary_array; /* possibly reallocated */
275 str = st[sp];
276 goto do_crement;
277 }
278 break;
279 case A_LVAL:
280#ifdef DEBUGGING
281 if (debug & 8) {
282 (void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab));
283 tmps = buf;
284 }
285#endif
286 ++sp;
287 str = STAB_STR(argptr.arg_stab);
288 if (!str)
289 fatal("panic: A_LVAL");
290 do_crement:
291 assigning = TRUE;
292 if (argflags & AF_PRE) {
293 if (argflags & AF_UP)
294 str_inc(str);
295 else
296 str_dec(str);
297 STABSET(str);
298 st[sp] = str;
299 str = arg->arg_ptr.arg_str;
300 }
301 else if (argflags & AF_POST) {
302 st[sp] = str_mortal(str);
303 if (argflags & AF_UP)
304 str_inc(str);
305 else
306 str_dec(str);
307 STABSET(str);
308 str = arg->arg_ptr.arg_str;
309 }
310 else
311 st[sp] = str;
312 break;
313 case A_LARYLEN:
314 ++sp;
315 stab = argptr.arg_stab;
316 str = stab_array(argptr.arg_stab)->ary_magic;
317 if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST))
318 str_numset(str,(double)(stab_array(stab)->ary_fill+arybase));
319#ifdef DEBUGGING
320 tmps = "LARYLEN";
321#endif
322 if (!str)
323 fatal("panic: A_LEXPR");
324 goto do_crement;
325 case A_ARYLEN:
326 stab = argptr.arg_stab;
327 st[++sp] = stab_array(stab)->ary_magic;
328 str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase));
329#ifdef DEBUGGING
330 tmps = "ARYLEN";
331#endif
332 break;
333 case A_SINGLE:
334 st[++sp] = argptr.arg_str;
335#ifdef DEBUGGING
336 tmps = "SINGLE";
337#endif
338 break;
339 case A_DOUBLE:
340 (void) interp(str,argptr.arg_str,sp);
341 st = stack->ary_array;
342 st[++sp] = str;
343#ifdef DEBUGGING
344 tmps = "DOUBLE";
345#endif
346 break;
347 case A_BACKTICK:
348 tmps = str_get(interp(str,argptr.arg_str,sp));
349 st = stack->ary_array;
350#ifdef TAINT
351 taintproper("Insecure dependency in ``");
352#endif
353 fp = mypopen(tmps,"r");
354 str_set(str,"");
355 if (fp) {
356 if (gimme == G_SCALAR) {
357 while (str_gets(str,fp,str->str_cur) != Nullch)
358 /*SUPPRESS 530*/
359 ;
360 }
361 else {
362 for (;;) {
363 if (++sp > stack->ary_max) {
364 astore(stack, sp, Nullstr);
365 st = stack->ary_array;
366 }
367 str = st[sp] = Str_new(56,80);
368 if (str_gets(str,fp,0) == Nullch) {
369 sp--;
370 break;
371 }
372 if (str->str_len - str->str_cur > 20) {
373 str->str_len = str->str_cur+1;
374 Renew(str->str_ptr, str->str_len, char);
375 }
376 str_2mortal(str);
377 }
378 }
379 statusvalue = mypclose(fp);
380 }
381 else
382 statusvalue = -1;
383
384 if (gimme == G_SCALAR)
385 st[++sp] = str;
386#ifdef DEBUGGING
387 tmps = "BACK";
388#endif
389 break;
390 case A_WANTARRAY:
391 {
392 if (curcsv->wantarray == G_ARRAY)
393 st[++sp] = &str_yes;
394 else
395 st[++sp] = &str_no;
396 }
397#ifdef DEBUGGING
398 tmps = "WANTARRAY";
399#endif
400 break;
401 case A_INDREAD:
402 last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
403 old_rschar = rschar;
404 old_rslen = rslen;
405 goto do_read;
406 case A_GLOB:
407 argflags |= AF_POST; /* enable newline chopping */
408 last_in_stab = argptr.arg_stab;
409 old_rschar = rschar;
410 old_rslen = rslen;
411 rslen = 1;
412#ifdef DOSISH
413 rschar = 0;
414#else
415#ifdef CSH
416 rschar = 0;
417#else
418 rschar = '\n';
419#endif /* !CSH */
420#endif /* !MSDOS */
421 goto do_read;
422 case A_READ:
423 last_in_stab = argptr.arg_stab;
424 old_rschar = rschar;
425 old_rslen = rslen;
426 do_read:
427 if (anum > 1) /* assign to scalar */
428 gimme = G_SCALAR; /* force context to scalar */
429 if (gimme == G_ARRAY)
430 str = Str_new(57,0);
431 ++sp;
432 fp = Nullfp;
433 if (stab_io(last_in_stab)) {
434 fp = stab_io(last_in_stab)->ifp;
435 if (!fp) {
436 if (stab_io(last_in_stab)->flags & IOF_ARGV) {
437 if (stab_io(last_in_stab)->flags & IOF_START) {
438 stab_io(last_in_stab)->flags &= ~IOF_START;
439 stab_io(last_in_stab)->lines = 0;
440 if (alen(stab_array(last_in_stab)) < 0) {
441 tmpstr = str_make("-",1); /* assume stdin */
442 (void)apush(stab_array(last_in_stab), tmpstr);
443 }
444 }
445 fp = nextargv(last_in_stab);
446 if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */
447 (void)do_close(last_in_stab,FALSE); /* now it does*/
448 stab_io(last_in_stab)->flags |= IOF_START;
449 }
450 }
451 else if (argtype == A_GLOB) {
452 (void) interp(str,stab_val(last_in_stab),sp);
453 st = stack->ary_array;
454 tmpstr = Str_new(55,0);
455#ifdef DOSISH
456 str_set(tmpstr, "perlglob ");
457 str_scat(tmpstr,str);
458 str_cat(tmpstr," |");
459#else
460#ifdef CSH
461 str_nset(tmpstr,cshname,cshlen);
462 str_cat(tmpstr," -cf 'set nonomatch; glob ");
463 str_scat(tmpstr,str);
464 str_cat(tmpstr,"'|");
465#else
466 str_set(tmpstr, "echo ");
467 str_scat(tmpstr,str);
468 str_cat(tmpstr,
469 "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
470#endif /* !CSH */
471#endif /* !MSDOS */
472 (void)do_open(last_in_stab,tmpstr->str_ptr,
473 tmpstr->str_cur);
474 fp = stab_io(last_in_stab)->ifp;
475 str_free(tmpstr);
476 }
477 }
478 }
479 if (!fp && dowarn)
480 warn("Read on closed filehandle <%s>",stab_ename(last_in_stab));
481 tmplen = str->str_len; /* remember if already alloced */
482 if (!tmplen)
483 Str_Grow(str,80); /* try short-buffering it */
484 keepgoing:
485 if (!fp)
486 st[sp] = &str_undef;
487 else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) {
488 clearerr(fp);
489 if (stab_io(last_in_stab)->flags & IOF_ARGV) {
490 fp = nextargv(last_in_stab);
491 if (fp)
492 goto keepgoing;
493 (void)do_close(last_in_stab,FALSE);
494 stab_io(last_in_stab)->flags |= IOF_START;
495 }
496 else if (argflags & AF_POST) {
497 (void)do_close(last_in_stab,FALSE);
498 }
499 st[sp] = &str_undef;
500 rschar = old_rschar;
501 rslen = old_rslen;
502 if (gimme == G_ARRAY) {
503 --sp;
504 str_2mortal(str);
505 goto array_return;
506 }
507 break;
508 }
509 else {
510 stab_io(last_in_stab)->lines++;
511 st[sp] = str;
512#ifdef TAINT
513 str->str_tainted = 1; /* Anything from the outside world...*/
514#endif
515 if (argflags & AF_POST) {
516 if (str->str_cur > 0)
517 str->str_cur--;
518 if (str->str_ptr[str->str_cur] == rschar)
519 str->str_ptr[str->str_cur] = '\0';
520 else
521 str->str_cur++;
522 for (tmps = str->str_ptr; *tmps; tmps++)
523 if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
524 index("$&*(){}[]'\";\\|?<>~`",*tmps))
525 break;
526 if (*tmps && stat(str->str_ptr,&statbuf) < 0)
527 goto keepgoing; /* unmatched wildcard? */
528 }
529 if (gimme == G_ARRAY) {
530 if (str->str_len - str->str_cur > 20) {
531 str->str_len = str->str_cur+1;
532 Renew(str->str_ptr, str->str_len, char);
533 }
534 str_2mortal(str);
535 if (++sp > stack->ary_max) {
536 astore(stack, sp, Nullstr);
537 st = stack->ary_array;
538 }
539 str = Str_new(58,80);
540 goto keepgoing;
541 }
542 else if (!tmplen && str->str_len - str->str_cur > 80) {
543 /* try to reclaim a bit of scalar space on 1st alloc */
544 if (str->str_cur < 60)
545 str->str_len = 80;
546 else
547 str->str_len = str->str_cur+40; /* allow some slop */
548 Renew(str->str_ptr, str->str_len, char);
549 }
550 }
551 rschar = old_rschar;
552 rslen = old_rslen;
553#ifdef DEBUGGING
554 tmps = "READ";
555#endif
556 break;
557 }
558#ifdef DEBUGGING
559 if (debug & 8)
560 deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp]));
561#endif
562 if (anum < 8)
563 arglast[anum] = sp;
564 }
565
566 st += arglast[0];
567#ifdef SMALLSWITCHES
568 if (optype < O_CHOWN)
569#endif
570 switch (optype) {
571 case O_RCAT:
572 STABSET(str);
573 break;
574 case O_ITEM:
575 if (gimme == G_ARRAY)
576 goto array_return;
577 /* FALL THROUGH */
578 case O_SCALAR:
579 STR_SSET(str,st[1]);
580 STABSET(str);
581 break;
582 case O_ITEM2:
583 if (gimme == G_ARRAY)
584 goto array_return;
585 --anum;
586 STR_SSET(str,st[arglast[anum]-arglast[0]]);
587 STABSET(str);
588 break;
589 case O_ITEM3:
590 if (gimme == G_ARRAY)
591 goto array_return;
592 --anum;
593 STR_SSET(str,st[arglast[anum]-arglast[0]]);
594 STABSET(str);
595 break;
596 case O_CONCAT:
597 STR_SSET(str,st[1]);
598 str_scat(str,st[2]);
599 STABSET(str);
600 break;
601 case O_REPEAT:
602 if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) {
603 sp = do_repeatary(arglast);
604 goto array_return;
605 }
606 STR_SSET(str,st[1]);
607 anum = (int)str_gnum(st[2]);
608 if (anum >= 1) {
609 tmpstr = Str_new(50, 0);
610 tmps = str_get(str);
611 str_nset(tmpstr,tmps,str->str_cur);
612 tmps = str_get(tmpstr); /* force to be string */
613 STR_GROW(str, (anum * str->str_cur) + 1);
614 repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
615 str->str_cur *= anum;
616 str->str_ptr[str->str_cur] = '\0';
617 str->str_nok = 0;
618 str_free(tmpstr);
619 }
620 else {
621 if (dowarn && st[2]->str_pok && !looks_like_number(st[2]))
622 warn("Right operand of x is not numeric");
623 str_sset(str,&str_no);
624 }
625 STABSET(str);
626 break;
627 case O_MATCH:
628 sp = do_match(str,arg,
629 gimme,arglast);
630 if (gimme == G_ARRAY)
631 goto array_return;
632 STABSET(str);
633 break;
634 case O_NMATCH:
635 sp = do_match(str,arg,
636 G_SCALAR,arglast);
637 str_sset(str, str_true(str) ? &str_no : &str_yes);
638 STABSET(str);
639 break;
640 case O_SUBST:
641 sp = do_subst(str,arg,arglast[0]);
642 goto array_return;
643 case O_NSUBST:
644 sp = do_subst(str,arg,arglast[0]);
645 str = arg->arg_ptr.arg_str;
646 str_set(str, str_true(str) ? No : Yes);
647 goto array_return;
648 case O_ASSIGN:
649 if (arg[1].arg_flags & AF_ARYOK) {
650 if (arg->arg_len == 1) {
651 arg->arg_type = O_LOCAL;
652 goto local;
653 }
654 else {
655 arg->arg_type = O_AASSIGN;
656 goto aassign;
657 }
658 }
659 else {
660 arg->arg_type = O_SASSIGN;
661 goto sassign;
662 }
663 case O_LOCAL:
664 local:
665 arglast[2] = arglast[1]; /* push a null array */
666 /* FALL THROUGH */
667 case O_AASSIGN:
668 aassign:
669 sp = do_assign(arg,
670 gimme,arglast);
671 goto array_return;
672 case O_SASSIGN:
673 sassign:
674#ifdef TAINT
675 if (tainted && !st[2]->str_tainted)
676 tainted = 0;
677#endif
678 STR_SSET(str, st[2]);
679 STABSET(str);
680 break;
681 case O_CHOP:
682 st -= arglast[0];
683 str = arg->arg_ptr.arg_str;
684 for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
685 do_chop(str,st[sp]);
686 st += arglast[0];
687 break;
688 case O_DEFINED:
689 if (arg[1].arg_type & A_DONT) {
690 sp = do_defined(str,arg,
691 gimme,arglast);
692 goto array_return;
693 }
694 else if (str->str_pok || str->str_nok)
695 goto say_yes;
696 goto say_no;
697 case O_UNDEF:
698 if (arg[1].arg_type & A_DONT) {
699 sp = do_undef(str,arg,
700 gimme,arglast);
701 goto array_return;
702 }
703 else if (str != stab_val(defstab)) {
704 if (str->str_len) {
705 if (str->str_state == SS_INCR)
706 Str_Grow(str,0);
707 Safefree(str->str_ptr);
708 str->str_ptr = Nullch;
709 str->str_len = 0;
710 }
711 str->str_pok = str->str_nok = 0;
712 STABSET(str);
713 }
714 goto say_undef;
715 case O_STUDY:
716 sp = do_study(str,arg,
717 gimme,arglast);
718 goto array_return;
719 case O_POW:
720 value = str_gnum(st[1]);
721 value = pow(value,str_gnum(st[2]));
722 goto donumset;
723 case O_MULTIPLY:
724 value = str_gnum(st[1]);
725 value *= str_gnum(st[2]);
726 goto donumset;
727 case O_DIVIDE:
728 if ((value = str_gnum(st[2])) == 0.0)
729 fatal("Illegal division by zero");
730#ifdef SLOPPYDIVIDE
731 /* insure that 20./5. == 4. */
732 {
733 double x;
734 int k;
735 x = str_gnum(st[1]);
736 if ((double)(int)x == x &&
737 (double)(int)value == value &&
738 (k = (int)x/(int)value)*(int)value == (int)x) {
739 value = k;
740 } else {
741 value = x/value;
742 }
743 }
744#else
745 value = str_gnum(st[1]) / value;
746#endif
747 goto donumset;
748 case O_MODULO:
749 tmpulong = (unsigned long) str_gnum(st[2]);
750 if (tmpulong == 0L)
751 fatal("Illegal modulus zero");
752#ifndef lint
753 value = str_gnum(st[1]);
754 if (value >= 0.0)
755 value = (double)(((unsigned long)value) % tmpulong);
756 else {
757 tmplong = (long)value;
758 value = (double)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
759 }
760#endif
761 goto donumset;
762 case O_ADD:
763 value = str_gnum(st[1]);
764 value += str_gnum(st[2]);
765 goto donumset;
766 case O_SUBTRACT:
767 value = str_gnum(st[1]);
768 value -= str_gnum(st[2]);
769 goto donumset;
770 case O_LEFT_SHIFT:
771 value = str_gnum(st[1]);
772 anum = (int)str_gnum(st[2]);
773#ifndef lint
774 value = (double)(U_L(value) << anum);
775#endif
776 goto donumset;
777 case O_RIGHT_SHIFT:
778 value = str_gnum(st[1]);
779 anum = (int)str_gnum(st[2]);
780#ifndef lint
781 value = (double)(U_L(value) >> anum);
782#endif
783 goto donumset;
784 case O_LT:
785 value = str_gnum(st[1]);
786 value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
787 goto donumset;
788 case O_GT:
789 value = str_gnum(st[1]);
790 value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
791 goto donumset;
792 case O_LE:
793 value = str_gnum(st[1]);
794 value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
795 goto donumset;
796 case O_GE:
797 value = str_gnum(st[1]);
798 value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
799 goto donumset;
800 case O_EQ:
801 if (dowarn) {
802 if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
803 (!st[2]->str_nok && !looks_like_number(st[2])) )
804 warn("Possible use of == on string value");
805 }
806 value = str_gnum(st[1]);
807 value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
808 goto donumset;
809 case O_NE:
810 value = str_gnum(st[1]);
811 value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
812 goto donumset;
813 case O_NCMP:
814 value = str_gnum(st[1]);
815 value -= str_gnum(st[2]);
816 if (value > 0.0)
817 value = 1.0;
818 else if (value < 0.0)
819 value = -1.0;
820 goto donumset;
821 case O_BIT_AND:
822 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
823 value = str_gnum(st[1]);
824#ifndef lint
825 value = (double)(U_L(value) & U_L(str_gnum(st[2])));
826#endif
827 goto donumset;
828 }
829 else
830 do_vop(optype,str,st[1],st[2]);
831 break;
832 case O_XOR:
833 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
834 value = str_gnum(st[1]);
835#ifndef lint
836 value = (double)(U_L(value) ^ U_L(str_gnum(st[2])));
837#endif
838 goto donumset;
839 }
840 else
841 do_vop(optype,str,st[1],st[2]);
842 break;
843 case O_BIT_OR:
844 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
845 value = str_gnum(st[1]);
846#ifndef lint
847 value = (double)(U_L(value) | U_L(str_gnum(st[2])));
848#endif
849 goto donumset;
850 }
851 else
852 do_vop(optype,str,st[1],st[2]);
853 break;
854/* use register in evaluating str_true() */
855 case O_AND:
856 if (str_true(st[1])) {
857 anum = 2;
858 optype = O_ITEM2;
859 argflags = arg[anum].arg_flags;
860 if (gimme == G_ARRAY)
861 argflags |= AF_ARYOK;
862 argtype = arg[anum].arg_type & A_MASK;
863 argptr = arg[anum].arg_ptr;
864 maxarg = anum = 1;
865 sp = arglast[0];
866 st -= sp;
867 goto re_eval;
868 }
869 else {
870 if (assigning) {
871 str_sset(str, st[1]);
872 STABSET(str);
873 }
874 else
875 str = st[1];
876 break;
877 }
878 case O_OR:
879 if (str_true(st[1])) {
880 if (assigning) {
881 str_sset(str, st[1]);
882 STABSET(str);
883 }
884 else
885 str = st[1];
886 break;
887 }
888 else {
889 anum = 2;
890 optype = O_ITEM2;
891 argflags = arg[anum].arg_flags;
892 if (gimme == G_ARRAY)
893 argflags |= AF_ARYOK;
894 argtype = arg[anum].arg_type & A_MASK;
895 argptr = arg[anum].arg_ptr;
896 maxarg = anum = 1;
897 sp = arglast[0];
898 st -= sp;
899 goto re_eval;
900 }
901 case O_COND_EXPR:
902 anum = (str_true(st[1]) ? 2 : 3);
903 optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
904 argflags = arg[anum].arg_flags;
905 if (gimme == G_ARRAY)
906 argflags |= AF_ARYOK;
907 argtype = arg[anum].arg_type & A_MASK;
908 argptr = arg[anum].arg_ptr;
909 maxarg = anum = 1;
910 sp = arglast[0];
911 st -= sp;
912 goto re_eval;
913 case O_COMMA:
914 if (gimme == G_ARRAY)
915 goto array_return;
916 str = st[2];
917 break;
918 case O_NEGATE:
919 value = -str_gnum(st[1]);
920 goto donumset;
921 case O_NOT:
922#ifdef NOTNOT
923 { char xxx = str_true(st[1]); value = (double) !xxx; }
924#else
925 value = (double) !str_true(st[1]);
926#endif
927 goto donumset;
928 case O_COMPLEMENT:
929 if (!sawvec || st[1]->str_nok) {
930#ifndef lint
931 value = (double) ~U_L(str_gnum(st[1]));
932#endif
933 goto donumset;
934 }
935 else {
936 STR_SSET(str,st[1]);
937 tmps = str_get(str);
938 for (anum = str->str_cur; anum; anum--, tmps++)
939 *tmps = ~*tmps;
940 }
941 break;
942 case O_SELECT:
943 stab_efullname(str,defoutstab);
944 if (maxarg > 0) {
945 if ((arg[1].arg_type & A_MASK) == A_WORD)
946 defoutstab = arg[1].arg_ptr.arg_stab;
947 else
948 defoutstab = stabent(str_get(st[1]),TRUE);
949 if (!stab_io(defoutstab))
950 stab_io(defoutstab) = stio_new();
951 curoutstab = defoutstab;
952 }
953 STABSET(str);
954 break;
955 case O_WRITE:
956 if (maxarg == 0)
957 stab = defoutstab;
958 else if ((arg[1].arg_type & A_MASK) == A_WORD) {
959 if (!(stab = arg[1].arg_ptr.arg_stab))
960 stab = defoutstab;
961 }
962 else
963 stab = stabent(str_get(st[1]),TRUE);
964 if (!stab_io(stab)) {
965 str_set(str, No);
966 STABSET(str);
967 break;
968 }
969 curoutstab = stab;
970 fp = stab_io(stab)->ofp;
971 debarg = arg;
972 if (stab_io(stab)->fmt_stab)
973 form = stab_form(stab_io(stab)->fmt_stab);
974 else
975 form = stab_form(stab);
976 if (!form || !fp) {
977 if (dowarn) {
978 if (form)
979 warn("No format for filehandle");
980 else {
981 if (stab_io(stab)->ifp)
982 warn("Filehandle only opened for input");
983 else
984 warn("Write on closed filehandle");
985 }
986 }
987 str_set(str, No);
988 STABSET(str);
989 break;
990 }
991 format(&outrec,form,sp);
992 do_write(&outrec,stab,sp);
993 if (stab_io(stab)->flags & IOF_FLUSH)
994 (void)fflush(fp);
995 str_set(str, Yes);
996 STABSET(str);
997 break;
998 case O_DBMOPEN:
999#ifdef SOME_DBM
1000 anum = arg[1].arg_type & A_MASK;
1001 if (anum == A_WORD || anum == A_STAB)
1002 stab = arg[1].arg_ptr.arg_stab;
1003 else
1004 stab = stabent(str_get(st[1]),TRUE);
1005 if (st[3]->str_nok || st[3]->str_pok)
1006 anum = (int)str_gnum(st[3]);
1007 else
1008 anum = -1;
1009 value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
1010 goto donumset;
1011#else
1012 fatal("No dbm or ndbm on this machine");
1013#endif
1014 case O_DBMCLOSE:
1015#ifdef SOME_DBM
1016 anum = arg[1].arg_type & A_MASK;
1017 if (anum == A_WORD || anum == A_STAB)
1018 stab = arg[1].arg_ptr.arg_stab;
1019 else
1020 stab = stabent(str_get(st[1]),TRUE);
1021 hdbmclose(stab_hash(stab));
1022 goto say_yes;
1023#else
1024 fatal("No dbm or ndbm on this machine");
1025#endif
1026 case O_OPEN:
1027 if ((arg[1].arg_type & A_MASK) == A_WORD)
1028 stab = arg[1].arg_ptr.arg_stab;
1029 else
1030 stab = stabent(str_get(st[1]),TRUE);
1031 tmps = str_get(st[2]);
1032 if (do_open(stab,tmps,st[2]->str_cur)) {
1033 value = (double)forkprocess;
1034 stab_io(stab)->lines = 0;
1035 goto donumset;
1036 }
1037 else if (forkprocess == 0) /* we are a new child */
1038 goto say_zero;
1039 else
1040 goto say_undef;
1041 /* break; */
1042 case O_TRANS:
1043 value = (double) do_trans(str,arg);
1044 str = arg->arg_ptr.arg_str;
1045 goto donumset;
1046 case O_NTRANS:
1047 str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
1048 str = arg->arg_ptr.arg_str;
1049 break;
1050 case O_CLOSE:
1051 if (maxarg == 0)
1052 stab = defoutstab;
1053 else if ((arg[1].arg_type & A_MASK) == A_WORD)
1054 stab = arg[1].arg_ptr.arg_stab;
1055 else
1056 stab = stabent(str_get(st[1]),TRUE);
1057 str_set(str, do_close(stab,TRUE) ? Yes : No );
1058 STABSET(str);
1059 break;
1060 case O_EACH:
1061 sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
1062 gimme,arglast);
1063 goto array_return;
1064 case O_VALUES:
1065 case O_KEYS:
1066 sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
1067 gimme,arglast);
1068 goto array_return;
1069 case O_LARRAY:
1070 str->str_nok = str->str_pok = 0;
1071 str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
1072 str->str_state = SS_ARY;
1073 break;
1074 case O_ARRAY:
1075 ary = stab_array(arg[1].arg_ptr.arg_stab);
1076 maxarg = ary->ary_fill + 1;
1077 if (gimme == G_ARRAY) { /* array wanted */
1078 sp = arglast[0];
1079 st -= sp;
1080 if (maxarg > 0 && sp + maxarg > stack->ary_max) {
1081 astore(stack,sp + maxarg, Nullstr);
1082 st = stack->ary_array;
1083 }
1084 st += sp;
1085 Copy(ary->ary_array, &st[1], maxarg, STR*);
1086 sp += maxarg;
1087 goto array_return;
1088 }
1089 else {
1090 value = (double)maxarg;
1091 goto donumset;
1092 }
1093 case O_AELEM:
1094 anum = ((int)str_gnum(st[2])) - arybase;
1095 str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
1096 break;
1097 case O_DELETE:
1098 tmpstab = arg[1].arg_ptr.arg_stab;
1099 tmps = str_get(st[2]);
1100 str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
1101 if (tmpstab == envstab)
1102 my_setenv(tmps,Nullch);
1103 if (!str)
1104 goto say_undef;
1105 break;
1106 case O_LHASH:
1107 str->str_nok = str->str_pok = 0;
1108 str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
1109 str->str_state = SS_HASH;
1110 break;
1111 case O_HASH:
1112 if (gimme == G_ARRAY) { /* array wanted */
1113 sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
1114 gimme,arglast);
1115 goto array_return;
1116 }
1117 else {
1118 tmpstab = arg[1].arg_ptr.arg_stab;
1119 if (!stab_hash(tmpstab)->tbl_fill)
1120 goto say_zero;
1121 sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
1122 stab_hash(tmpstab)->tbl_max+1);
1123 str_set(str,buf);
1124 }
1125 break;
1126 case O_HELEM:
1127 tmpstab = arg[1].arg_ptr.arg_stab;
1128 tmps = str_get(st[2]);
1129 str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
1130 break;
1131 case O_LAELEM:
1132 anum = ((int)str_gnum(st[2])) - arybase;
1133 str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
1134 if (!str || str == &str_undef)
1135 fatal("Assignment to non-creatable value, subscript %d",anum);
1136 break;
1137 case O_LHELEM:
1138 tmpstab = arg[1].arg_ptr.arg_stab;
1139 tmps = str_get(st[2]);
1140 anum = st[2]->str_cur;
1141 str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
1142 if (!str || str == &str_undef)
1143 fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
1144 if (tmpstab == envstab) /* heavy wizardry going on here */
1145 str_magic(str, tmpstab, 'E', tmps, anum); /* str is now magic */
1146 /* he threw the brick up into the air */
1147 else if (tmpstab == sigstab)
1148 str_magic(str, tmpstab, 'S', tmps, anum);
1149#ifdef SOME_DBM
1150 else if (stab_hash(tmpstab)->tbl_dbm)
1151 str_magic(str, tmpstab, 'D', tmps, anum);
1152#endif
1153 else if (tmpstab == DBline)
1154 str_magic(str, tmpstab, 'L', tmps, anum);
1155 break;
1156 case O_LSLICE:
1157 anum = 2;
1158 argtype = FALSE;
1159 goto do_slice_already;
1160 case O_ASLICE:
1161 anum = 1;
1162 argtype = FALSE;
1163 goto do_slice_already;
1164 case O_HSLICE:
1165 anum = 0;
1166 argtype = FALSE;
1167 goto do_slice_already;
1168 case O_LASLICE:
1169 anum = 1;
1170 argtype = TRUE;
1171 goto do_slice_already;
1172 case O_LHSLICE:
1173 anum = 0;
1174 argtype = TRUE;
1175 do_slice_already:
1176 sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype,
1177 gimme,arglast);
1178 goto array_return;
1179 case O_SPLICE:
1180 sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast);
1181 goto array_return;
1182 case O_PUSH:
1183 if (arglast[2] - arglast[1] != 1)
1184 str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
1185 else {
1186 str = Str_new(51,0); /* must copy the STR */
1187 str_sset(str,st[2]);
1188 (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
1189 }
1190 break;
1191 case O_POP:
1192 str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
1193 goto staticalization;
1194 case O_SHIFT:
1195 str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
1196 staticalization:
1197 if (!str)
1198 goto say_undef;
1199 if (ary->ary_flags & ARF_REAL)
1200 (void)str_2mortal(str);
1201 break;
1202 case O_UNPACK:
1203 sp = do_unpack(str,gimme,arglast);
1204 goto array_return;
1205 case O_SPLIT:
1206 value = str_gnum(st[3]);
1207 sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
1208 gimme,arglast);
1209 goto array_return;
1210 case O_LENGTH:
1211 if (maxarg < 1)
1212 value = (double)str_len(stab_val(defstab));
1213 else
1214 value = (double)str_len(st[1]);
1215 goto donumset;
1216 case O_SPRINTF:
1217 do_sprintf(str, sp-arglast[0], st+1);
1218 break;
1219 case O_SUBSTR:
1220 anum = ((int)str_gnum(st[2])) - arybase; /* anum=where to start*/
1221 tmps = str_get(st[1]); /* force conversion to string */
1222 /*SUPPRESS 560*/
1223 if (argtype = (str == st[1]))
1224 str = arg->arg_ptr.arg_str;
1225 if (anum < 0)
1226 anum += st[1]->str_cur + arybase;
1227 if (anum < 0 || anum > st[1]->str_cur)
1228 str_nset(str,"",0);
1229 else {
1230 optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]);
1231 if (optype < 0)
1232 optype = 0;
1233 tmps += anum;
1234 anum = st[1]->str_cur - anum; /* anum=how many bytes left*/
1235 if (anum > optype)
1236 anum = optype;
1237 str_nset(str, tmps, anum);
1238 if (argtype) { /* it's an lvalue! */
1239 lstr = (struct lstring*)str;
1240 str->str_magic = st[1];
1241 st[1]->str_rare = 's';
1242 lstr->lstr_offset = tmps - str_get(st[1]);
1243 lstr->lstr_len = anum;
1244 }
1245 }
1246 break;
1247 case O_PACK:
1248 /*SUPPRESS 701*/
1249 (void)do_pack(str,arglast);
1250 break;
1251 case O_GREP:
1252 sp = do_grep(arg,str,gimme,arglast);
1253 goto array_return;
1254 case O_JOIN:
1255 do_join(str,arglast);
1256 break;
1257 case O_SLT:
1258 tmps = str_get(st[1]);
1259 value = (double) (str_cmp(st[1],st[2]) < 0);
1260 goto donumset;
1261 case O_SGT:
1262 tmps = str_get(st[1]);
1263 value = (double) (str_cmp(st[1],st[2]) > 0);
1264 goto donumset;
1265 case O_SLE:
1266 tmps = str_get(st[1]);
1267 value = (double) (str_cmp(st[1],st[2]) <= 0);
1268 goto donumset;
1269 case O_SGE:
1270 tmps = str_get(st[1]);
1271 value = (double) (str_cmp(st[1],st[2]) >= 0);
1272 goto donumset;
1273 case O_SEQ:
1274 tmps = str_get(st[1]);
1275 value = (double) str_eq(st[1],st[2]);
1276 goto donumset;
1277 case O_SNE:
1278 tmps = str_get(st[1]);
1279 value = (double) !str_eq(st[1],st[2]);
1280 goto donumset;
1281 case O_SCMP:
1282 tmps = str_get(st[1]);
1283 value = (double) str_cmp(st[1],st[2]);
1284 goto donumset;
1285 case O_SUBR:
1286 sp = do_subr(arg,gimme,arglast);
1287 st = stack->ary_array + arglast[0]; /* maybe realloced */
1288 goto array_return;
1289 case O_DBSUBR:
1290 sp = do_subr(arg,gimme,arglast);
1291 st = stack->ary_array + arglast[0]; /* maybe realloced */
1292 goto array_return;
1293 case O_CALLER:
1294 sp = do_caller(arg,maxarg,gimme,arglast);
1295 st = stack->ary_array + arglast[0]; /* maybe realloced */
1296 goto array_return;
1297 case O_SORT:
1298 sp = do_sort(str,arg,
1299 gimme,arglast);
1300 goto array_return;
1301 case O_REVERSE:
1302 if (gimme == G_ARRAY)
1303 sp = do_reverse(arglast);
1304 else
1305 sp = do_sreverse(str, arglast);
1306 goto array_return;
1307 case O_WARN:
1308 if (arglast[2] - arglast[1] != 1) {
1309 do_join(str,arglast);
1310 tmps = str_get(str);
1311 }
1312 else {
1313 str = st[2];
1314 tmps = str_get(st[2]);
1315 }
1316 if (!tmps || !*tmps)
1317 tmps = "Warning: something's wrong";
1318 warn("%s",tmps);
1319 goto say_yes;
1320 case O_DIE:
1321 if (arglast[2] - arglast[1] != 1) {
1322 do_join(str,arglast);
1323 tmps = str_get(str);
1324 }
1325 else {
1326 str = st[2];
1327 tmps = str_get(st[2]);
1328 }
1329 if (!tmps || !*tmps)
1330 tmps = "Died";
1331 fatal("%s",tmps);
1332 goto say_zero;
1333 case O_PRTF:
1334 case O_PRINT:
1335 if ((arg[1].arg_type & A_MASK) == A_WORD)
1336 stab = arg[1].arg_ptr.arg_stab;
1337 else
1338 stab = stabent(str_get(st[1]),TRUE);
1339 if (!stab)
1340 stab = defoutstab;
1341 if (!stab_io(stab)) {
1342 if (dowarn)
1343 warn("Filehandle never opened");
1344 goto say_zero;
1345 }
1346 if (!(fp = stab_io(stab)->ofp)) {
1347 if (dowarn) {
1348 if (stab_io(stab)->ifp)
1349 warn("Filehandle opened only for input");
1350 else
1351 warn("Print on closed filehandle");
1352 }
1353 goto say_zero;
1354 }
1355 else {
1356 if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
1357 value = (double)do_aprint(arg,fp,arglast);
1358 else {
1359 value = (double)do_print(st[2],fp);
1360 if (orslen && optype == O_PRINT)
1361 if (fwrite(ors, 1, orslen, fp) == 0)
1362 goto say_zero;
1363 }
1364 if (stab_io(stab)->flags & IOF_FLUSH)
1365 if (fflush(fp) == EOF)
1366 goto say_zero;
1367 }
1368 goto donumset;
1369 case O_CHDIR:
1370 if (maxarg < 1)
1371 tmps = Nullch;
1372 else
1373 tmps = str_get(st[1]);
1374 if (!tmps || !*tmps) {
1375 tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
1376 tmps = str_get(tmpstr);
1377 }
1378 if (!tmps || !*tmps) {
1379 tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
1380 tmps = str_get(tmpstr);
1381 }
1382#ifdef TAINT
1383 taintproper("Insecure dependency in chdir");
1384#endif
1385 value = (double)(chdir(tmps) >= 0);
1386 goto donumset;
1387 case O_EXIT:
1388 if (maxarg < 1)
1389 anum = 0;
1390 else
1391 anum = (int)str_gnum(st[1]);
1392 exit(anum);
1393 goto say_zero;
1394 case O_RESET:
1395 if (maxarg < 1)
1396 tmps = "";
1397 else
1398 tmps = str_get(st[1]);
1399 str_reset(tmps,curcmd->c_stash);
1400 value = 1.0;
1401 goto donumset;
1402 case O_LIST:
1403 if (gimme == G_ARRAY)
1404 goto array_return;
1405 if (maxarg > 0)
1406 str = st[sp - arglast[0]]; /* unwanted list, return last item */
1407 else
1408 str = &str_undef;
1409 break;
1410 case O_EOF:
1411 if (maxarg <= 0)
1412 stab = last_in_stab;
1413 else if ((arg[1].arg_type & A_MASK) == A_WORD)
1414 stab = arg[1].arg_ptr.arg_stab;
1415 else
1416 stab = stabent(str_get(st[1]),TRUE);
1417 str_set(str, do_eof(stab) ? Yes : No);
1418 STABSET(str);
1419 break;
1420 case O_GETC:
1421 if (maxarg <= 0)
1422 stab = stdinstab;
1423 else if ((arg[1].arg_type & A_MASK) == A_WORD)
1424 stab = arg[1].arg_ptr.arg_stab;
1425 else
1426 stab = stabent(str_get(st[1]),TRUE);
1427 if (!stab)
1428 stab = argvstab;
1429 if (!stab || do_eof(stab)) /* make sure we have fp with something */
1430 goto say_undef;
1431 else {
1432#ifdef TAINT
1433 tainted = 1;
1434#endif
1435 str_set(str," ");
1436 *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
1437 }
1438 STABSET(str);
1439 break;
1440 case O_TELL:
1441 if (maxarg <= 0)
1442 stab = last_in_stab;
1443 else if ((arg[1].arg_type & A_MASK) == A_WORD)
1444 stab = arg[1].arg_ptr.arg_stab;
1445 else
1446 stab = stabent(str_get(st[1]),TRUE);
1447#ifndef lint
1448 value = (double)do_tell(stab);
1449#else
1450 (void)do_tell(stab);
1451#endif
1452 goto donumset;
1453 case O_RECV:
1454 case O_READ:
1455 case O_SYSREAD:
1456 if ((arg[1].arg_type & A_MASK) == A_WORD)
1457 stab = arg[1].arg_ptr.arg_stab;
1458 else
1459 stab = stabent(str_get(st[1]),TRUE);
1460 tmps = str_get(st[2]);
1461 anum = (int)str_gnum(st[3]);
1462 errno = 0;
1463 maxarg = sp - arglast[0];
1464 if (maxarg > 4)
1465 warn("Too many args on read");
1466 if (maxarg == 4)
1467 maxarg = (int)str_gnum(st[4]);
1468 else
1469 maxarg = 0;
1470 if (!stab_io(stab) || !stab_io(stab)->ifp)
1471 goto say_undef;
1472#ifdef HAS_SOCKET
1473 if (optype == O_RECV) {
1474 argtype = sizeof buf;
1475 STR_GROW(st[2], anum+1), (tmps = str_get(st[2])); /* sneaky */
1476 anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg,
1477 buf, &argtype);
1478 if (anum >= 0) {
1479 st[2]->str_cur = anum;
1480 st[2]->str_ptr[anum] = '\0';
1481 str_nset(str,buf,argtype);
1482 }
1483 else
1484 str_sset(str,&str_undef);
1485 break;
1486 }
1487#else
1488 if (optype == O_RECV)
1489 goto badsock;
1490#endif
1491 STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2])); /* sneaky */
1492 if (optype == O_SYSREAD) {
1493 anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
1494 }
1495 else
1496#ifdef HAS_SOCKET
1497 if (stab_io(stab)->type == 's') {
1498 argtype = sizeof buf;
1499 anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0,
1500 buf, &argtype);
1501 }
1502 else
1503#endif
1504 anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
1505 if (anum < 0)
1506 goto say_undef;
1507 st[2]->str_cur = anum+maxarg;
1508 st[2]->str_ptr[anum+maxarg] = '\0';
1509 value = (double)anum;
1510 goto donumset;
1511 case O_SYSWRITE:
1512 case O_SEND:
1513 if ((arg[1].arg_type & A_MASK) == A_WORD)
1514 stab = arg[1].arg_ptr.arg_stab;
1515 else
1516 stab = stabent(str_get(st[1]),TRUE);
1517 tmps = str_get(st[2]);
1518 anum = (int)str_gnum(st[3]);
1519 errno = 0;
1520 stio = stab_io(stab);
1521 maxarg = sp - arglast[0];
1522 if (!stio || !stio->ifp) {
1523 anum = -1;
1524 if (dowarn) {
1525 if (optype == O_SYSWRITE)
1526 warn("Syswrite on closed filehandle");
1527 else
1528 warn("Send on closed socket");
1529 }
1530 }
1531 else if (optype == O_SYSWRITE) {
1532 if (maxarg > 4)
1533 warn("Too many args on syswrite");
1534 if (maxarg == 4)
1535 optype = (int)str_gnum(st[4]);
1536 else
1537 optype = 0;
1538 anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum);
1539 }
1540#ifdef HAS_SOCKET
1541 else if (maxarg >= 4) {
1542 if (maxarg > 4)
1543 warn("Too many args on send");
1544 tmps2 = str_get(st[4]);
1545 anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
1546 anum, tmps2, st[4]->str_cur);
1547 }
1548 else
1549 anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
1550#else
1551 else
1552 goto badsock;
1553#endif
1554 if (anum < 0)
1555 goto say_undef;
1556 value = (double)anum;
1557 goto donumset;
1558 case O_SEEK:
1559 if ((arg[1].arg_type & A_MASK) == A_WORD)
1560 stab = arg[1].arg_ptr.arg_stab;
1561 else
1562 stab = stabent(str_get(st[1]),TRUE);
1563 value = str_gnum(st[2]);
1564 str_set(str, do_seek(stab,
1565 (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
1566 STABSET(str);
1567 break;
1568 case O_RETURN:
1569 tmps = "_SUB_"; /* just fake up a "last _SUB_" */
1570 optype = O_LAST;
1571 if (curcsv && curcsv->wantarray == G_ARRAY) {
1572 lastretstr = Nullstr;
1573 lastspbase = arglast[1];
1574 lastsize = arglast[2] - arglast[1];
1575 }
1576 else
1577 lastretstr = str_mortal(st[arglast[2] - arglast[0]]);
1578 goto dopop;
1579 case O_REDO:
1580 case O_NEXT:
1581 case O_LAST:
1582 tmps = Nullch;
1583 if (maxarg > 0) {
1584 tmps = str_get(arg[1].arg_ptr.arg_str);
1585 dopop:
1586 while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
1587 strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
1588#ifdef DEBUGGING
1589 if (debug & 4) {
1590 deb("(Skipping label #%d %s)\n",loop_ptr,
1591 loop_stack[loop_ptr].loop_label);
1592 }
1593#endif
1594 loop_ptr--;
1595 }
1596#ifdef DEBUGGING
1597 if (debug & 4) {
1598 deb("(Found label #%d %s)\n",loop_ptr,
1599 loop_stack[loop_ptr].loop_label);
1600 }
1601#endif
1602 }
1603 if (loop_ptr < 0) {
1604 if (tmps && strEQ(tmps, "_SUB_"))
1605 fatal("Can't return outside a subroutine");
1606 fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
1607 }
1608 if (!lastretstr && optype == O_LAST && lastsize) {
1609 st -= arglast[0];
1610 st += lastspbase + 1;
1611 optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
1612 if (optype) {
1613 for (anum = lastsize; anum > 0; anum--,st++)
1614 st[optype] = str_mortal(st[0]);
1615 }
1616 longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
1617 }
1618 longjmp(loop_stack[loop_ptr].loop_env, optype);
1619 case O_DUMP:
1620 case O_GOTO:/* shudder */
1621 goto_targ = str_get(arg[1].arg_ptr.arg_str);
1622 if (!*goto_targ)
1623 goto_targ = Nullch; /* just restart from top */
1624 if (optype == O_DUMP) {
1625 do_undump = 1;
1626 my_unexec();
1627 }
1628 longjmp(top_env, 1);
1629 case O_INDEX:
1630 tmps = str_get(st[1]);
1631 if (maxarg < 3)
1632 anum = 0;
1633 else {
1634 anum = (int) str_gnum(st[3]) - arybase;
1635 if (anum < 0)
1636 anum = 0;
1637 else if (anum > st[1]->str_cur)
1638 anum = st[1]->str_cur;
1639 }
1640#ifndef lint
1641 if (!(tmps2 = fbminstr((unsigned char*)tmps + anum,
1642 (unsigned char*)tmps + st[1]->str_cur, st[2])))
1643#else
1644 if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
1645#endif
1646 value = (double)(-1 + arybase);
1647 else
1648 value = (double)(tmps2 - tmps + arybase);
1649 goto donumset;
1650 case O_RINDEX:
1651 tmps = str_get(st[1]);
1652 tmps2 = str_get(st[2]);
1653 if (maxarg < 3)
1654 anum = st[1]->str_cur;
1655 else {
1656 anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur;
1657 if (anum < 0)
1658 anum = 0;
1659 else if (anum > st[1]->str_cur)
1660 anum = st[1]->str_cur;
1661 }
1662#ifndef lint
1663 if (!(tmps2 = rninstr(tmps, tmps + anum,
1664 tmps2, tmps2 + st[2]->str_cur)))
1665#else
1666 if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
1667#endif
1668 value = (double)(-1 + arybase);
1669 else
1670 value = (double)(tmps2 - tmps + arybase);
1671 goto donumset;
1672 case O_TIME:
1673#ifndef lint
1674 value = (double) time(Null(long*));
1675#endif
1676 goto donumset;
1677 case O_TMS:
1678 sp = do_tms(str,gimme,arglast);
1679 goto array_return;
1680 case O_LOCALTIME:
1681 if (maxarg < 1)
1682 (void)time(&when);
1683 else
1684 when = (time_t)str_gnum(st[1]);
1685 sp = do_time(str,localtime(&when),
1686 gimme,arglast);
1687 goto array_return;
1688 case O_GMTIME:
1689 if (maxarg < 1)
1690 (void)time(&when);
1691 else
1692 when = (time_t)str_gnum(st[1]);
1693 sp = do_time(str,gmtime(&when),
1694 gimme,arglast);
1695 goto array_return;
1696 case O_TRUNCATE:
1697 sp = do_truncate(str,arg,
1698 gimme,arglast);
1699 goto array_return;
1700 case O_LSTAT:
1701 case O_STAT:
1702 sp = do_stat(str,arg,
1703 gimme,arglast);
1704 goto array_return;
1705 case O_CRYPT:
1706#ifdef HAS_CRYPT
1707 tmps = str_get(st[1]);
1708#ifdef FCRYPT
1709 str_set(str,fcrypt(tmps,str_get(st[2])));
1710#else
1711 str_set(str,crypt(tmps,str_get(st[2])));
1712#endif
1713#else
1714 fatal(
1715 "The crypt() function is unimplemented due to excessive paranoia.");
1716#endif
1717 break;
1718 case O_ATAN2:
1719 value = str_gnum(st[1]);
1720 value = atan2(value,str_gnum(st[2]));
1721 goto donumset;
1722 case O_SIN:
1723 if (maxarg < 1)
1724 value = str_gnum(stab_val(defstab));
1725 else
1726 value = str_gnum(st[1]);
1727 value = sin(value);
1728 goto donumset;
1729 case O_COS:
1730 if (maxarg < 1)
1731 value = str_gnum(stab_val(defstab));
1732 else
1733 value = str_gnum(st[1]);
1734 value = cos(value);
1735 goto donumset;
1736 case O_RAND:
1737 if (maxarg < 1)
1738 value = 1.0;
1739 else
1740 value = str_gnum(st[1]);
1741 if (value == 0.0)
1742 value = 1.0;
1743#if RANDBITS == 31
1744 value = rand() * value / 2147483648.0;
1745#else
1746#if RANDBITS == 16
1747 value = rand() * value / 65536.0;
1748#else
1749#if RANDBITS == 15
1750 value = rand() * value / 32768.0;
1751#else
1752 value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1753#endif
1754#endif
1755#endif
1756 goto donumset;
1757 case O_SRAND:
1758 if (maxarg < 1) {
1759 (void)time(&when);
1760 anum = when;
1761 }
1762 else
1763 anum = (int)str_gnum(st[1]);
1764 (void)srand(anum);
1765 goto say_yes;
1766 case O_EXP:
1767 if (maxarg < 1)
1768 value = str_gnum(stab_val(defstab));
1769 else
1770 value = str_gnum(st[1]);
1771 value = exp(value);
1772 goto donumset;
1773 case O_LOG:
1774 if (maxarg < 1)
1775 value = str_gnum(stab_val(defstab));
1776 else
1777 value = str_gnum(st[1]);
1778 if (value <= 0.0)
1779 fatal("Can't take log of %g\n", value);
1780 value = log(value);
1781 goto donumset;
1782 case O_SQRT:
1783 if (maxarg < 1)
1784 value = str_gnum(stab_val(defstab));
1785 else
1786 value = str_gnum(st[1]);
1787 if (value < 0.0)
1788 fatal("Can't take sqrt of %g\n", value);
1789 value = sqrt(value);
1790 goto donumset;
1791 case O_INT:
1792 if (maxarg < 1)
1793 value = str_gnum(stab_val(defstab));
1794 else
1795 value = str_gnum(st[1]);
1796 if (value >= 0.0)
1797 (void)modf(value,&value);
1798 else {
1799 (void)modf(-value,&value);
1800 value = -value;
1801 }
1802 goto donumset;
1803 case O_ORD:
1804 if (maxarg < 1)
1805 tmps = str_get(stab_val(defstab));
1806 else
1807 tmps = str_get(st[1]);
1808#ifndef I286
1809 value = (double) (*tmps & 255);
1810#else
1811 anum = (int) *tmps;
1812 value = (double) (anum & 255);
1813#endif
1814 goto donumset;
1815 case O_ALARM:
1816#ifdef HAS_ALARM
1817 if (maxarg < 1)
1818 tmps = str_get(stab_val(defstab));
1819 else
1820 tmps = str_get(st[1]);
1821 if (!tmps)
1822 tmps = "0";
1823 anum = alarm((unsigned int)atoi(tmps));
1824 if (anum < 0)
1825 goto say_undef;
1826 value = (double)anum;
1827 goto donumset;
1828#else
1829 fatal("Unsupported function alarm");
1830 break;
1831#endif
1832 case O_SLEEP:
1833 if (maxarg < 1)
1834 tmps = Nullch;
1835 else
1836 tmps = str_get(st[1]);
1837 (void)time(&when);
1838 if (!tmps || !*tmps)
1839 sleep((32767<<16)+32767);
1840 else
1841 sleep((unsigned int)atoi(tmps));
1842#ifndef lint
1843 value = (double)when;
1844 (void)time(&when);
1845 value = ((double)when) - value;
1846#endif
1847 goto donumset;
1848 case O_RANGE:
1849 sp = do_range(gimme,arglast);
1850 goto array_return;
1851 case O_F_OR_R:
1852 if (gimme == G_ARRAY) { /* it's a range */
1853 /* can we optimize to constant array? */
1854 if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
1855 (arg[2].arg_type & A_MASK) == A_SINGLE) {
1856 st[2] = arg[2].arg_ptr.arg_str;
1857 sp = do_range(gimme,arglast);
1858 st = stack->ary_array;
1859 maxarg = sp - arglast[0];
1860 str_free(arg[1].arg_ptr.arg_str);
1861 arg[1].arg_ptr.arg_str = Nullstr;
1862 str_free(arg[2].arg_ptr.arg_str);
1863 arg[2].arg_ptr.arg_str = Nullstr;
1864 arg->arg_type = O_ARRAY;
1865 arg[1].arg_type = A_STAB|A_DONT;
1866 arg->arg_len = 1;
1867 stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
1868 ary = stab_array(stab);
1869 afill(ary,maxarg - 1);
1870 anum = maxarg;
1871 st += arglast[0]+1;
1872 while (maxarg-- > 0)
1873 ary->ary_array[maxarg] = str_smake(st[maxarg]);
1874 st -= arglast[0]+1;
1875 goto array_return;
1876 }
1877 arg->arg_type = optype = O_RANGE;
1878 maxarg = arg->arg_len = 2;
1879 anum = 2;
1880 arg[anum].arg_flags &= ~AF_ARYOK;
1881 argflags = arg[anum].arg_flags;
1882 argtype = arg[anum].arg_type & A_MASK;
1883 arg[anum].arg_type = argtype;
1884 argptr = arg[anum].arg_ptr;
1885 sp = arglast[0];
1886 st -= sp;
1887 sp++;
1888 goto re_eval;
1889 }
1890 arg->arg_type = O_FLIP;
1891 /* FALL THROUGH */
1892 case O_FLIP:
1893 if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
1894 last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
1895 :
1896 str_true(st[1]) ) {
1897 arg[2].arg_type &= ~A_DONT;
1898 arg[1].arg_type |= A_DONT;
1899 arg->arg_type = optype = O_FLOP;
1900 if (arg->arg_flags & AF_COMMON) {
1901 str_numset(str,0.0);
1902 anum = 2;
1903 argflags = arg[2].arg_flags;
1904 argtype = arg[2].arg_type & A_MASK;
1905 argptr = arg[2].arg_ptr;
1906 sp = arglast[0];
1907 st -= sp++;
1908 goto re_eval;
1909 }
1910 else {
1911 str_numset(str,1.0);
1912 break;
1913 }
1914 }
1915 str_set(str,"");
1916 break;
1917 case O_FLOP:
1918 str_inc(str);
1919 if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
1920 last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
1921 :
1922 str_true(st[2]) ) {
1923 arg->arg_type = O_FLIP;
1924 arg[1].arg_type &= ~A_DONT;
1925 arg[2].arg_type |= A_DONT;
1926 str_cat(str,"E0");
1927 }
1928 break;
1929 case O_FORK:
1930#ifdef HAS_FORK
1931 anum = fork();
1932 if (anum < 0)
1933 goto say_undef;
1934 if (!anum) {
1935 /*SUPPRESS 560*/
1936 if (tmpstab = stabent("$",allstabs))
1937 str_numset(STAB_STR(tmpstab),(double)getpid());
1938 hclear(pidstatus, FALSE); /* no kids, so don't wait for 'em */
1939 }
1940 value = (double)anum;
1941 goto donumset;
1942#else
1943 fatal("Unsupported function fork");
1944 break;
1945#endif
1946 case O_WAIT:
1947#ifdef HAS_WAIT
1948#ifndef lint
1949 anum = wait(&argflags);
1950 if (anum > 0)
1951 pidgone(anum,argflags);
1952 value = (double)anum;
1953#endif
1954 statusvalue = (unsigned short)argflags;
1955 goto donumset;
1956#else
1957 fatal("Unsupported function wait");
1958 break;
1959#endif
1960 case O_WAITPID:
1961#ifdef HAS_WAIT
1962#ifndef lint
1963 anum = (int)str_gnum(st[1]);
1964 optype = (int)str_gnum(st[2]);
1965 anum = wait4pid(anum, &argflags,optype);
1966 value = (double)anum;
1967#endif
1968 statusvalue = (unsigned short)argflags;
1969 goto donumset;
1970#else
1971 fatal("Unsupported function wait");
1972 break;
1973#endif
1974 case O_SYSTEM:
1975#ifdef HAS_FORK
1976#ifdef TAINT
1977 if (arglast[2] - arglast[1] == 1) {
1978 taintenv();
1979 tainted |= st[2]->str_tainted;
1980 taintproper("Insecure dependency in system");
1981 }
1982#endif
1983 while ((anum = vfork()) == -1) {
1984 if (errno != EAGAIN) {
1985 value = -1.0;
1986 goto donumset;
1987 }
1988 sleep(5);
1989 }
1990 if (anum > 0) {
1991#ifndef lint
1992 ihand = signal(SIGINT, SIG_IGN);
1993 qhand = signal(SIGQUIT, SIG_IGN);
1994 argtype = wait4pid(anum, &argflags, 0);
1995#else
1996 ihand = qhand = 0;
1997#endif
1998 (void)signal(SIGINT, ihand);
1999 (void)signal(SIGQUIT, qhand);
2000 statusvalue = (unsigned short)argflags;
2001 if (argtype < 0)
2002 value = -1.0;
2003 else {
2004 value = (double)((unsigned int)argflags & 0xffff);
2005 }
2006 do_execfree(); /* free any memory child malloced on vfork */
2007 goto donumset;
2008 }
2009 if ((arg[1].arg_type & A_MASK) == A_STAB)
2010 value = (double)do_aexec(st[1],arglast);
2011 else if (arglast[2] - arglast[1] != 1)
2012 value = (double)do_aexec(Nullstr,arglast);
2013 else {
2014 value = (double)do_exec(str_get(str_mortal(st[2])));
2015 }
2016 _exit(-1);
2017#else /* ! FORK */
2018 if ((arg[1].arg_type & A_MASK) == A_STAB)
2019 value = (double)do_aspawn(st[1],arglast);
2020 else if (arglast[2] - arglast[1] != 1)
2021 value = (double)do_aspawn(Nullstr,arglast);
2022 else {
2023 value = (double)do_spawn(str_get(str_mortal(st[2])));
2024 }
2025 goto donumset;
2026#endif /* FORK */
2027 case O_EXEC_OP:
2028 if ((arg[1].arg_type & A_MASK) == A_STAB)
2029 value = (double)do_aexec(st[1],arglast);
2030 else if (arglast[2] - arglast[1] != 1)
2031 value = (double)do_aexec(Nullstr,arglast);
2032 else {
2033#ifdef TAINT
2034 taintenv();
2035 tainted |= st[2]->str_tainted;
2036 taintproper("Insecure dependency in exec");
2037#endif
2038 value = (double)do_exec(str_get(str_mortal(st[2])));
2039 }
2040 goto donumset;
2041 case O_HEX:
2042 if (maxarg < 1)
2043 tmps = str_get(stab_val(defstab));
2044 else
2045 tmps = str_get(st[1]);
2046 value = (double)scanhex(tmps, 99, &argtype);
2047 goto donumset;
2048
2049 case O_OCT:
2050 if (maxarg < 1)
2051 tmps = str_get(stab_val(defstab));
2052 else
2053 tmps = str_get(st[1]);
2054 while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
2055 tmps++;
2056 if (*tmps == 'x')
2057 value = (double)scanhex(++tmps, 99, &argtype);
2058 else
2059 value = (double)scanoct(tmps, 99, &argtype);
2060 goto donumset;
2061
2062/* These common exits are hidden here in the middle of the switches for the
2063 benefit of those machines with limited branch addressing. Sigh. */
2064
2065array_return:
2066#ifdef DEBUGGING
2067 if (debug) {
2068 dlevel--;
2069 if (debug & 8) {
2070 anum = sp - arglast[0];
2071 switch (anum) {
2072 case 0:
2073 deb("%s RETURNS ()\n",opname[optype]);
2074 break;
2075 case 1:
2076 deb("%s RETURNS (\"%s\")\n",opname[optype],
2077 st[1] ? str_get(st[1]) : "");
2078 break;
2079 default:
2080 tmps = st[1] ? str_get(st[1]) : "";
2081 deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
2082 anum,tmps,anum==2?"":"...,",
2083 st[anum] ? str_get(st[anum]) : "");
2084 break;
2085 }
2086 }
2087 }
2088#endif
2089 return sp;
2090
2091say_yes:
2092 str = &str_yes;
2093 goto normal_return;
2094
2095say_no:
2096 str = &str_no;
2097 goto normal_return;
2098
2099say_undef:
2100 str = &str_undef;
2101 goto normal_return;
2102
2103say_zero:
2104 value = 0.0;
2105 /* FALL THROUGH */
2106
2107donumset:
2108 str_numset(str,value);
2109 STABSET(str);
2110 st[1] = str;
2111#ifdef DEBUGGING
2112 if (debug) {
2113 dlevel--;
2114 if (debug & 8)
2115 deb("%s RETURNS \"%f\"\n",opname[optype],value);
2116 }
2117#endif
2118 return arglast[0] + 1;
2119#ifdef SMALLSWITCHES
2120 }
2121 else
2122 switch (optype) {
2123#endif
2124 case O_CHOWN:
2125#ifdef HAS_CHOWN
2126 value = (double)apply(optype,arglast);
2127 goto donumset;
2128#else
2129 fatal("Unsupported function chown");
2130 break;
2131#endif
2132 case O_KILL:
2133#ifdef HAS_KILL
2134 value = (double)apply(optype,arglast);
2135 goto donumset;
2136#else
2137 fatal("Unsupported function kill");
2138 break;
2139#endif
2140 case O_UNLINK:
2141 case O_CHMOD:
2142 case O_UTIME:
2143 value = (double)apply(optype,arglast);
2144 goto donumset;
2145 case O_UMASK:
2146#ifdef HAS_UMASK
2147 if (maxarg < 1) {
2148 anum = umask(0);
2149 (void)umask(anum);
2150 }
2151 else
2152 anum = umask((int)str_gnum(st[1]));
2153 value = (double)anum;
2154#ifdef TAINT
2155 taintproper("Insecure dependency in umask");
2156#endif
2157 goto donumset;
2158#else
2159 fatal("Unsupported function umask");
2160 break;
2161#endif
2162#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
2163 case O_MSGGET:
2164 case O_SHMGET:
2165 case O_SEMGET:
2166 if ((anum = do_ipcget(optype, arglast)) == -1)
2167 goto say_undef;
2168 value = (double)anum;
2169 goto donumset;
2170 case O_MSGCTL:
2171 case O_SHMCTL:
2172 case O_SEMCTL:
2173 anum = do_ipcctl(optype, arglast);
2174 if (anum == -1)
2175 goto say_undef;
2176 if (anum != 0) {
2177 value = (double)anum;
2178 goto donumset;
2179 }
2180 str_set(str,"0 but true");
2181 STABSET(str);
2182 break;
2183 case O_MSGSND:
2184 value = (double)(do_msgsnd(arglast) >= 0);
2185 goto donumset;
2186 case O_MSGRCV:
2187 value = (double)(do_msgrcv(arglast) >= 0);
2188 goto donumset;
2189 case O_SEMOP:
2190 value = (double)(do_semop(arglast) >= 0);
2191 goto donumset;
2192 case O_SHMREAD:
2193 case O_SHMWRITE:
2194 value = (double)(do_shmio(optype, arglast) >= 0);
2195 goto donumset;
2196#else /* not SYSVIPC */
2197 case O_MSGGET:
2198 case O_MSGCTL:
2199 case O_MSGSND:
2200 case O_MSGRCV:
2201 case O_SEMGET:
2202 case O_SEMCTL:
2203 case O_SEMOP:
2204 case O_SHMGET:
2205 case O_SHMCTL:
2206 case O_SHMREAD:
2207 case O_SHMWRITE:
2208 fatal("System V IPC is not implemented on this machine");
2209#endif /* not SYSVIPC */
2210 case O_RENAME:
2211 tmps = str_get(st[1]);
2212 tmps2 = str_get(st[2]);
2213#ifdef TAINT
2214 taintproper("Insecure dependency in rename");
2215#endif
2216#ifdef HAS_RENAME
2217 value = (double)(rename(tmps,tmps2) >= 0);
2218#else
2219 if (same_dirent(tmps2, tmps)) /* can always rename to same name */
2220 anum = 1;
2221 else {
2222 if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
2223 (void)UNLINK(tmps2);
2224 if (!(anum = link(tmps,tmps2)))
2225 anum = UNLINK(tmps);
2226 }
2227 value = (double)(anum >= 0);
2228#endif
2229 goto donumset;
2230 case O_LINK:
2231#ifdef HAS_LINK
2232 tmps = str_get(st[1]);
2233 tmps2 = str_get(st[2]);
2234#ifdef TAINT
2235 taintproper("Insecure dependency in link");
2236#endif
2237 value = (double)(link(tmps,tmps2) >= 0);
2238 goto donumset;
2239#else
2240 fatal("Unsupported function link");
2241 break;
2242#endif
2243 case O_MKDIR:
2244 tmps = str_get(st[1]);
2245 anum = (int)str_gnum(st[2]);
2246#ifdef TAINT
2247 taintproper("Insecure dependency in mkdir");
2248#endif
2249#ifdef HAS_MKDIR
2250 value = (double)(mkdir(tmps,anum) >= 0);
2251 goto donumset;
2252#else
2253 (void)strcpy(buf,"mkdir ");
2254#endif
2255#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
2256 one_liner:
2257 for (tmps2 = buf+6; *tmps; ) {
2258 *tmps2++ = '\\';
2259 *tmps2++ = *tmps++;
2260 }
2261 (void)strcpy(tmps2," 2>&1");
2262 rsfp = mypopen(buf,"r");
2263 if (rsfp) {
2264 *buf = '\0';
2265 tmps2 = fgets(buf,sizeof buf,rsfp);
2266 (void)mypclose(rsfp);
2267 if (tmps2 != Nullch) {
2268 for (errno = 1; errno < sys_nerr; errno++) {
2269 if (instr(buf,sys_errlist[errno])) /* you don't see this */
2270 goto say_zero;
2271 }
2272 errno = 0;
2273#ifndef EACCES
2274#define EACCES EPERM
2275#endif
2276 if (instr(buf,"cannot make"))
2277 errno = EEXIST;
2278 else if (instr(buf,"existing file"))
2279 errno = EEXIST;
2280 else if (instr(buf,"ile exists"))
2281 errno = EEXIST;
2282 else if (instr(buf,"non-exist"))
2283 errno = ENOENT;
2284 else if (instr(buf,"does not exist"))
2285 errno = ENOENT;
2286 else if (instr(buf,"not empty"))
2287 errno = EBUSY;
2288 else if (instr(buf,"cannot access"))
2289 errno = EACCES;
2290 else
2291 errno = EPERM;
2292 goto say_zero;
2293 }
2294 else { /* some mkdirs return no failure indication */
2295 tmps = str_get(st[1]);
2296 anum = (stat(tmps,&statbuf) >= 0);
2297 if (optype == O_RMDIR)
2298 anum = !anum;
2299 if (anum)
2300 errno = 0;
2301 else
2302 errno = EACCES; /* a guess */
2303 value = (double)anum;
2304 }
2305 goto donumset;
2306 }
2307 else
2308 goto say_zero;
2309#endif
2310 case O_RMDIR:
2311 if (maxarg < 1)
2312 tmps = str_get(stab_val(defstab));
2313 else
2314 tmps = str_get(st[1]);
2315#ifdef TAINT
2316 taintproper("Insecure dependency in rmdir");
2317#endif
2318#ifdef HAS_RMDIR
2319 value = (double)(rmdir(tmps) >= 0);
2320 goto donumset;
2321#else
2322 (void)strcpy(buf,"rmdir ");
2323 goto one_liner; /* see above in HAS_MKDIR */
2324#endif
2325 case O_GETPPID:
2326#ifdef HAS_GETPPID
2327 value = (double)getppid();
2328 goto donumset;
2329#else
2330 fatal("Unsupported function getppid");
2331 break;
2332#endif
2333 case O_GETPGRP:
2334#ifdef HAS_GETPGRP
2335 if (maxarg < 1)
2336 anum = 0;
2337 else
2338 anum = (int)str_gnum(st[1]);
2339#ifdef _POSIX_SOURCE
2340 if (anum != 0)
2341 fatal("POSIX getpgrp can't take an argument");
2342 value = (double)getpgrp();
2343#else
2344 value = (double)getpgrp(anum);
2345#endif
2346 goto donumset;
2347#else
2348 fatal("The getpgrp() function is unimplemented on this machine");
2349 break;
2350#endif
2351 case O_SETPGRP:
2352#ifdef HAS_SETPGRP
2353 argtype = (int)str_gnum(st[1]);
2354 anum = (int)str_gnum(st[2]);
2355#ifdef TAINT
2356 taintproper("Insecure dependency in setpgrp");
2357#endif
2358 value = (double)(setpgrp(argtype,anum) >= 0);
2359 goto donumset;
2360#else
2361 fatal("The setpgrp() function is unimplemented on this machine");
2362 break;
2363#endif
2364 case O_GETPRIORITY:
2365#ifdef HAS_GETPRIORITY
2366 argtype = (int)str_gnum(st[1]);
2367 anum = (int)str_gnum(st[2]);
2368 value = (double)getpriority(argtype,anum);
2369 goto donumset;
2370#else
2371 fatal("The getpriority() function is unimplemented on this machine");
2372 break;
2373#endif
2374 case O_SETPRIORITY:
2375#ifdef HAS_SETPRIORITY
2376 argtype = (int)str_gnum(st[1]);
2377 anum = (int)str_gnum(st[2]);
2378 optype = (int)str_gnum(st[3]);
2379#ifdef TAINT
2380 taintproper("Insecure dependency in setpriority");
2381#endif
2382 value = (double)(setpriority(argtype,anum,optype) >= 0);
2383 goto donumset;
2384#else
2385 fatal("The setpriority() function is unimplemented on this machine");
2386 break;
2387#endif
2388 case O_CHROOT:
2389#ifdef HAS_CHROOT
2390 if (maxarg < 1)
2391 tmps = str_get(stab_val(defstab));
2392 else
2393 tmps = str_get(st[1]);
2394#ifdef TAINT
2395 taintproper("Insecure dependency in chroot");
2396#endif
2397 value = (double)(chroot(tmps) >= 0);
2398 goto donumset;
2399#else
2400 fatal("Unsupported function chroot");
2401 break;
2402#endif
2403 case O_FCNTL:
2404 case O_IOCTL:
2405 if (maxarg <= 0)
2406 stab = last_in_stab;
2407 else if ((arg[1].arg_type & A_MASK) == A_WORD)
2408 stab = arg[1].arg_ptr.arg_stab;
2409 else
2410 stab = stabent(str_get(st[1]),TRUE);
2411 argtype = U_I(str_gnum(st[2]));
2412#ifdef TAINT
2413 taintproper("Insecure dependency in ioctl");
2414#endif
2415 anum = do_ctl(optype,stab,argtype,st[3]);
2416 if (anum == -1)
2417 goto say_undef;
2418 if (anum != 0) {
2419 value = (double)anum;
2420 goto donumset;
2421 }
2422 str_set(str,"0 but true");
2423 STABSET(str);
2424 break;
2425 case O_FLOCK:
2426#ifdef HAS_FLOCK
2427 if (maxarg <= 0)
2428 stab = last_in_stab;
2429 else if ((arg[1].arg_type & A_MASK) == A_WORD)
2430 stab = arg[1].arg_ptr.arg_stab;
2431 else
2432 stab = stabent(str_get(st[1]),TRUE);
2433 if (stab && stab_io(stab))
2434 fp = stab_io(stab)->ifp;
2435 else
2436 fp = Nullfp;
2437 if (fp) {
2438 argtype = (int)str_gnum(st[2]);
2439 value = (double)(flock(fileno(fp),argtype) >= 0);
2440 }
2441 else
2442 value = 0;
2443 goto donumset;
2444#else
2445 fatal("The flock() function is unimplemented on this machine");
2446 break;
2447#endif
2448 case O_UNSHIFT:
2449 ary = stab_array(arg[1].arg_ptr.arg_stab);
2450 if (arglast[2] - arglast[1] != 1)
2451 do_unshift(ary,arglast);
2452 else {
2453 STR *tmpstr = Str_new(52,0); /* must copy the STR */
2454 str_sset(tmpstr,st[2]);
2455 aunshift(ary,1);
2456 (void)astore(ary,0,tmpstr);
2457 }
2458 value = (double)(ary->ary_fill + 1);
2459 goto donumset;
2460
2461 case O_TRY:
2462 sp = do_try(arg[1].arg_ptr.arg_cmd,
2463 gimme,arglast);
2464 goto array_return;
2465
2466 case O_EVALONCE:
2467 sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE,
2468 gimme,arglast);
2469 if (eval_root) {
2470 str_free(arg[1].arg_ptr.arg_str);
2471 arg[1].arg_ptr.arg_cmd = eval_root;
2472 arg[1].arg_type = (A_CMD|A_DONT);
2473 arg[0].arg_type = O_TRY;
2474 }
2475 goto array_return;
2476
2477 case O_REQUIRE:
2478 case O_DOFILE:
2479 case O_EVAL:
2480 if (maxarg < 1)
2481 tmpstr = stab_val(defstab);
2482 else
2483 tmpstr =
2484 (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
2485#ifdef TAINT
2486 tainted |= tmpstr->str_tainted;
2487 taintproper("Insecure dependency in eval");
2488#endif
2489 sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE,
2490 gimme,arglast);
2491 goto array_return;
2492
2493 case O_FTRREAD:
2494 argtype = 0;
2495 anum = S_IRUSR;
2496 goto check_perm;
2497 case O_FTRWRITE:
2498 argtype = 0;
2499 anum = S_IWUSR;
2500 goto check_perm;
2501 case O_FTREXEC:
2502 argtype = 0;
2503 anum = S_IXUSR;
2504 goto check_perm;
2505 case O_FTEREAD:
2506 argtype = 1;
2507 anum = S_IRUSR;
2508 goto check_perm;
2509 case O_FTEWRITE:
2510 argtype = 1;
2511 anum = S_IWUSR;
2512 goto check_perm;
2513 case O_FTEEXEC:
2514 argtype = 1;
2515 anum = S_IXUSR;
2516 check_perm:
2517 if (mystat(arg,st[1]) < 0)
2518 goto say_undef;
2519 if (cando(anum,argtype,&statcache))
2520 goto say_yes;
2521 goto say_no;
2522
2523 case O_FTIS:
2524 if (mystat(arg,st[1]) < 0)
2525 goto say_undef;
2526 goto say_yes;
2527 case O_FTEOWNED:
2528 case O_FTROWNED:
2529 if (mystat(arg,st[1]) < 0)
2530 goto say_undef;
2531 if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
2532 goto say_yes;
2533 goto say_no;
2534 case O_FTZERO:
2535 if (mystat(arg,st[1]) < 0)
2536 goto say_undef;
2537 if (!statcache.st_size)
2538 goto say_yes;
2539 goto say_no;
2540 case O_FTSIZE:
2541 if (mystat(arg,st[1]) < 0)
2542 goto say_undef;
2543 value = (double)statcache.st_size;
2544 goto donumset;
2545
2546 case O_FTMTIME:
2547 if (mystat(arg,st[1]) < 0)
2548 goto say_undef;
2549 value = (double)(basetime - statcache.st_mtime) / 86400.0;
2550 goto donumset;
2551 case O_FTATIME:
2552 if (mystat(arg,st[1]) < 0)
2553 goto say_undef;
2554 value = (double)(basetime - statcache.st_atime) / 86400.0;
2555 goto donumset;
2556 case O_FTCTIME:
2557 if (mystat(arg,st[1]) < 0)
2558 goto say_undef;
2559 value = (double)(basetime - statcache.st_ctime) / 86400.0;
2560 goto donumset;
2561
2562 case O_FTSOCK:
2563 if (mystat(arg,st[1]) < 0)
2564 goto say_undef;
2565 if (S_ISSOCK(statcache.st_mode))
2566 goto say_yes;
2567 goto say_no;
2568 case O_FTCHR:
2569 if (mystat(arg,st[1]) < 0)
2570 goto say_undef;
2571 if (S_ISCHR(statcache.st_mode))
2572 goto say_yes;
2573 goto say_no;
2574 case O_FTBLK:
2575 if (mystat(arg,st[1]) < 0)
2576 goto say_undef;
2577 if (S_ISBLK(statcache.st_mode))
2578 goto say_yes;
2579 goto say_no;
2580 case O_FTFILE:
2581 if (mystat(arg,st[1]) < 0)
2582 goto say_undef;
2583 if (S_ISREG(statcache.st_mode))
2584 goto say_yes;
2585 goto say_no;
2586 case O_FTDIR:
2587 if (mystat(arg,st[1]) < 0)
2588 goto say_undef;
2589 if (S_ISDIR(statcache.st_mode))
2590 goto say_yes;
2591 goto say_no;
2592 case O_FTPIPE:
2593 if (mystat(arg,st[1]) < 0)
2594 goto say_undef;
2595 if (S_ISFIFO(statcache.st_mode))
2596 goto say_yes;
2597 goto say_no;
2598 case O_FTLINK:
2599 if (mylstat(arg,st[1]) < 0)
2600 goto say_undef;
2601 if (S_ISLNK(statcache.st_mode))
2602 goto say_yes;
2603 goto say_no;
2604 case O_SYMLINK:
2605#ifdef HAS_SYMLINK
2606 tmps = str_get(st[1]);
2607 tmps2 = str_get(st[2]);
2608#ifdef TAINT
2609 taintproper("Insecure dependency in symlink");
2610#endif
2611 value = (double)(symlink(tmps,tmps2) >= 0);
2612 goto donumset;
2613#else
2614 fatal("Unsupported function symlink");
2615#endif
2616 case O_READLINK:
2617#ifdef HAS_SYMLINK
2618 if (maxarg < 1)
2619 tmps = str_get(stab_val(defstab));
2620 else
2621 tmps = str_get(st[1]);
2622 anum = readlink(tmps,buf,sizeof buf);
2623 if (anum < 0)
2624 goto say_undef;
2625 str_nset(str,buf,anum);
2626 break;
2627#else
2628 goto say_undef; /* just pretend it's a normal file */
2629#endif
2630 case O_FTSUID:
2631#ifdef S_ISUID
2632 anum = S_ISUID;
2633 goto check_xid;
2634#else
2635 goto say_no;
2636#endif
2637 case O_FTSGID:
2638#ifdef S_ISGID
2639 anum = S_ISGID;
2640 goto check_xid;
2641#else
2642 goto say_no;
2643#endif
2644 case O_FTSVTX:
2645#ifdef S_ISVTX
2646 anum = S_ISVTX;
2647#else
2648 goto say_no;
2649#endif
2650 check_xid:
2651 if (mystat(arg,st[1]) < 0)
2652 goto say_undef;
2653 if (statcache.st_mode & anum)
2654 goto say_yes;
2655 goto say_no;
2656 case O_FTTTY:
2657 if (arg[1].arg_type & A_DONT) {
2658 stab = arg[1].arg_ptr.arg_stab;
2659 tmps = "";
2660 }
2661 else
2662 stab = stabent(tmps = str_get(st[1]),FALSE);
2663 if (stab && stab_io(stab) && stab_io(stab)->ifp)
2664 anum = fileno(stab_io(stab)->ifp);
2665 else if (isDIGIT(*tmps))
2666 anum = atoi(tmps);
2667 else
2668 goto say_undef;
2669 if (isatty(anum))
2670 goto say_yes;
2671 goto say_no;
2672 case O_FTTEXT:
2673 case O_FTBINARY:
2674 str = do_fttext(arg,st[1]);
2675 break;
2676#ifdef HAS_SOCKET
2677 case O_SOCKET:
2678 if ((arg[1].arg_type & A_MASK) == A_WORD)
2679 stab = arg[1].arg_ptr.arg_stab;
2680 else
2681 stab = stabent(str_get(st[1]),TRUE);
2682#ifndef lint
2683 value = (double)do_socket(stab,arglast);
2684#else
2685 (void)do_socket(stab,arglast);
2686#endif
2687 goto donumset;
2688 case O_BIND:
2689 if ((arg[1].arg_type & A_MASK) == A_WORD)
2690 stab = arg[1].arg_ptr.arg_stab;
2691 else
2692 stab = stabent(str_get(st[1]),TRUE);
2693#ifndef lint
2694 value = (double)do_bind(stab,arglast);
2695#else
2696 (void)do_bind(stab,arglast);
2697#endif
2698 goto donumset;
2699 case O_CONNECT:
2700 if ((arg[1].arg_type & A_MASK) == A_WORD)
2701 stab = arg[1].arg_ptr.arg_stab;
2702 else
2703 stab = stabent(str_get(st[1]),TRUE);
2704#ifndef lint
2705 value = (double)do_connect(stab,arglast);
2706#else
2707 (void)do_connect(stab,arglast);
2708#endif
2709 goto donumset;
2710 case O_LISTEN:
2711 if ((arg[1].arg_type & A_MASK) == A_WORD)
2712 stab = arg[1].arg_ptr.arg_stab;
2713 else
2714 stab = stabent(str_get(st[1]),TRUE);
2715#ifndef lint
2716 value = (double)do_listen(stab,arglast);
2717#else
2718 (void)do_listen(stab,arglast);
2719#endif
2720 goto donumset;
2721 case O_ACCEPT:
2722 if ((arg[1].arg_type & A_MASK) == A_WORD)
2723 stab = arg[1].arg_ptr.arg_stab;
2724 else
2725 stab = stabent(str_get(st[1]),TRUE);
2726 if ((arg[2].arg_type & A_MASK) == A_WORD)
2727 stab2 = arg[2].arg_ptr.arg_stab;
2728 else
2729 stab2 = stabent(str_get(st[2]),TRUE);
2730 do_accept(str,stab,stab2);
2731 STABSET(str);
2732 break;
2733 case O_GHBYNAME:
2734 if (maxarg < 1)
2735 goto say_undef;
2736 case O_GHBYADDR:
2737 case O_GHOSTENT:
2738 sp = do_ghent(optype,
2739 gimme,arglast);
2740 goto array_return;
2741 case O_GNBYNAME:
2742 if (maxarg < 1)
2743 goto say_undef;
2744 case O_GNBYADDR:
2745 case O_GNETENT:
2746 sp = do_gnent(optype,
2747 gimme,arglast);
2748 goto array_return;
2749 case O_GPBYNAME:
2750 if (maxarg < 1)
2751 goto say_undef;
2752 case O_GPBYNUMBER:
2753 case O_GPROTOENT:
2754 sp = do_gpent(optype,
2755 gimme,arglast);
2756 goto array_return;
2757 case O_GSBYNAME:
2758 if (maxarg < 1)
2759 goto say_undef;
2760 case O_GSBYPORT:
2761 case O_GSERVENT:
2762 sp = do_gsent(optype,
2763 gimme,arglast);
2764 goto array_return;
2765 case O_SHOSTENT:
2766 value = (double) sethostent((int)str_gnum(st[1]));
2767 goto donumset;
2768 case O_SNETENT:
2769 value = (double) setnetent((int)str_gnum(st[1]));
2770 goto donumset;
2771 case O_SPROTOENT:
2772 value = (double) setprotoent((int)str_gnum(st[1]));
2773 goto donumset;
2774 case O_SSERVENT:
2775 value = (double) setservent((int)str_gnum(st[1]));
2776 goto donumset;
2777 case O_EHOSTENT:
2778 value = (double) endhostent();
2779 goto donumset;
2780 case O_ENETENT:
2781 value = (double) endnetent();
2782 goto donumset;
2783 case O_EPROTOENT:
2784 value = (double) endprotoent();
2785 goto donumset;
2786 case O_ESERVENT:
2787 value = (double) endservent();
2788 goto donumset;
2789 case O_SOCKPAIR:
2790 if ((arg[1].arg_type & A_MASK) == A_WORD)
2791 stab = arg[1].arg_ptr.arg_stab;
2792 else
2793 stab = stabent(str_get(st[1]),TRUE);
2794 if ((arg[2].arg_type & A_MASK) == A_WORD)
2795 stab2 = arg[2].arg_ptr.arg_stab;
2796 else
2797 stab2 = stabent(str_get(st[2]),TRUE);
2798#ifndef lint
2799 value = (double)do_spair(stab,stab2,arglast);
2800#else
2801 (void)do_spair(stab,stab2,arglast);
2802#endif
2803 goto donumset;
2804 case O_SHUTDOWN:
2805 if ((arg[1].arg_type & A_MASK) == A_WORD)
2806 stab = arg[1].arg_ptr.arg_stab;
2807 else
2808 stab = stabent(str_get(st[1]),TRUE);
2809#ifndef lint
2810 value = (double)do_shutdown(stab,arglast);
2811#else
2812 (void)do_shutdown(stab,arglast);
2813#endif
2814 goto donumset;
2815 case O_GSOCKOPT:
2816 case O_SSOCKOPT:
2817 if ((arg[1].arg_type & A_MASK) == A_WORD)
2818 stab = arg[1].arg_ptr.arg_stab;
2819 else
2820 stab = stabent(str_get(st[1]),TRUE);
2821 sp = do_sopt(optype,stab,arglast);
2822 goto array_return;
2823 case O_GETSOCKNAME:
2824 case O_GETPEERNAME:
2825 if ((arg[1].arg_type & A_MASK) == A_WORD)
2826 stab = arg[1].arg_ptr.arg_stab;
2827 else
2828 stab = stabent(str_get(st[1]),TRUE);
2829 if (!stab)
2830 goto say_undef;
2831 sp = do_getsockname(optype,stab,arglast);
2832 goto array_return;
2833
2834#else /* HAS_SOCKET not defined */
2835 case O_SOCKET:
2836 case O_BIND:
2837 case O_CONNECT:
2838 case O_LISTEN:
2839 case O_ACCEPT:
2840 case O_SOCKPAIR:
2841 case O_GHBYNAME:
2842 case O_GHBYADDR:
2843 case O_GHOSTENT:
2844 case O_GNBYNAME:
2845 case O_GNBYADDR:
2846 case O_GNETENT:
2847 case O_GPBYNAME:
2848 case O_GPBYNUMBER:
2849 case O_GPROTOENT:
2850 case O_GSBYNAME:
2851 case O_GSBYPORT:
2852 case O_GSERVENT:
2853 case O_SHOSTENT:
2854 case O_SNETENT:
2855 case O_SPROTOENT:
2856 case O_SSERVENT:
2857 case O_EHOSTENT:
2858 case O_ENETENT:
2859 case O_EPROTOENT:
2860 case O_ESERVENT:
2861 case O_SHUTDOWN:
2862 case O_GSOCKOPT:
2863 case O_SSOCKOPT:
2864 case O_GETSOCKNAME:
2865 case O_GETPEERNAME:
2866 badsock:
2867 fatal("Unsupported socket function");
2868#endif /* HAS_SOCKET */
2869 case O_SSELECT:
2870#ifdef HAS_SELECT
2871 sp = do_select(gimme,arglast);
2872 goto array_return;
2873#else
2874 fatal("select not implemented");
2875#endif
2876 case O_FILENO:
2877 if (maxarg < 1)
2878 goto say_undef;
2879 if ((arg[1].arg_type & A_MASK) == A_WORD)
2880 stab = arg[1].arg_ptr.arg_stab;
2881 else
2882 stab = stabent(str_get(st[1]),TRUE);
2883 if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
2884 goto say_undef;
2885 value = fileno(fp);
2886 goto donumset;
2887 case O_BINMODE:
2888 if (maxarg < 1)
2889 goto say_undef;
2890 if ((arg[1].arg_type & A_MASK) == A_WORD)
2891 stab = arg[1].arg_ptr.arg_stab;
2892 else
2893 stab = stabent(str_get(st[1]),TRUE);
2894 if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
2895 goto say_undef;
2896#ifdef DOSISH
2897#ifdef atarist
2898 if(fflush(fp))
2899 str_set(str, No);
2900 else
2901 {
2902 fp->_flag |= _IOBIN;
2903 str_set(str, Yes);
2904 }
2905#else
2906 str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No);
2907#endif
2908#else
2909 str_set(str, Yes);
2910#endif
2911 STABSET(str);
2912 break;
2913 case O_VEC:
2914 sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
2915 goto array_return;
2916 case O_GPWNAM:
2917 case O_GPWUID:
2918 case O_GPWENT:
2919#ifdef HAS_PASSWD
2920 sp = do_gpwent(optype,
2921 gimme,arglast);
2922 goto array_return;
2923 case O_SPWENT:
2924 value = (double) setpwent();
2925 goto donumset;
2926 case O_EPWENT:
2927 value = (double) endpwent();
2928 goto donumset;
2929#else
2930 case O_EPWENT:
2931 case O_SPWENT:
2932 fatal("Unsupported password function");
2933 break;
2934#endif
2935 case O_GGRNAM:
2936 case O_GGRGID:
2937 case O_GGRENT:
2938#ifdef HAS_GROUP
2939 sp = do_ggrent(optype,
2940 gimme,arglast);
2941 goto array_return;
2942 case O_SGRENT:
2943 value = (double) setgrent();
2944 goto donumset;
2945 case O_EGRENT:
2946 value = (double) endgrent();
2947 goto donumset;
2948#else
2949 case O_EGRENT:
2950 case O_SGRENT:
2951 fatal("Unsupported group function");
2952 break;
2953#endif
2954 case O_GETLOGIN:
2955#ifdef HAS_GETLOGIN
2956 if (!(tmps = getlogin()))
2957 goto say_undef;
2958 str_set(str,tmps);
2959#else
2960 fatal("Unsupported function getlogin");
2961#endif
2962 break;
2963 case O_OPEN_DIR:
2964 case O_READDIR:
2965 case O_TELLDIR:
2966 case O_SEEKDIR:
2967 case O_REWINDDIR:
2968 case O_CLOSEDIR:
2969 if (maxarg < 1)
2970 goto say_undef;
2971 if ((arg[1].arg_type & A_MASK) == A_WORD)
2972 stab = arg[1].arg_ptr.arg_stab;
2973 else
2974 stab = stabent(str_get(st[1]),TRUE);
2975 if (!stab)
2976 goto say_undef;
2977 sp = do_dirop(optype,stab,gimme,arglast);
2978 goto array_return;
2979 case O_SYSCALL:
2980 value = (double)do_syscall(arglast);
2981 goto donumset;
2982 case O_PIPE_OP:
2983#ifdef HAS_PIPE
2984 if ((arg[1].arg_type & A_MASK) == A_WORD)
2985 stab = arg[1].arg_ptr.arg_stab;
2986 else
2987 stab = stabent(str_get(st[1]),TRUE);
2988 if ((arg[2].arg_type & A_MASK) == A_WORD)
2989 stab2 = arg[2].arg_ptr.arg_stab;
2990 else
2991 stab2 = stabent(str_get(st[2]),TRUE);
2992 do_pipe(str,stab,stab2);
2993 STABSET(str);
2994#else
2995 fatal("Unsupported function pipe");
2996#endif
2997 break;
2998 }
2999
3000 normal_return:
3001 st[1] = str;
3002#ifdef DEBUGGING
3003 if (debug) {
3004 dlevel--;
3005 if (debug & 8)
3006 deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
3007 }
3008#endif
3009 return arglast[0] + 1;
3010}
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.