eval.c

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