eval.c

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