eval.c

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