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