eval.c

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