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