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