eval.c

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