eval.c.save

   1 /* $RCSfile: eval.c,v $$Revision: 4.1 $$Date: 92/08/07 18:20:29 $
   2  *
   3  *    Copyright (c) 1991, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  * $Log:        eval.c,v $
   9  * Revision 4.1  92/08/07  18:20:29  lwall
  10  *
  11  * Revision 4.0.1.4  92/06/08  13:20:20  lwall
  12  * patch20: added explicit time_t support
  13  * patch20: fixed confusion between a *var's real name and its effective name
  14  * patch20: added Atari ST portability
  15  * patch20: new warning for use of x with non-numeric right operand
  16  * patch20: modulus with highest bit in left operand set didn't always work
  17  * patch20: dbmclose(%array) didn't work
  18  * patch20: added ... as variant on ..
  19  * patch20: O_PIPE conflicted with Atari
  20  *
  21  * Revision 4.0.1.3  91/11/05  17:15:21  lwall
  22  * patch11: prepared for ctype implementations that don't define isascii()
  23  * patch11: various portability fixes
  24  * patch11: added sort {} LIST
  25  * patch11: added eval {}
  26  * patch11: sysread() in socket was substituting recv()
  27  * patch11: a last statement outside any block caused occasional core dumps
  28  * patch11: missing arguments caused core dump in -D8 code
  29  * patch11: eval 'stuff' now optimized to eval {stuff}
  30  *
  31  * Revision 4.0.1.2  91/06/07  11:07:23  lwall
  32  * patch4: new copyright notice
  33  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  34  * patch4: assignment wasn't correctly de-tainting the assigned variable.
  35  * patch4: default top-of-form format is now FILEHANDLE_TOP
  36  * patch4: added $^P variable to control calling of perldb routines
  37  * patch4: taintchecks could improperly modify parent in vfork()
  38  * patch4: many, many itty-bitty portability fixes
  39  *
  40  * Revision 4.0.1.1  91/04/11  17:43:48  lwall
  41  * patch1: fixed failed fork to return undef as documented
  42  * patch1: reduced maximum branch distance in eval.c
  43  *
  44  * Revision 4.0  91/03/20  01:16:48  lwall
  45  * 4.0 baseline.
  46  *
  47  */
  48
  49 #include "EXTERN.h"
  50 #include "perl.h"
  51
  52 extern int (*ppaddr[])();
  53 extern int mark[];
  54
  55 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  56 #include <signal.h>
  57 #endif
  58
  59 #ifdef I_FCNTL
  60 #include <fcntl.h>
  61 #endif
  62 #ifdef MSDOS
  63 /* I_FCNTL *MUST* not be defined for MS-DOS and OS/2
  64    but fcntl.h is required for O_BINARY */
  65 #include <fcntl.h>
  66 #endif
  67 #ifdef I_SYS_FILE
  68 #include <sys/file.h>
  69 #endif
  70 #ifdef I_VFORK
  71 #   include <vfork.h>
  72 #endif
  73
  74 double sin(), cos(), atan2(), pow();
  75
  76 char *getlogin();
  77
  78 int
  79 eval(arg,gimme,sp)
  80 register ARG *arg;
  81 int gimme;
  82 register int sp;
  83 {
  84     register STR *str;
  85     register int anum;
  86     register int optype;
  87     register STR **st;
  88     int maxarg;
  89     double value;
  90     register char *tmps;
  91     char *tmps2;
  92     int argflags;
  93     int argtype;
  94     union argptr argptr;
  95     int arglast[8];     /* highest sp for arg--valid only for non-O_LIST args */
  96     unsigned long tmpulong;
  97     long tmplong;
  98     time_t when;
  99     STRLEN tmplen;
 100     FILE *fp;
 101     STR *tmpstr;
 102     FCMD *form;
 103     STAB *stab;
 104     STAB *stab2;
 105     STIO *stio;
 106     ARRAY *ary;
 107     int old_rslen;
 108     int old_rschar;
 109     VOIDRET (*ihand)();     /* place to save signal during system() */
 110     VOIDRET (*qhand)();     /* place to save signal during system() */
 111     bool assigning = FALSE;
 112     int mymarkbase = savestack->ary_fill;
 113
 114     if (!arg)
 115         goto say_undef;
 116     optype = arg->arg_type;
 117     maxarg = arg->arg_len;
 118     arglast[0] = sp;
 119     str = arg->arg_ptr.arg_str;
 120     if (sp + maxarg > stack->ary_max)
 121         astore(stack, sp + maxarg, Nullstr);
 122     st = stack->ary_array;
 123
 124 #ifdef DEBUGGING
 125     if (debug) {
 126         if (debug & 8) {
 127             deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
 128         }
 129         debname[dlevel] = opname[optype][0];
 130         debdelim[dlevel] = ':';
 131         if (++dlevel >= dlmax)
 132             grow_dlevel();
 133     }
 134 #endif
 135
 136     if (mark[optype]) {
 137         saveint(&markbase);
 138         markbase = mymarkbase;
 139         saveint(&stack_mark);
 140         stack_mark = sp;
 141     }
 142     for (anum = 1; anum <= maxarg; anum++) {
 143         argflags = arg[anum].arg_flags;
 144         argtype = arg[anum].arg_type;
 145         argptr = arg[anum].arg_ptr;
 146       re_eval:
 147         switch (argtype) {
 148         default:
 149             if (!ppaddr[optype] || optype == O_SUBR || optype == O_DBSUBR) {
 150                 st[++sp] = &str_undef;
 151             }
 152 #ifdef DEBUGGING
 153             tmps = "NULL";
 154 #endif
 155             break;
 156         case A_EXPR:
 157 #ifdef DEBUGGING
 158             if (debug & 8) {
 159                 tmps = "EXPR";
 160                 deb("%d.EXPR =>\n",anum);
 161             }
 162 #endif
 163             sp = eval(argptr.arg_arg,
 164                 (argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp);
 165             if (sp + (maxarg - anum) > stack->ary_max)
 166                 astore(stack, sp + (maxarg - anum), Nullstr);
 167             st = stack->ary_array;      /* possibly reallocated */
 168             break;
 169         case A_CMD:
 170 #ifdef DEBUGGING
 171             if (debug & 8) {
 172                 tmps = "CMD";
 173                 deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
 174             }
 175 #endif
 176             sp = cmd_exec(argptr.arg_cmd, gimme, sp);
 177             if (sp + (maxarg - anum) > stack->ary_max)
 178                 astore(stack, sp + (maxarg - anum), Nullstr);
 179             st = stack->ary_array;      /* possibly reallocated */
 180             break;
 181         case A_LARYSTAB:
 182             ++sp;
 183             switch (optype) {
 184                 case O_ITEM2: argtype = 2; break;
 185                 case O_ITEM3: argtype = 3; break;
 186                 default:      argtype = anum; break;
 187             }
 188             str = afetch(stab_array(argptr.arg_stab),
 189                 arg[argtype].arg_len - arybase, TRUE);
 190 #ifdef DEBUGGING
 191             if (debug & 8) {
 192                 (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
 193                     arg[argtype].arg_len);
 194                 tmps = buf;
 195             }
 196 #endif
 197             goto do_crement;
 198         case A_ARYSTAB:
 199             switch (optype) {
 200                 case O_ITEM2: argtype = 2; break;
 201                 case O_ITEM3: argtype = 3; break;
 202                 default:      argtype = anum; break;
 203             }
 204             st[++sp] = afetch(stab_array(argptr.arg_stab),
 205                 arg[argtype].arg_len - arybase, FALSE);
 206 #ifdef DEBUGGING
 207             if (debug & 8) {
 208                 (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
 209                     arg[argtype].arg_len);
 210                 tmps = buf;
 211             }
 212 #endif
 213             break;
 214         case A_STAR:
 215             stab = argptr.arg_stab;
 216             st[++sp] = (STR*)stab;
 217             if (!stab_xarray(stab))
 218                 aadd(stab);
 219             if (!stab_xhash(stab))
 220                 hadd(stab);
 221             if (!stab_io(stab))
 222                 stab_io(stab) = stio_new();
 223 #ifdef DEBUGGING
 224             if (debug & 8) {
 225                 (void)sprintf(buf,"STAR *%s -> *%s",
 226                     stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
 227                 tmps = buf;
 228             }
 229 #endif
 230             break;
 231         case A_LSTAR:
 232             str = st[++sp] = (STR*)argptr.arg_stab;
 233 #ifdef DEBUGGING
 234             if (debug & 8) {
 235                 (void)sprintf(buf,"LSTAR *%s -> *%s",
 236                 stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
 237                 tmps = buf;
 238             }
 239 #endif
 240             break;
 241         case A_STAB:
 242             st[++sp] = STAB_STR(argptr.arg_stab);
 243 #ifdef DEBUGGING
 244             if (debug & 8) {
 245                 (void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab));
 246                 tmps = buf;
 247             }
 248 #endif
 249             break;
 250         case A_LENSTAB:
 251             str_numset(str, (double)STAB_LEN(argptr.arg_stab));
 252             st[++sp] = str;
 253 #ifdef DEBUGGING
 254             if (debug & 8) {
 255                 (void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab));
 256                 tmps = buf;
 257             }
 258 #endif
 259             break;
 260         case A_LEXPR:
 261 #ifdef DEBUGGING
 262             if (debug & 8) {
 263                 tmps = "LEXPR";
 264                 deb("%d.LEXPR =>\n",anum);
 265             }
 266 #endif
 267             if (argflags & AF_ARYOK) {
 268                 sp = eval(argptr.arg_arg, G_ARRAY, sp);
 269                 if (sp + (maxarg - anum) > stack->ary_max)
 270                     astore(stack, sp + (maxarg - anum), Nullstr);
 271                 st = stack->ary_array;  /* possibly reallocated */
 272             }
 273             else {
 274                 sp = eval(argptr.arg_arg, G_SCALAR, sp);
 275                 st = stack->ary_array;  /* possibly reallocated */
 276                 str = st[sp];
 277                 goto do_crement;
 278             }
 279             break;
 280         case A_LVAL:
 281 #ifdef DEBUGGING
 282             if (debug & 8) {
 283                 (void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab));
 284                 tmps = buf;
 285             }
 286 #endif
 287             ++sp;
 288             str = STAB_STR(argptr.arg_stab);
 289             if (!str)
 290                 fatal("panic: A_LVAL");
 291           do_crement:
 292             assigning = TRUE;
 293             if (argflags & AF_PRE) {
 294                 if (argflags & AF_UP)
 295                     str_inc(str);
 296                 else
 297                     str_dec(str);
 298                 STABSET(str);
 299                 st[sp] = str;
 300                 str = arg->arg_ptr.arg_str;
 301             }
 302             else if (argflags & AF_POST) {
 303                 st[sp] = str_mortal(str);
 304                 if (argflags & AF_UP)
 305                     str_inc(str);
 306                 else
 307                     str_dec(str);
 308                 STABSET(str);
 309                 str = arg->arg_ptr.arg_str;
 310             }
 311             else
 312                 st[sp] = str;
 313             break;
 314         case A_LARYLEN:
 315             ++sp;
 316             stab = argptr.arg_stab;
 317             str = stab_array(argptr.arg_stab)->ary_magic;
 318             if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST))
 319                 str_numset(str,(double)(stab_array(stab)->ary_fill+arybase));
 320 #ifdef DEBUGGING
 321             tmps = "LARYLEN";
 322 #endif
 323             if (!str)
 324                 fatal("panic: A_LEXPR");
 325             goto do_crement;
 326         case A_ARYLEN:
 327             stab = argptr.arg_stab;
 328             st[++sp] = stab_array(stab)->ary_magic;
 329             str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase));
 330 #ifdef DEBUGGING
 331             tmps = "ARYLEN";
 332 #endif
 333             break;
 334         case A_SINGLE:
 335             st[++sp] = argptr.arg_str;
 336 #ifdef DEBUGGING
 337             tmps = "SINGLE";
 338 #endif
 339             break;
 340         case A_DOUBLE:
 341             (void) interp(str,argptr.arg_str,sp);
 342             st = stack->ary_array;
 343             st[++sp] = str;
 344 #ifdef DEBUGGING
 345             tmps = "DOUBLE";
 346 #endif
 347             break;
 348         case A_BACKTICK:
 349             tmps = str_get(interp(str,argptr.arg_str,sp));
 350             st = stack->ary_array;
 351 #ifdef TAINT
 352             TAINT_PROPER("``");
 353 #endif
 354             fp = mypopen(tmps,"r");
 355             str_set(str,"");
 356             if (fp) {
 357                 if (gimme == G_SCALAR) {
 358                     while (str_gets(str,fp,str->str_cur) != Nullch)
 359                         /*SUPPRESS 530*/
 360                         ;
 361                 }
 362                 else {
 363                     for (;;) {
 364                         if (++sp > stack->ary_max) {
 365                             astore(stack, sp, Nullstr);
 366                             st = stack->ary_array;
 367                         }
 368                         str = st[sp] = Str_new(56,80);
 369                         if (str_gets(str,fp,0) == Nullch) {
 370                             sp--;
 371                             break;
 372                         }
 373                         if (str->str_len - str->str_cur > 20) {
 374                             str->str_len = str->str_cur+1;
 375                             Renew(str->str_ptr, str->str_len, char);
 376                         }
 377                         str_2mortal(str);
 378                     }
 379                 }
 380                 statusvalue = mypclose(fp);
 381             }
 382             else
 383                 statusvalue = -1;
 384
 385             if (gimme == G_SCALAR)
 386                 st[++sp] = str;
 387 #ifdef DEBUGGING
 388             tmps = "BACK";
 389 #endif
 390             break;
 391         case A_WANTARRAY:
 392             {
 393                 if (curcsv->wantarray == G_ARRAY)
 394                     st[++sp] = &str_yes;
 395                 else
 396                     st[++sp] = &str_no;
 397             }
 398 #ifdef DEBUGGING
 399             tmps = "WANTARRAY";
 400 #endif
 401             break;
 402         case A_INDREAD:
 403             last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
 404             old_rschar = rschar;
 405             old_rslen = rslen;
 406             goto do_read;
 407         case A_GLOB:
 408             argflags |= AF_POST;        /* enable newline chopping */
 409             last_in_stab = argptr.arg_stab;
 410             old_rschar = rschar;
 411             old_rslen = rslen;
 412             rslen = 1;
 413 #ifdef DOSISH
 414             rschar = 0;
 415 #else
 416 #ifdef CSH
 417             rschar = 0;
 418 #else
 419             rschar = '\n';
 420 #endif  /* !CSH */
 421 #endif  /* !MSDOS */
 422             goto do_read;
 423         case A_READ:
 424             last_in_stab = argptr.arg_stab;
 425             old_rschar = rschar;
 426             old_rslen = rslen;
 427           do_read:
 428             if (anum > 1)               /* assign to scalar */
 429                 gimme = G_SCALAR;       /* force context to scalar */
 430             if (gimme == G_ARRAY)
 431                 str = Str_new(57,0);
 432             ++sp;
 433             fp = Nullfp;
 434             if (stab_io(last_in_stab)) {
 435                 fp = stab_io(last_in_stab)->ifp;
 436                 if (!fp) {
 437                     if (stab_io(last_in_stab)->flags & IOF_ARGV) {
 438                         if (stab_io(last_in_stab)->flags & IOF_START) {
 439                             stab_io(last_in_stab)->flags &= ~IOF_START;
 440                             stab_io(last_in_stab)->lines = 0;
 441                             if (alen(stab_array(last_in_stab)) < 0) {
 442                                 tmpstr = str_make("-",1); /* assume stdin */
 443                                 (void)apush(stab_array(last_in_stab), tmpstr);
 444                             }
 445                         }
 446                         fp = nextargv(last_in_stab);
 447                         if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */
 448                             (void)do_close(last_in_stab,FALSE); /* now it does*/
 449                             stab_io(last_in_stab)->flags |= IOF_START;
 450                         }
 451                     }
 452                     else if (argtype == A_GLOB) {
 453                         (void) interp(str,stab_val(last_in_stab),sp);
 454                         st = stack->ary_array;
 455                         tmpstr = Str_new(55,0);
 456 #ifdef DOSISH
 457                         str_set(tmpstr, "perlglob ");
 458                         str_scat(tmpstr,str);
 459                         str_cat(tmpstr," |");
 460 #else
 461 #ifdef CSH
 462                         str_nset(tmpstr,cshname,cshlen);
 463                         str_cat(tmpstr," -cf 'set nonomatch; glob ");
 464                         str_scat(tmpstr,str);
 465                         str_cat(tmpstr,"'|");
 466 #else
 467                         str_set(tmpstr, "echo ");
 468                         str_scat(tmpstr,str);
 469                         str_cat(tmpstr,
 470                           "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
 471 #endif /* !CSH */
 472 #endif /* !MSDOS */
 473                         (void)do_open(last_in_stab,tmpstr->str_ptr,
 474                           tmpstr->str_cur);
 475                         fp = stab_io(last_in_stab)->ifp;
 476                         str_free(tmpstr);
 477                     }
 478                 }
 479             }
 480             if (!fp && dowarn)
 481                 warn("Read on closed filehandle <%s>",stab_ename(last_in_stab));
 482             tmplen = str->str_len;      /* remember if already alloced */
 483             if (!tmplen)
 484                 Str_Grow(str,80);       /* try short-buffering it */
 485           keepgoing:
 486             if (!fp)
 487                 st[sp] = &str_undef;
 488             else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) {
 489                 clearerr(fp);
 490                 if (stab_io(last_in_stab)->flags & IOF_ARGV) {
 491                     fp = nextargv(last_in_stab);
 492                     if (fp)
 493                         goto keepgoing;
 494                     (void)do_close(last_in_stab,FALSE);
 495                     stab_io(last_in_stab)->flags |= IOF_START;
 496                 }
 497                 else if (argflags & AF_POST) {
 498                     (void)do_close(last_in_stab,FALSE);
 499                 }
 500                 st[sp] = &str_undef;
 501                 rschar = old_rschar;
 502                 rslen = old_rslen;
 503                 if (gimme == G_ARRAY) {
 504                     --sp;
 505                     str_2mortal(str);
 506                     goto array_return;
 507                 }
 508                 break;
 509             }
 510             else {
 511                 stab_io(last_in_stab)->lines++;
 512                 st[sp] = str;
 513 #ifdef TAINT
 514                 str->str_tainted = 1; /* Anything from the outside world...*/
 515 #endif
 516                 if (argflags & AF_POST) {
 517                     if (str->str_cur > 0)
 518                         str->str_cur--;
 519                     if (str->str_ptr[str->str_cur] == rschar)
 520                         str->str_ptr[str->str_cur] = '\0';
 521                     else
 522                         str->str_cur++;
 523                     for (tmps = str->str_ptr; *tmps; tmps++)
 524                         if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
 525                             index("$&*(){}[]'\";\\|?<>~`",*tmps))
 526                                 break;
 527                     if (*tmps && stat(str->str_ptr,&statbuf) < 0)
 528                         goto keepgoing;         /* unmatched wildcard? */
 529                 }
 530                 if (gimme == G_ARRAY) {
 531                     if (str->str_len - str->str_cur > 20) {
 532                         str->str_len = str->str_cur+1;
 533                         Renew(str->str_ptr, str->str_len, char);
 534                     }
 535                     str_2mortal(str);
 536                     if (++sp > stack->ary_max) {
 537                         astore(stack, sp, Nullstr);
 538                         st = stack->ary_array;
 539                     }
 540                     str = Str_new(58,80);
 541                     goto keepgoing;
 542                 }
 543                 else if (!tmplen && str->str_len - str->str_cur > 80) {
 544                     /* try to reclaim a bit of scalar space on 1st alloc */
 545                     if (str->str_cur < 60)
 546                         str->str_len = 80;
 547                     else
 548                         str->str_len = str->str_cur+40; /* allow some slop */
 549                     Renew(str->str_ptr, str->str_len, char);
 550                 }
 551             }
 552             rschar = old_rschar;
 553             rslen = old_rslen;
 554 #ifdef DEBUGGING
 555             tmps = "READ";
 556 #endif
 557             break;
 558         }
 559 #ifdef DEBUGGING
 560         if (debug & 8) {
 561             if (strEQ(tmps, "NULL"))
 562                 deb("%d.%s\n",anum,tmps);
 563             else
 564                 deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp]));
 565         }
 566 #endif
 567         if (anum < 8)
 568             arglast[anum] = sp;
 569     }
 570
 571     if (ppaddr[optype]) {
 572         int status;
 573
 574         /* pretend like we've been maintaining stack_* all along */
 575         stack_ary = stack->ary_array;
 576         stack_sp = stack_ary + sp;
 577         if (mark[optype] && stack_mark != arglast[0])
 578             warn("Inconsistent stack mark %d != %d", stack_mark, arglast[0]);
 579         stack_max = stack_ary + stack->ary_max;
 580
 581         status = (*ppaddr[optype])(str, arg, gimme);
 582
 583         if (savestack->ary_fill > mymarkbase) {
 584             warn("Inconsistent stack base");
 585             restorelist(mymarkbase);
 586         }
 587         sp = stack_sp - stack_ary;
 588         if (sp < arglast[0])
 589             warn("TOO MANY POPS");
 590         st += arglast[0];
 591         goto array_return;
 592     }
 593
 594     st += arglast[0];
 595
 596 #ifdef SMALLSWITCHES
 597     if (optype < O_CHOWN)
 598 #endif
 599     switch (optype) {
 600     case O_RCAT:
 601         STABSET(str);
 602         break;
 603     case O_ITEM:
 604         if (gimme == G_ARRAY)
 605             goto array_return;
 606         /* FALL THROUGH */
 607     case O_SCALAR:
 608         STR_SSET(str,st[1]);
 609         STABSET(str);
 610         break;
 611     case O_ITEM2:
 612         if (gimme == G_ARRAY)
 613             goto array_return;
 614         --anum;
 615         STR_SSET(str,st[arglast[anum]-arglast[0]]);
 616         STABSET(str);
 617         break;
 618     case O_ITEM3:
 619         if (gimme == G_ARRAY)
 620         goto array_return;
 621         --anum;
 622         STR_SSET(str,st[arglast[anum]-arglast[0]]);
 623         STABSET(str);
 624         break;
 625     case O_CONCAT:
 626         STR_SSET(str,st[1]);
 627         str_scat(str,st[2]);
 628         STABSET(str);
 629         break;
 630     case O_REPEAT:
 631         if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) {
 632             sp = do_repeatary(arglast);
 633             goto array_return;
 634         }
 635         STR_SSET(str,st[1]);
 636         anum = (int)str_gnum(st[2]);
 637         if (anum >= 1) {
 638             tmpstr = Str_new(50, 0);
 639             tmps = str_get(str);
 640             str_nset(tmpstr,tmps,str->str_cur);
 641             tmps = str_get(tmpstr);     /* force to be string */
 642             STR_GROW(str, (anum * str->str_cur) + 1);
 643             repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
 644             str->str_cur *= anum;
 645             str->str_ptr[str->str_cur] = '\0';
 646             str->str_nok = 0;
 647             str_free(tmpstr);
 648         }
 649         else {
 650             if (dowarn && st[2]->str_pok && !looks_like_number(st[2]))
 651                 warn("Right operand of x is not numeric");
 652             str_sset(str,&str_no);
 653         }
 654         STABSET(str);
 655         break;
 656     case O_MATCH:
 657         sp = do_match(str,arg,
 658           gimme,arglast);
 659         if (gimme == G_ARRAY)
 660             goto array_return;
 661         STABSET(str);
 662         break;
 663     case O_NMATCH:
 664         sp = do_match(str,arg,
 665           G_SCALAR,arglast);
 666         str_sset(str, str_true(str) ? &str_no : &str_yes);
 667         STABSET(str);
 668         break;
 669     case O_SUBST:
 670         sp = do_subst(str,arg,arglast[0]);
 671         goto array_return;
 672     case O_NSUBST:
 673         sp = do_subst(str,arg,arglast[0]);
 674         str = arg->arg_ptr.arg_str;
 675         str_set(str, str_true(str) ? No : Yes);
 676         goto array_return;
 677     case O_ASSIGN:
 678         if (arg[1].arg_flags & AF_ARYOK) {
 679             if (arg->arg_len == 1) {
 680                 arg->arg_type = O_LOCAL;
 681                 goto local;
 682             }
 683             else {
 684                 arg->arg_type = O_AASSIGN;
 685                 goto aassign;
 686             }
 687         }
 688         else {
 689             arg->arg_type = O_SASSIGN;
 690             goto sassign;
 691         }
 692     case O_LOCAL:
 693       local:
 694         arglast[2] = arglast[1];        /* push a null array */
 695         /* FALL THROUGH */
 696     case O_AASSIGN:
 697       aassign:
 698         sp = do_assign(arg,
 699           gimme,arglast);
 700         goto array_return;
 701     case O_SASSIGN:
 702       sassign:
 703 #ifdef TAINT
 704         if (tainted && !st[2]->str_tainted)
 705             tainted = 0;
 706 #endif
 707         STR_SSET(str, st[2]);
 708         STABSET(str);
 709         break;
 710     case O_CHOP:
 711         st -= arglast[0];
 712         str = arg->arg_ptr.arg_str;
 713         for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
 714             do_chop(str,st[sp]);
 715         st += arglast[0];
 716         break;
 717     case O_DEFINED:
 718         if (arg[1].arg_type & A_DONT) {
 719             sp = do_defined(str,arg,
 720                   gimme,arglast);
 721             goto array_return;
 722         }
 723         else if (str->str_pok || str->str_nok)
 724             goto say_yes;
 725         goto say_no;
 726     case O_UNDEF:
 727         if (arg[1].arg_type & A_DONT) {
 728             sp = do_undef(str,arg,
 729               gimme,arglast);
 730             goto array_return;
 731         }
 732         else if (str != stab_val(defstab)) {
 733             if (str->str_len) {
 734                 if (str->str_state == SS_INCR)
 735                     Str_Grow(str,0);
 736                 Safefree(str->str_ptr);
 737                 str->str_ptr = Nullch;
 738                 str->str_len = 0;
 739             }
 740             str->str_pok = str->str_nok = 0;
 741             STABSET(str);
 742         }
 743         goto say_undef;
 744     case O_STUDY:
 745         sp = do_study(str,arg,
 746           gimme,arglast);
 747         goto array_return;
 748     case O_POW:
 749         value = str_gnum(st[1]);
 750         value = pow(value,str_gnum(st[2]));
 751         goto donumset;
 752     case O_MULTIPLY:
 753         value = str_gnum(st[1]);
 754         value *= str_gnum(st[2]);
 755         goto donumset;
 756     case O_DIVIDE:
 757         if ((value = str_gnum(st[2])) == 0.0)
 758             fatal("Illegal division by zero");
 759 #ifdef SLOPPYDIVIDE
 760         /* insure that 20./5. == 4. */
 761         {
 762             double x;
 763             int    k;
 764             x =  str_gnum(st[1]);
 765             if ((double)(int)x     == x &&
 766                 (double)(int)value == value &&
 767                 (k = (int)x/(int)value)*(int)value == (int)x) {
 768                 value = k;
 769             } else {
 770                 value = x/value;
 771             }
 772         }
 773 #else
 774         value = str_gnum(st[1]) / value;
 775 #endif
 776         goto donumset;
 777     case O_MODULO:
 778         tmpulong = (unsigned long) str_gnum(st[2]);
 779         if (tmpulong == 0L)
 780             fatal("Illegal modulus zero");
 781 #ifndef lint
 782         value = str_gnum(st[1]);
 783         if (value >= 0.0)
 784             value = (double)(((unsigned long)value) % tmpulong);
 785         else {
 786             tmplong = (long)value;
 787             value = (double)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
 788         }
 789 #endif
 790         goto donumset;
 791     case O_ADD:
 792         value = str_gnum(st[1]);
 793         value += str_gnum(st[2]);
 794         goto donumset;
 795     case O_SUBTRACT:
 796         value = str_gnum(st[1]);
 797         value -= str_gnum(st[2]);
 798         goto donumset;
 799     case O_LEFT_SHIFT:
 800         value = str_gnum(st[1]);
 801         anum = (int)str_gnum(st[2]);
 802 #ifndef lint
 803         value = (double)(U_L(value) << anum);
 804 #endif
 805         goto donumset;
 806     case O_RIGHT_SHIFT:
 807         value = str_gnum(st[1]);
 808         anum = (int)str_gnum(st[2]);
 809 #ifndef lint
 810         value = (double)(U_L(value) >> anum);
 811 #endif
 812         goto donumset;
 813     case O_LT:
 814         value = str_gnum(st[1]);
 815         value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
 816         goto donumset;
 817     case O_GT:
 818         value = str_gnum(st[1]);
 819         value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
 820         goto donumset;
 821     case O_LE:
 822         value = str_gnum(st[1]);
 823         value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
 824         goto donumset;
 825     case O_GE:
 826         value = str_gnum(st[1]);
 827         value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
 828         goto donumset;
 829     case O_EQ:
 830         if (dowarn) {
 831             if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
 832                 (!st[2]->str_nok && !looks_like_number(st[2])) )
 833                 warn("Possible use of == on string value");
 834         }
 835         value = str_gnum(st[1]);
 836         value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
 837         goto donumset;
 838     case O_NE:
 839         value = str_gnum(st[1]);
 840         value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
 841         goto donumset;
 842     case O_NCMP:
 843         value = str_gnum(st[1]);
 844         value -= str_gnum(st[2]);
 845         if (value > 0.0)
 846             value = 1.0;
 847         else if (value < 0.0)
 848             value = -1.0;
 849         goto donumset;
 850     case O_BIT_AND:
 851         if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
 852             value = str_gnum(st[1]);
 853 #ifndef lint
 854             value = (double)(U_L(value) & U_L(str_gnum(st[2])));
 855 #endif
 856             goto donumset;
 857         }
 858         else
 859             do_vop(optype,str,st[1],st[2]);
 860         break;
 861     case O_XOR:
 862         if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
 863             value = str_gnum(st[1]);
 864 #ifndef lint
 865             value = (double)(U_L(value) ^ U_L(str_gnum(st[2])));
 866 #endif
 867             goto donumset;
 868         }
 869         else
 870             do_vop(optype,str,st[1],st[2]);
 871         break;
 872     case O_BIT_OR:
 873         if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
 874             value = str_gnum(st[1]);
 875 #ifndef lint
 876             value = (double)(U_L(value) | U_L(str_gnum(st[2])));
 877 #endif
 878             goto donumset;
 879         }
 880         else
 881             do_vop(optype,str,st[1],st[2]);
 882         break;
 883 /* use register in evaluating str_true() */
 884     case O_AND:
 885         if (str_true(st[1])) {
 886             anum = 2;
 887             optype = O_ITEM2;
 888             argflags = arg[anum].arg_flags;
 889             if (gimme == G_ARRAY)
 890                 argflags |= AF_ARYOK;
 891             argtype = arg[anum].arg_type & A_MASK;
 892             argptr = arg[anum].arg_ptr;
 893             maxarg = anum = 1;
 894             sp = arglast[0];
 895             st -= sp;
 896             goto re_eval;
 897         }
 898         else {
 899             if (assigning) {
 900                 str_sset(str, st[1]);
 901                 STABSET(str);
 902             }
 903             else
 904                 str = st[1];
 905             break;
 906         }
 907     case O_OR:
 908         if (str_true(st[1])) {
 909             if (assigning) {
 910                 str_sset(str, st[1]);
 911                 STABSET(str);
 912             }
 913             else
 914                 str = st[1];
 915             break;
 916         }
 917         else {
 918             anum = 2;
 919             optype = O_ITEM2;
 920             argflags = arg[anum].arg_flags;
 921             if (gimme == G_ARRAY)
 922                 argflags |= AF_ARYOK;
 923             argtype = arg[anum].arg_type & A_MASK;
 924             argptr = arg[anum].arg_ptr;
 925             maxarg = anum = 1;
 926             sp = arglast[0];
 927             st -= sp;
 928             goto re_eval;
 929         }
 930     case O_COND_EXPR:
 931         anum = (str_true(st[1]) ? 2 : 3);
 932         optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
 933         argflags = arg[anum].arg_flags;
 934         if (gimme == G_ARRAY)
 935             argflags |= AF_ARYOK;
 936         argtype = arg[anum].arg_type & A_MASK;
 937         argptr = arg[anum].arg_ptr;
 938         maxarg = anum = 1;
 939         sp = arglast[0];
 940         st -= sp;
 941         goto re_eval;
 942     case O_COMMA:
 943         if (gimme == G_ARRAY)
 944             goto array_return;
 945         str = st[2];
 946         break;
 947     case O_NEGATE:
 948         value = -str_gnum(st[1]);
 949         goto donumset;
 950     case O_NOT:
 951 #ifdef NOTNOT
 952         { char xxx = str_true(st[1]); value = (double) !xxx; }
 953 #else
 954         value = (double) !str_true(st[1]);
 955 #endif
 956         goto donumset;
 957     case O_COMPLEMENT:
 958         if (!sawvec || st[1]->str_nok) {
 959 #ifndef lint
 960             value = (double) ~U_L(str_gnum(st[1]));
 961 #endif
 962             goto donumset;
 963         }
 964         else {
 965             STR_SSET(str,st[1]);
 966             tmps = str_get(str);
 967             for (anum = str->str_cur; anum; anum--, tmps++)
 968                 *tmps = ~*tmps;
 969         }
 970         break;
 971     case O_SELECT:
 972         stab_efullname(str,defoutstab);
 973         if (maxarg > 0) {
 974             if ((arg[1].arg_type & A_MASK) == A_WORD)
 975                 defoutstab = arg[1].arg_ptr.arg_stab;
 976             else
 977                 defoutstab = stabent(str_get(st[1]),TRUE);
 978             if (!stab_io(defoutstab))
 979                 stab_io(defoutstab) = stio_new();
 980             curoutstab = defoutstab;
 981         }
 982         STABSET(str);
 983         break;
 984     case O_WRITE:
 985         if (maxarg == 0)
 986             stab = defoutstab;
 987         else if ((arg[1].arg_type & A_MASK) == A_WORD) {
 988             if (!(stab = arg[1].arg_ptr.arg_stab))
 989                 stab = defoutstab;
 990         }
 991         else
 992             stab = stabent(str_get(st[1]),TRUE);
 993         if (!stab_io(stab)) {
 994             str_set(str, No);
 995             STABSET(str);
 996             break;
 997         }
 998         curoutstab = stab;
 999         fp = stab_io(stab)->ofp;
1000         if (stab_io(stab)->fmt_stab)
1001             form = stab_form(stab_io(stab)->fmt_stab);
1002         else
1003             form = stab_form(stab);
1004         if (!form || !fp) {
1005             if (dowarn) {
1006                 if (form)
1007                     warn("No format for filehandle");
1008                 else {
1009                     if (stab_io(stab)->ifp)
1010                         warn("Filehandle only opened for input");
1011                     else
1012                         warn("Write on closed filehandle");
1013                 }
1014             }
1015             str_set(str, No);
1016             STABSET(str);
1017             break;
1018         }
1019         format(&outrec,form,sp);
1020         do_write(&outrec,stab,sp);
1021         if (stab_io(stab)->flags & IOF_FLUSH)
1022             (void)fflush(fp);
1023         str_set(str, Yes);
1024         STABSET(str);
1025         break;
1026     case O_DBMOPEN:
1027 #ifdef SOME_DBM
1028         anum = arg[1].arg_type & A_MASK;
1029         if (anum == A_WORD || anum == A_STAB)
1030             stab = arg[1].arg_ptr.arg_stab;
1031         else
1032             stab = stabent(str_get(st[1]),TRUE);
1033         if (st[3]->str_nok || st[3]->str_pok)
1034             anum = (int)str_gnum(st[3]);
1035         else
1036             anum = -1;
1037         value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
1038         goto donumset;
1039 #else
1040         fatal("No dbm or ndbm on this machine");
1041 #endif
1042     case O_DBMCLOSE:
1043 #ifdef SOME_DBM
1044         anum = arg[1].arg_type & A_MASK;
1045         if (anum == A_WORD || anum == A_STAB)
1046             stab = arg[1].arg_ptr.arg_stab;
1047         else
1048             stab = stabent(str_get(st[1]),TRUE);
1049         hdbmclose(stab_hash(stab));
1050         goto say_yes;
1051 #else
1052         fatal("No dbm or ndbm on this machine");
1053 #endif
1054     case O_OPEN:
1055         if ((arg[1].arg_type & A_MASK) == A_WORD)
1056             stab = arg[1].arg_ptr.arg_stab;
1057         else
1058             stab = stabent(str_get(st[1]),TRUE);
1059         tmps = str_get(st[2]);
1060         if (do_open(stab,tmps,st[2]->str_cur)) {
1061             value = (double)forkprocess;
1062             stab_io(stab)->lines = 0;
1063             goto donumset;
1064         }
1065         else if (forkprocess == 0)              /* we are a new child */
1066             goto say_zero;
1067         else
1068             goto say_undef;
1069         /* break; */
1070     case O_TRANS:
1071         value = (double) do_trans(str,arg);
1072         str = arg->arg_ptr.arg_str;
1073         goto donumset;
1074     case O_NTRANS:
1075         str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
1076         str = arg->arg_ptr.arg_str;
1077         break;
1078     case O_CLOSE:
1079         if (maxarg == 0)
1080             stab = defoutstab;
1081         else if ((arg[1].arg_type & A_MASK) == A_WORD)
1082             stab = arg[1].arg_ptr.arg_stab;
1083         else
1084             stab = stabent(str_get(st[1]),TRUE);
1085         str_set(str, do_close(stab,TRUE) ? Yes : No );
1086         STABSET(str);
1087         break;
1088     case O_EACH:
1089         sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
1090           gimme,arglast);
1091         goto array_return;
1092     case O_VALUES:
1093     case O_KEYS:
1094         sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
1095           gimme,arglast);
1096         goto array_return;
1097     case O_LARRAY:
1098         str->str_nok = str->str_pok = 0;
1099         str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
1100         str->str_state = SS_ARY;
1101         break;
1102     case O_ARRAY:
1103         ary = stab_array(arg[1].arg_ptr.arg_stab);
1104         maxarg = ary->ary_fill + 1;
1105         if (gimme == G_ARRAY) { /* array wanted */
1106             sp = arglast[0];
1107             st -= sp;
1108             if (maxarg > 0 && sp + maxarg > stack->ary_max) {
1109                 astore(stack,sp + maxarg, Nullstr);
1110                 st = stack->ary_array;
1111             }
1112             st += sp;
1113             Copy(ary->ary_array, &st[1], maxarg, STR*);
1114             sp += maxarg;
1115             goto array_return;
1116         }
1117         else {
1118             value = (double)maxarg;
1119             goto donumset;
1120         }
1121     case O_AELEM:
1122         anum = ((int)str_gnum(st[2])) - arybase;
1123         str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
1124         break;
1125     case O_DELETE:
1126         tmpstab = arg[1].arg_ptr.arg_stab;
1127         tmps = str_get(st[2]);
1128         str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
1129         if (tmpstab == envstab)
1130             my_setenv(tmps,Nullch);
1131         if (!str)
1132             goto say_undef;
1133         break;
1134     case O_LHASH:
1135         str->str_nok = str->str_pok = 0;
1136         str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
1137         str->str_state = SS_HASH;
1138         break;
1139     case O_HASH:
1140         if (gimme == G_ARRAY) { /* array wanted */
1141             sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
1142                 gimme,arglast);
1143             goto array_return;
1144         }
1145         else {
1146             tmpstab = arg[1].arg_ptr.arg_stab;
1147             if (!stab_hash(tmpstab)->tbl_fill)
1148                 goto say_zero;
1149             sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
1150                 stab_hash(tmpstab)->tbl_max+1);
1151             str_set(str,buf);
1152         }
1153         break;
1154     case O_HELEM:
1155         tmpstab = arg[1].arg_ptr.arg_stab;
1156         tmps = str_get(st[2]);
1157         str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
1158         break;
1159     case O_LAELEM:
1160         anum = ((int)str_gnum(st[2])) - arybase;
1161         str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
1162         if (!str || str == &str_undef)
1163             fatal("Assignment to non-creatable value, subscript %d",anum);
1164         break;
1165     case O_LHELEM:
1166         tmpstab = arg[1].arg_ptr.arg_stab;
1167         tmps = str_get(st[2]);
1168         anum = st[2]->str_cur;
1169         str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
1170         if (!str || str == &str_undef)
1171             fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
1172         if (tmpstab == envstab)         /* heavy wizardry going on here */
1173             str_magic(str, tmpstab, 'E', tmps, anum);   /* str is now magic */
1174                                         /* he threw the brick up into the air */
1175         else if (tmpstab == sigstab)
1176             str_magic(str, tmpstab, 'S', tmps, anum);
1177 #ifdef SOME_DBM
1178         else if (stab_hash(tmpstab)->tbl_dbm)
1179             str_magic(str, tmpstab, 'D', tmps, anum);
1180 #endif
1181         else if (tmpstab == DBline)
1182             str_magic(str, tmpstab, 'L', tmps, anum);
1183         break;
1184     case O_LSLICE:
1185         anum = 2;
1186         argtype = FALSE;
1187         goto do_slice_already;
1188     case O_ASLICE:
1189         anum = 1;
1190         argtype = FALSE;
1191         goto do_slice_already;
1192     case O_HSLICE:
1193         anum = 0;
1194         argtype = FALSE;
1195         goto do_slice_already;
1196     case O_LASLICE:
1197         anum = 1;
1198         argtype = TRUE;
1199         goto do_slice_already;
1200     case O_LHSLICE:
1201         anum = 0;
1202         argtype = TRUE;
1203       do_slice_already:
1204         sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype,
1205             gimme,arglast);
1206         goto array_return;
1207     case O_SPLICE:
1208         sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast);
1209         goto array_return;
1210     case O_PUSH:
1211         if (arglast[2] - arglast[1] != 1)
1212             str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
1213         else {
1214             str = Str_new(51,0);                /* must copy the STR */
1215             str_sset(str,st[2]);
1216             (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
1217         }
1218         break;
1219     case O_POP:
1220         str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
1221         goto staticalization;
1222     case O_SHIFT:
1223         str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
1224       staticalization:
1225         if (!str)
1226             goto say_undef;
1227         if (ary->ary_flags & ARF_REAL)
1228             (void)str_2mortal(str);
1229         break;
1230     case O_UNPACK:
1231         sp = do_unpack(str,gimme,arglast);
1232         goto array_return;
1233     case O_SPLIT:
1234         value = str_gnum(st[3]);
1235         sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
1236           gimme,arglast);
1237         goto array_return;
1238     case O_LENGTH:
1239         if (maxarg < 1)
1240             value = (double)str_len(stab_val(defstab));
1241         else
1242             value = (double)str_len(st[1]);
1243         goto donumset;
1244     case O_SPRINTF:
1245         do_sprintf(str, sp-arglast[0], st+1);
1246         break;
1247     case O_SUBSTR:
1248         anum = ((int)str_gnum(st[2])) - arybase;        /* anum=where to start*/
1249         tmps = str_get(st[1]);          /* force conversion to string */
1250         /*SUPPRESS 560*/
1251         if (argtype = (str == st[1]))
1252             str = arg->arg_ptr.arg_str;
1253         if (anum < 0)
1254             anum += st[1]->str_cur + arybase;
1255         if (anum < 0 || anum > st[1]->str_cur)
1256             str_nset(str,"",0);
1257         else {
1258             optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]);
1259             if (optype < 0)
1260                 optype = 0;
1261             tmps += anum;
1262             anum = st[1]->str_cur - anum;       /* anum=how many bytes left*/
1263             if (anum > optype)
1264                 anum = optype;
1265             str_nset(str, tmps, anum);
1266             if (argtype) {                      /* it's an lvalue! */
1267                 Lstring *lstr = (Lstring*)str;
1268
1269                 str->str_magic = st[1];
1270                 st[1]->str_rare = 's';
1271                 lstr->lstr_offset = tmps - str_get(st[1]);
1272                 lstr->lstr_len = anum;
1273             }
1274         }
1275         break;
1276     case O_PACK:
1277         /*SUPPRESS 701*/
1278         (void)do_pack(str,arglast);
1279         break;
1280     case O_GREP:
1281         sp = do_grep(arg,str,gimme,arglast);
1282         goto array_return;
1283     case O_JOIN:
1284         do_join(str,arglast);
1285         break;
1286     case O_SLT:
1287         tmps = str_get(st[1]);
1288         value = (double) (str_cmp(st[1],st[2]) < 0);
1289         goto donumset;
1290     case O_SGT:
1291         tmps = str_get(st[1]);
1292         value = (double) (str_cmp(st[1],st[2]) > 0);
1293         goto donumset;
1294     case O_SLE:
1295         tmps = str_get(st[1]);
1296         value = (double) (str_cmp(st[1],st[2]) <= 0);
1297         goto donumset;
1298     case O_SGE:
1299         tmps = str_get(st[1]);
1300         value = (double) (str_cmp(st[1],st[2]) >= 0);
1301         goto donumset;
1302     case O_SEQ:
1303         tmps = str_get(st[1]);
1304         value = (double) str_eq(st[1],st[2]);
1305         goto donumset;
1306     case O_SNE:
1307         tmps = str_get(st[1]);
1308         value = (double) !str_eq(st[1],st[2]);
1309         goto donumset;
1310     case O_SCMP:
1311         tmps = str_get(st[1]);
1312         value = (double) str_cmp(st[1],st[2]);
1313         goto donumset;
1314     case O_SUBR:
1315         sp = do_subr(arg,gimme,arglast);
1316         st = stack->ary_array + arglast[0];             /* maybe realloced */
1317         goto array_return;
1318     case O_DBSUBR:
1319         sp = do_subr(arg,gimme,arglast);
1320         st = stack->ary_array + arglast[0];             /* maybe realloced */
1321         goto array_return;
1322     case O_CALLER:
1323         sp = do_caller(arg,maxarg,gimme,arglast);
1324         st = stack->ary_array + arglast[0];             /* maybe realloced */
1325         goto array_return;
1326     case O_SORT:
1327         sp = do_sort(str,arg,
1328           gimme,arglast);
1329         goto array_return;
1330     case O_REVERSE:
1331         if (gimme == G_ARRAY)
1332             sp = do_reverse(arglast);
1333         else
1334             sp = do_sreverse(str, arglast);
1335         goto array_return;
1336     case O_WARN:
1337         if (arglast[2] - arglast[1] != 1) {
1338             do_join(str,arglast);
1339             tmps = str_get(str);
1340         }
1341         else {
1342             str = st[2];
1343             tmps = str_get(st[2]);
1344         }
1345         if (!tmps || !*tmps)
1346             tmps = "Warning: something's wrong";
1347         warn("%s",tmps);
1348         goto say_yes;
1349     case O_DIE:
1350         if (arglast[2] - arglast[1] != 1) {
1351             do_join(str,arglast);
1352             tmps = str_get(str);
1353         }
1354         else {
1355             str = st[2];
1356             tmps = str_get(st[2]);
1357         }
1358         if (!tmps || !*tmps)
1359             tmps = "Died";
1360         fatal("%s",tmps);
1361         goto say_zero;
1362     case O_PRTF:
1363     case O_PRINT:
1364         if ((arg[1].arg_type & A_MASK) == A_WORD)
1365             stab = arg[1].arg_ptr.arg_stab;
1366         else
1367             stab = stabent(str_get(st[1]),TRUE);
1368         if (!stab)
1369             stab = defoutstab;
1370         if (!stab_io(stab)) {
1371             if (dowarn)
1372                 warn("Filehandle never opened");
1373             goto say_zero;
1374         }
1375         if (!(fp = stab_io(stab)->ofp)) {
1376             if (dowarn)  {
1377                 if (stab_io(stab)->ifp)
1378                     warn("Filehandle opened only for input");
1379                 else
1380                     warn("Print on closed filehandle");
1381             }
1382             goto say_zero;
1383         }
1384         else {
1385             if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
1386                 value = (double)do_aprint(arg,fp,arglast);
1387             else {
1388                 value = (double)do_print(st[2],fp);
1389                 if (orslen && optype == O_PRINT)
1390                     if (fwrite(ors, 1, orslen, fp) == 0)
1391                         goto say_zero;
1392             }
1393             if (stab_io(stab)->flags & IOF_FLUSH)
1394                 if (fflush(fp) == EOF)
1395                     goto say_zero;
1396         }
1397         goto donumset;
1398     case O_CHDIR:
1399         if (maxarg < 1)
1400             tmps = Nullch;
1401         else
1402             tmps = str_get(st[1]);
1403         if (!tmps || !*tmps) {
1404             tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
1405             tmps = str_get(tmpstr);
1406         }
1407         if (!tmps || !*tmps) {
1408             tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
1409             tmps = str_get(tmpstr);
1410         }
1411 #ifdef TAINT
1412         TAINT_PROPER("chdir");
1413 #endif
1414         value = (double)(chdir(tmps) >= 0);
1415         goto donumset;
1416     case O_EXIT:
1417         if (maxarg < 1)
1418             anum = 0;
1419         else
1420             anum = (int)str_gnum(st[1]);
1421         my_exit(anum);
1422         goto say_zero;
1423     case O_RESET:
1424         if (maxarg < 1)
1425             tmps = "";
1426         else
1427             tmps = str_get(st[1]);
1428         str_reset(tmps,curcmd->c_stash);
1429         value = 1.0;
1430         goto donumset;
1431     case O_LIST:
1432         if (gimme == G_ARRAY)
1433             goto array_return;
1434         if (maxarg > 0)
1435             str = st[sp - arglast[0]];  /* unwanted list, return last item */
1436         else
1437             str = &str_undef;
1438         break;
1439     case O_EOF:
1440         if (maxarg <= 0)
1441             stab = last_in_stab;
1442         else if ((arg[1].arg_type & A_MASK) == A_WORD)
1443             stab = arg[1].arg_ptr.arg_stab;
1444         else
1445             stab = stabent(str_get(st[1]),TRUE);
1446         str_set(str, do_eof(stab) ? Yes : No);
1447         STABSET(str);
1448         break;
1449     case O_GETC:
1450         if (maxarg <= 0)
1451             stab = stdinstab;
1452         else if ((arg[1].arg_type & A_MASK) == A_WORD)
1453             stab = arg[1].arg_ptr.arg_stab;
1454         else
1455             stab = stabent(str_get(st[1]),TRUE);
1456         if (!stab)
1457             stab = argvstab;
1458         if (!stab || do_eof(stab)) /* make sure we have fp with something */
1459             goto say_undef;
1460         else {
1461 #ifdef TAINT
1462             tainted = 1;
1463 #endif
1464             str_set(str," ");
1465             *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
1466         }
1467         STABSET(str);
1468         break;
1469     case O_TELL:
1470         if (maxarg <= 0)
1471             stab = last_in_stab;
1472         else if ((arg[1].arg_type & A_MASK) == A_WORD)
1473             stab = arg[1].arg_ptr.arg_stab;
1474         else
1475             stab = stabent(str_get(st[1]),TRUE);
1476 #ifndef lint
1477         value = (double)do_tell(stab);
1478 #else
1479         (void)do_tell(stab);
1480 #endif
1481         goto donumset;
1482     case O_RECV:
1483     case O_READ:
1484     case O_SYSREAD:
1485         if ((arg[1].arg_type & A_MASK) == A_WORD)
1486             stab = arg[1].arg_ptr.arg_stab;
1487         else
1488             stab = stabent(str_get(st[1]),TRUE);
1489         tmps = str_get(st[2]);
1490         anum = (int)str_gnum(st[3]);
1491         errno = 0;
1492         maxarg = sp - arglast[0];
1493         if (maxarg > 4)
1494             warn("Too many args on read");
1495         if (maxarg == 4)
1496             maxarg = (int)str_gnum(st[4]);
1497         else
1498             maxarg = 0;
1499         if (!stab_io(stab) || !stab_io(stab)->ifp)
1500             goto say_undef;
1501 #ifdef HAS_SOCKET
1502         if (optype == O_RECV) {
1503             argtype = sizeof buf;
1504             STR_GROW(st[2], anum+1), (tmps = str_get(st[2]));  /* sneaky */
1505             anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg,
1506                 buf, &argtype);
1507             if (anum >= 0) {
1508                 st[2]->str_cur = anum;
1509                 st[2]->str_ptr[anum] = '\0';
1510                 str_nset(str,buf,argtype);
1511             }
1512             else
1513                 str_sset(str,&str_undef);
1514             break;
1515         }
1516 #else
1517         if (optype == O_RECV)
1518             goto badsock;
1519 #endif
1520         STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2]));  /* sneaky */
1521         if (optype == O_SYSREAD) {
1522             anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
1523         }
1524         else
1525 #ifdef HAS_SOCKET
1526         if (stab_io(stab)->type == 's') {
1527             argtype = sizeof buf;
1528             anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0,
1529                 buf, &argtype);
1530         }
1531         else
1532 #endif
1533             anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
1534         if (anum < 0)
1535             goto say_undef;
1536         st[2]->str_cur = anum+maxarg;
1537         st[2]->str_ptr[anum+maxarg] = '\0';
1538         value = (double)anum;
1539         goto donumset;
1540     case O_SYSWRITE:
1541     case O_SEND:
1542         if ((arg[1].arg_type & A_MASK) == A_WORD)
1543             stab = arg[1].arg_ptr.arg_stab;
1544         else
1545             stab = stabent(str_get(st[1]),TRUE);
1546         tmps = str_get(st[2]);
1547         anum = (int)str_gnum(st[3]);
1548         errno = 0;
1549         stio = stab_io(stab);
1550         maxarg = sp - arglast[0];
1551         if (!stio || !stio->ifp) {
1552             anum = -1;
1553             if (dowarn) {
1554                 if (optype == O_SYSWRITE)
1555                     warn("Syswrite on closed filehandle");
1556                 else
1557                     warn("Send on closed socket");
1558             }
1559         }
1560         else if (optype == O_SYSWRITE) {
1561             if (maxarg > 4)
1562                 warn("Too many args on syswrite");
1563             if (maxarg == 4)
1564                 optype = (int)str_gnum(st[4]);
1565             else
1566                 optype = 0;
1567             anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum);
1568         }
1569 #ifdef HAS_SOCKET
1570         else if (maxarg >= 4) {
1571             if (maxarg > 4)
1572                 warn("Too many args on send");
1573             tmps2 = str_get(st[4]);
1574             anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
1575               anum, tmps2, st[4]->str_cur);
1576         }
1577         else
1578             anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
1579 #else
1580         else
1581             goto badsock;
1582 #endif
1583         if (anum < 0)
1584             goto say_undef;
1585         value = (double)anum;
1586         goto donumset;
1587     case O_SEEK:
1588         if ((arg[1].arg_type & A_MASK) == A_WORD)
1589             stab = arg[1].arg_ptr.arg_stab;
1590         else
1591             stab = stabent(str_get(st[1]),TRUE);
1592         value = str_gnum(st[2]);
1593         str_set(str, do_seek(stab,
1594           (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
1595         STABSET(str);
1596         break;
1597     case O_RETURN:
1598         tmps = "_SUB_";         /* just fake up a "last _SUB_" */
1599         optype = O_LAST;
1600         if (curcsv && curcsv->wantarray == G_ARRAY) {
1601             lastretstr = Nullstr;
1602             lastspbase = arglast[1];
1603             lastsize = arglast[2] - arglast[1];
1604         }
1605         else
1606             lastretstr = str_mortal(st[arglast[2] - arglast[0]]);
1607         goto dopop;
1608     case O_REDO:
1609     case O_NEXT:
1610     case O_LAST:
1611         tmps = Nullch;
1612         if (maxarg > 0) {
1613             tmps = str_get(arg[1].arg_ptr.arg_str);
1614           dopop:
1615             while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
1616               strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
1617 #ifdef DEBUGGING
1618                 if (debug & 4) {
1619                     deb("(Skipping label #%d %s)\n",loop_ptr,
1620                         loop_stack[loop_ptr].loop_label);
1621                 }
1622 #endif
1623                 loop_ptr--;
1624             }
1625 #ifdef DEBUGGING
1626             if (debug & 4) {
1627                 deb("(Found label #%d %s)\n",loop_ptr,
1628                     loop_stack[loop_ptr].loop_label);
1629             }
1630 #endif
1631         }
1632         if (loop_ptr < 0) {
1633             if (tmps && strEQ(tmps, "_SUB_"))
1634                 fatal("Can't return outside a subroutine");
1635             fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
1636         }
1637         if (!lastretstr && optype == O_LAST && lastsize) {
1638             st -= arglast[0];
1639             st += lastspbase + 1;
1640             optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
1641             if (optype) {
1642                 for (anum = lastsize; anum > 0; anum--,st++)
1643                     st[optype] = str_mortal(st[0]);
1644             }
1645             longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
1646         }
1647         longjmp(loop_stack[loop_ptr].loop_env, optype);
1648     case O_DUMP:
1649     case O_GOTO:/* shudder */
1650         goto_targ = str_get(arg[1].arg_ptr.arg_str);
1651         if (!*goto_targ)
1652             goto_targ = Nullch;         /* just restart from top */
1653         if (optype == O_DUMP) {
1654             do_undump = TRUE;
1655             my_unexec();
1656         }
1657         longjmp(top_env, 1);
1658     case O_INDEX:
1659         tmps = str_get(st[1]);
1660         if (maxarg < 3)
1661             anum = 0;
1662         else {
1663             anum = (int) str_gnum(st[3]) - arybase;
1664             if (anum < 0)
1665                 anum = 0;
1666             else if (anum > st[1]->str_cur)
1667                 anum = st[1]->str_cur;
1668         }
1669 #ifndef lint
1670         if (!(tmps2 = fbminstr((unsigned char*)tmps + anum,
1671           (unsigned char*)tmps + st[1]->str_cur, st[2])))
1672 #else
1673         if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
1674 #endif
1675             value = (double)(-1 + arybase);
1676         else
1677             value = (double)(tmps2 - tmps + arybase);
1678         goto donumset;
1679     case O_RINDEX:
1680         tmps = str_get(st[1]);
1681         tmps2 = str_get(st[2]);
1682         if (maxarg < 3)
1683             anum = st[1]->str_cur;
1684         else {
1685             anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur;
1686             if (anum < 0)
1687                 anum = 0;
1688             else if (anum > st[1]->str_cur)
1689                 anum = st[1]->str_cur;
1690         }
1691 #ifndef lint
1692         if (!(tmps2 = rninstr(tmps,  tmps  + anum,
1693                               tmps2, tmps2 + st[2]->str_cur)))
1694 #else
1695         if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
1696 #endif
1697             value = (double)(-1 + arybase);
1698         else
1699             value = (double)(tmps2 - tmps + arybase);
1700         goto donumset;
1701     case O_TIME:
1702 #ifndef lint
1703         value = (double) time(Null(long*));
1704 #endif
1705         goto donumset;
1706     case O_TMS:
1707         sp = do_tms(str,gimme,arglast);
1708         goto array_return;
1709     case O_LOCALTIME:
1710         if (maxarg < 1)
1711             (void)time(&when);
1712         else
1713             when = (time_t)str_gnum(st[1]);
1714         sp = do_time(str,localtime(&when),
1715           gimme,arglast);
1716         goto array_return;
1717     case O_GMTIME:
1718         if (maxarg < 1)
1719             (void)time(&when);
1720         else
1721             when = (time_t)str_gnum(st[1]);
1722         sp = do_time(str,gmtime(&when),
1723           gimme,arglast);
1724         goto array_return;
1725     case O_TRUNCATE:
1726         sp = do_truncate(str,arg,
1727           gimme,arglast);
1728         goto array_return;
1729     case O_LSTAT:
1730     case O_STAT:
1731         sp = do_stat(str,arg,
1732           gimme,arglast);
1733         goto array_return;
1734     case O_CRYPT:
1735 #ifdef HAS_CRYPT
1736         tmps = str_get(st[1]);
1737 #ifdef FCRYPT
1738         str_set(str,fcrypt(tmps,str_get(st[2])));
1739 #else
1740         str_set(str,crypt(tmps,str_get(st[2])));
1741 #endif
1742 #else
1743         fatal(
1744           "The crypt() function is unimplemented due to excessive paranoia.");
1745 #endif
1746         break;
1747     case O_ATAN2:
1748         value = str_gnum(st[1]);
1749         value = atan2(value,str_gnum(st[2]));
1750         goto donumset;
1751     case O_SIN:
1752         if (maxarg < 1)
1753             value = str_gnum(stab_val(defstab));
1754         else
1755             value = str_gnum(st[1]);
1756         value = sin(value);
1757         goto donumset;
1758     case O_COS:
1759         if (maxarg < 1)
1760             value = str_gnum(stab_val(defstab));
1761         else
1762             value = str_gnum(st[1]);
1763         value = cos(value);
1764         goto donumset;
1765     case O_RAND:
1766         if (maxarg < 1)
1767             value = 1.0;
1768         else
1769             value = str_gnum(st[1]);
1770         if (value == 0.0)
1771             value = 1.0;
1772 #if RANDBITS == 31
1773         value = rand() * value / 2147483648.0;
1774 #else
1775 #if RANDBITS == 16
1776         value = rand() * value / 65536.0;
1777 #else
1778 #if RANDBITS == 15
1779         value = rand() * value / 32768.0;
1780 #else
1781         value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1782 #endif
1783 #endif
1784 #endif
1785         goto donumset;
1786     case O_SRAND:
1787         if (maxarg < 1) {
1788             (void)time(&when);
1789             anum = when;
1790         }
1791         else
1792             anum = (int)str_gnum(st[1]);
1793         (void)srand(anum);
1794         goto say_yes;
1795     case O_EXP:
1796         if (maxarg < 1)
1797             value = str_gnum(stab_val(defstab));
1798         else
1799             value = str_gnum(st[1]);
1800         value = exp(value);
1801         goto donumset;
1802     case O_LOG:
1803         if (maxarg < 1)
1804             value = str_gnum(stab_val(defstab));
1805         else
1806             value = str_gnum(st[1]);
1807         if (value <= 0.0)
1808             fatal("Can't take log of %g\n", value);
1809         value = log(value);
1810         goto donumset;
1811     case O_SQRT:
1812         if (maxarg < 1)
1813             value = str_gnum(stab_val(defstab));
1814         else
1815             value = str_gnum(st[1]);
1816         if (value < 0.0)
1817             fatal("Can't take sqrt of %g\n", value);
1818         value = sqrt(value);
1819         goto donumset;
1820     case O_INT:
1821         if (maxarg < 1)
1822             value = str_gnum(stab_val(defstab));
1823         else
1824             value = str_gnum(st[1]);
1825         if (value >= 0.0)
1826             (void)modf(value,&value);
1827         else {
1828             (void)modf(-value,&value);
1829             value = -value;
1830         }
1831         goto donumset;
1832     case O_ORD:
1833         if (maxarg < 1)
1834             tmps = str_get(stab_val(defstab));
1835         else
1836             tmps = str_get(st[1]);
1837 #ifndef I286
1838         value = (double) (*tmps & 255);
1839 #else
1840         anum = (int) *tmps;
1841         value = (double) (anum & 255);
1842 #endif
1843         goto donumset;
1844     case O_ALARM:
1845 #ifdef HAS_ALARM
1846         if (maxarg < 1)
1847             tmps = str_get(stab_val(defstab));
1848         else
1849             tmps = str_get(st[1]);
1850         if (!tmps)
1851             tmps = "0";
1852         anum = alarm((unsigned int)atoi(tmps));
1853         if (anum < 0)
1854             goto say_undef;
1855         value = (double)anum;
1856         goto donumset;
1857 #else
1858         fatal("Unsupported function alarm");
1859         break;
1860 #endif
1861     case O_SLEEP:
1862         if (maxarg < 1)
1863             tmps = Nullch;
1864         else
1865             tmps = str_get(st[1]);
1866         (void)time(&when);
1867         if (!tmps || !*tmps)
1868             sleep((32767<<16)+32767);
1869         else
1870             sleep((unsigned int)atoi(tmps));
1871 #ifndef lint
1872         value = (double)when;
1873         (void)time(&when);
1874         value = ((double)when) - value;
1875 #endif
1876         goto donumset;
1877     case O_RANGE:
1878         sp = do_range(gimme,arglast);
1879         goto array_return;
1880     case O_F_OR_R:
1881         if (gimme == G_ARRAY) {         /* it's a range */
1882             /* can we optimize to constant array? */
1883             if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
1884               (arg[2].arg_type & A_MASK) == A_SINGLE) {
1885                 st[2] = arg[2].arg_ptr.arg_str;
1886                 sp = do_range(gimme,arglast);
1887                 st = stack->ary_array;
1888                 maxarg = sp - arglast[0];
1889                 str_free(arg[1].arg_ptr.arg_str);
1890                 arg[1].arg_ptr.arg_str = Nullstr;
1891                 str_free(arg[2].arg_ptr.arg_str);
1892                 arg[2].arg_ptr.arg_str = Nullstr;
1893                 arg->arg_type = O_ARRAY;
1894                 arg[1].arg_type = A_STAB|A_DONT;
1895                 arg->arg_len = 1;
1896                 stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
1897                 ary = stab_array(stab);
1898                 afill(ary,maxarg - 1);
1899                 anum = maxarg;
1900                 st += arglast[0]+1;
1901                 while (maxarg-- > 0)
1902                     ary->ary_array[maxarg] = str_smake(st[maxarg]);
1903                 st -= arglast[0]+1;
1904                 goto array_return;
1905             }
1906             arg->arg_type = optype = O_RANGE;
1907             maxarg = arg->arg_len = 2;
1908             anum = 2;
1909             arg[anum].arg_flags &= ~AF_ARYOK;
1910             argflags = arg[anum].arg_flags;
1911             argtype = arg[anum].arg_type & A_MASK;
1912             arg[anum].arg_type = argtype;
1913             argptr = arg[anum].arg_ptr;
1914             sp = arglast[0];
1915             st -= sp;
1916             sp++;
1917             goto re_eval;
1918         }
1919         arg->arg_type = O_FLIP;
1920         /* FALL THROUGH */
1921     case O_FLIP:
1922         if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
1923           last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
1924           :
1925           str_true(st[1]) ) {
1926             arg[2].arg_type &= ~A_DONT;
1927             arg[1].arg_type |= A_DONT;
1928             arg->arg_type = optype = O_FLOP;
1929             if (arg->arg_flags & AF_COMMON) {
1930                 str_numset(str,0.0);
1931                 anum = 2;
1932                 argflags = arg[2].arg_flags;
1933                 argtype = arg[2].arg_type & A_MASK;
1934                 argptr = arg[2].arg_ptr;
1935                 sp = arglast[0];
1936                 st -= sp++;
1937                 goto re_eval;
1938             }
1939             else {
1940                 str_numset(str,1.0);
1941                 break;
1942             }
1943         }
1944         str_set(str,"");
1945         break;
1946     case O_FLOP:
1947         str_inc(str);
1948         if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
1949           last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
1950           :
1951           str_true(st[2]) ) {
1952             arg->arg_type = O_FLIP;
1953             arg[1].arg_type &= ~A_DONT;
1954             arg[2].arg_type |= A_DONT;
1955             str_cat(str,"E0");
1956         }
1957         break;
1958     case O_FORK:
1959 #ifdef HAS_FORK
1960         anum = fork();
1961         if (anum < 0)
1962             goto say_undef;
1963         if (!anum) {
1964             /*SUPPRESS 560*/
1965             if (tmpstab = stabent("$",allstabs))
1966                 str_numset(STAB_STR(tmpstab),(double)getpid());
1967             hclear(pidstatus, FALSE);   /* no kids, so don't wait for 'em */
1968         }
1969         value = (double)anum;
1970         goto donumset;
1971 #else
1972         fatal("Unsupported function fork");
1973         break;
1974 #endif
1975     case O_WAIT:
1976 #ifdef HAS_WAIT
1977 #ifndef lint
1978         anum = wait(&argflags);
1979         if (anum > 0)
1980             pidgone(anum,argflags);
1981         value = (double)anum;
1982 #endif
1983         statusvalue = (unsigned short)argflags;
1984         goto donumset;
1985 #else
1986         fatal("Unsupported function wait");
1987         break;
1988 #endif
1989     case O_WAITPID:
1990 #ifdef HAS_WAIT
1991 #ifndef lint
1992         anum = (int)str_gnum(st[1]);
1993         optype = (int)str_gnum(st[2]);
1994         anum = wait4pid(anum, &argflags,optype);
1995         value = (double)anum;
1996 #endif
1997         statusvalue = (unsigned short)argflags;
1998         goto donumset;
1999 #else
2000         fatal("Unsupported function wait");
2001         break;
2002 #endif
2003     case O_SYSTEM:
2004 #ifdef HAS_FORK
2005 #ifdef TAINT
2006         if (arglast[2] - arglast[1] == 1) {
2007             taintenv();
2008             tainted |= st[2]->str_tainted;
2009             TAINT_PROPER("system");
2010         }
2011 #endif
2012         while ((anum = vfork()) == -1) {
2013             if (errno != EAGAIN) {
2014                 value = -1.0;
2015                 goto donumset;
2016             }
2017             sleep(5);
2018         }
2019         if (anum > 0) {
2020 #ifndef lint
2021             ihand = signal(SIGINT, SIG_IGN);
2022             qhand = signal(SIGQUIT, SIG_IGN);
2023             argtype = wait4pid(anum, &argflags, 0);
2024 #else
2025             ihand = qhand = 0;
2026 #endif
2027             (void)signal(SIGINT, ihand);
2028             (void)signal(SIGQUIT, qhand);
2029             statusvalue = (unsigned short)argflags;
2030             if (argtype < 0)
2031                 value = -1.0;
2032             else {
2033                 value = (double)((unsigned int)argflags & 0xffff);
2034             }
2035             do_execfree();      /* free any memory child malloced on vfork */
2036             goto donumset;
2037         }
2038         if ((arg[1].arg_type & A_MASK) == A_STAB)
2039             value = (double)do_aexec(st[1],arglast);
2040         else if (arglast[2] - arglast[1] != 1)
2041             value = (double)do_aexec(Nullstr,arglast);
2042         else {
2043             value = (double)do_exec(str_get(str_mortal(st[2])));
2044         }
2045         _exit(-1);
2046 #else /* ! FORK */
2047         if ((arg[1].arg_type & A_MASK) == A_STAB)
2048             value = (double)do_aspawn(st[1],arglast);
2049         else if (arglast[2] - arglast[1] != 1)
2050             value = (double)do_aspawn(Nullstr,arglast);
2051         else {
2052             value = (double)do_spawn(str_get(str_mortal(st[2])));
2053         }
2054         goto donumset;
2055 #endif /* FORK */
2056     case O_EXEC_OP:
2057         if ((arg[1].arg_type & A_MASK) == A_STAB)
2058             value = (double)do_aexec(st[1],arglast);
2059         else if (arglast[2] - arglast[1] != 1)
2060             value = (double)do_aexec(Nullstr,arglast);
2061         else {
2062 #ifdef TAINT
2063             taintenv();
2064             tainted |= st[2]->str_tainted;
2065             TAINT_PROPER("exec");
2066 #endif
2067             value = (double)do_exec(str_get(str_mortal(st[2])));
2068         }
2069         goto donumset;
2070     case O_HEX:
2071         if (maxarg < 1)
2072             tmps = str_get(stab_val(defstab));
2073         else
2074             tmps = str_get(st[1]);
2075         value = (double)scanhex(tmps, 99, &argtype);
2076         goto donumset;
2077
2078     case O_OCT:
2079         if (maxarg < 1)
2080             tmps = str_get(stab_val(defstab));
2081         else
2082             tmps = str_get(st[1]);
2083         while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
2084             tmps++;
2085         if (*tmps == 'x')
2086             value = (double)scanhex(++tmps, 99, &argtype);
2087         else
2088             value = (double)scanoct(tmps, 99, &argtype);
2089         goto donumset;
2090
2091 /* These common exits are hidden here in the middle of the switches for the
2092    benefit of those machines with limited branch addressing.  Sigh.  */
2093
2094 array_return:
2095 #ifdef DEBUGGING
2096     if (debug) {
2097         dlevel--;
2098         if (debug & 8) {
2099             anum = sp - arglast[0];
2100             switch (anum) {
2101             case 0:
2102                 deb("%s RETURNS ()\n",opname[optype]);
2103                 break;
2104             case 1:
2105                 deb("%s RETURNS (\"%s\")\n",opname[optype],
2106                     st[1] ? str_get(st[1]) : "");
2107                 break;
2108             default:
2109                 tmps = st[1] ? str_get(st[1]) : "";
2110                 deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
2111                   anum,tmps,anum==2?"":"...,",
2112                         st[anum] ? str_get(st[anum]) : "");
2113                 break;
2114             }
2115         }
2116     }
2117 #endif
2118     stack_ary = stack->ary_array;
2119     stack_max = stack_ary + stack->ary_max;
2120     stack_sp = stack_ary + sp;
2121     return sp;
2122
2123 say_yes:
2124     str = &str_yes;
2125     goto normal_return;
2126
2127 say_no:
2128     str = &str_no;
2129     goto normal_return;
2130
2131 say_undef:
2132     str = &str_undef;
2133     goto normal_return;
2134
2135 say_zero:
2136     value = 0.0;
2137     /* FALL THROUGH */
2138
2139 donumset:
2140     str_numset(str,value);
2141     STABSET(str);
2142     st[1] = str;
2143 #ifdef DEBUGGING
2144     if (debug) {
2145         dlevel--;
2146         if (debug & 8)
2147             deb("%s RETURNS \"%f\"\n",opname[optype],value);
2148     }
2149 #endif
2150     stack_ary = stack->ary_array;
2151     stack_max = stack_ary + stack->ary_max;
2152     stack_sp = stack_ary + arglast[0] + 1;
2153     return arglast[0] + 1;
2154 #ifdef SMALLSWITCHES
2155     }
2156     else
2157     switch (optype) {
2158 #endif
2159     case O_CHOWN:
2160 #ifdef HAS_CHOWN
2161         value = (double)apply(optype,arglast);
2162         goto donumset;
2163 #else
2164         fatal("Unsupported function chown");
2165         break;
2166 #endif
2167     case O_KILL:
2168 #ifdef HAS_KILL
2169         value = (double)apply(optype,arglast);
2170         goto donumset;
2171 #else
2172         fatal("Unsupported function kill");
2173         break;
2174 #endif
2175     case O_UNLINK:
2176     case O_CHMOD:
2177     case O_UTIME:
2178         value = (double)apply(optype,arglast);
2179         goto donumset;
2180     case O_UMASK:
2181 #ifdef HAS_UMASK
2182         if (maxarg < 1) {
2183             anum = umask(0);
2184             (void)umask(anum);
2185         }
2186         else
2187             anum = umask((int)str_gnum(st[1]));
2188         value = (double)anum;
2189 #ifdef TAINT
2190         TAINT_PROPER("umask");
2191 #endif
2192         goto donumset;
2193 #else
2194         fatal("Unsupported function umask");
2195         break;
2196 #endif
2197 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
2198     case O_MSGGET:
2199     case O_SHMGET:
2200     case O_SEMGET:
2201         if ((anum = do_ipcget(optype, arglast)) == -1)
2202             goto say_undef;
2203         value = (double)anum;
2204         goto donumset;
2205     case O_MSGCTL:
2206     case O_SHMCTL:
2207     case O_SEMCTL:
2208         anum = do_ipcctl(optype, arglast);
2209         if (anum == -1)
2210             goto say_undef;
2211         if (anum != 0) {
2212             value = (double)anum;
2213             goto donumset;
2214         }
2215         str_set(str,"0 but true");
2216         STABSET(str);
2217         break;
2218     case O_MSGSND:
2219         value = (double)(do_msgsnd(arglast) >= 0);
2220         goto donumset;
2221     case O_MSGRCV:
2222         value = (double)(do_msgrcv(arglast) >= 0);
2223         goto donumset;
2224     case O_SEMOP:
2225         value = (double)(do_semop(arglast) >= 0);
2226         goto donumset;
2227     case O_SHMREAD:
2228     case O_SHMWRITE:
2229         value = (double)(do_shmio(optype, arglast) >= 0);
2230         goto donumset;
2231 #else /* not SYSVIPC */
2232     case O_MSGGET:
2233     case O_MSGCTL:
2234     case O_MSGSND:
2235     case O_MSGRCV:
2236     case O_SEMGET:
2237     case O_SEMCTL:
2238     case O_SEMOP:
2239     case O_SHMGET:
2240     case O_SHMCTL:
2241     case O_SHMREAD:
2242     case O_SHMWRITE:
2243         fatal("System V IPC is not implemented on this machine");
2244 #endif /* not SYSVIPC */
2245     case O_RENAME:
2246         tmps = str_get(st[1]);
2247         tmps2 = str_get(st[2]);
2248 #ifdef TAINT
2249         TAINT_PROPER("rename");
2250 #endif
2251 #ifdef HAS_RENAME
2252         value = (double)(rename(tmps,tmps2) >= 0);
2253 #else
2254         if (same_dirent(tmps2, tmps))   /* can always rename to same name */
2255             anum = 1;
2256         else {
2257             if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
2258                 (void)UNLINK(tmps2);
2259             if (!(anum = link(tmps,tmps2)))
2260                 anum = UNLINK(tmps);
2261         }
2262         value = (double)(anum >= 0);
2263 #endif
2264         goto donumset;
2265     case O_LINK:
2266 #ifdef HAS_LINK
2267         tmps = str_get(st[1]);
2268         tmps2 = str_get(st[2]);
2269 #ifdef TAINT
2270         TAINT_PROPER("link");
2271 #endif
2272         value = (double)(link(tmps,tmps2) >= 0);
2273         goto donumset;
2274 #else
2275         fatal("Unsupported function link");
2276         break;
2277 #endif
2278     case O_MKDIR:
2279         tmps = str_get(st[1]);
2280         anum = (int)str_gnum(st[2]);
2281 #ifdef TAINT
2282         TAINT_PROPER("mkdir");
2283 #endif
2284 #ifdef HAS_MKDIR
2285         value = (double)(mkdir(tmps,anum) >= 0);
2286         goto donumset;
2287 #else
2288         (void)strcpy(buf,"mkdir ");
2289 #endif
2290 #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
2291       one_liner:
2292         for (tmps2 = buf+6; *tmps; ) {
2293             *tmps2++ = '\\';
2294             *tmps2++ = *tmps++;
2295         }
2296         (void)strcpy(tmps2," 2>&1");
2297         rsfp = mypopen(buf,"r");
2298         if (rsfp) {
2299             *buf = '\0';
2300             tmps2 = fgets(buf,sizeof buf,rsfp);
2301             (void)mypclose(rsfp);
2302             if (tmps2 != Nullch) {
2303                 for (errno = 1; errno < sys_nerr; errno++) {
2304                     if (instr(buf,sys_errlist[errno]))  /* you don't see this */
2305                         goto say_zero;
2306                 }
2307                 errno = 0;
2308 #ifndef EACCES
2309 #define EACCES EPERM
2310 #endif
2311                 if (instr(buf,"cannot make"))
2312                     errno = EEXIST;
2313                 else if (instr(buf,"existing file"))
2314                     errno = EEXIST;
2315                 else if (instr(buf,"ile exists"))
2316                     errno = EEXIST;
2317                 else if (instr(buf,"non-exist"))
2318                     errno = ENOENT;
2319                 else if (instr(buf,"does not exist"))
2320                     errno = ENOENT;
2321                 else if (instr(buf,"not empty"))
2322                     errno = EBUSY;
2323                 else if (instr(buf,"cannot access"))
2324                     errno = EACCES;
2325                 else
2326                     errno = EPERM;
2327                 goto say_zero;
2328             }
2329             else {      /* some mkdirs return no failure indication */
2330                 tmps = str_get(st[1]);
2331                 anum = (stat(tmps,&statbuf) >= 0);
2332                 if (optype == O_RMDIR)
2333                     anum = !anum;
2334                 if (anum)
2335                     errno = 0;
2336                 else
2337                     errno = EACCES;     /* a guess */
2338                 value = (double)anum;
2339             }
2340             goto donumset;
2341         }
2342         else
2343             goto say_zero;
2344 #endif
2345     case O_RMDIR:
2346         if (maxarg < 1)
2347             tmps = str_get(stab_val(defstab));
2348         else
2349             tmps = str_get(st[1]);
2350 #ifdef TAINT
2351         TAINT_PROPER("rmdir");
2352 #endif
2353 #ifdef HAS_RMDIR
2354         value = (double)(rmdir(tmps) >= 0);
2355         goto donumset;
2356 #else
2357         (void)strcpy(buf,"rmdir ");
2358         goto one_liner;         /* see above in HAS_MKDIR */
2359 #endif
2360     case O_GETPPID:
2361 #ifdef HAS_GETPPID
2362         value = (double)getppid();
2363         goto donumset;
2364 #else
2365         fatal("Unsupported function getppid");
2366         break;
2367 #endif
2368     case O_GETPGRP:
2369 #ifdef HAS_GETPGRP
2370         if (maxarg < 1)
2371             anum = 0;
2372         else
2373             anum = (int)str_gnum(st[1]);
2374 #ifdef _POSIX_SOURCE
2375         if (anum != 0)
2376             fatal("POSIX getpgrp can't take an argument");
2377         value = (double)getpgrp();
2378 #else
2379         value = (double)getpgrp(anum);
2380 #endif
2381         goto donumset;
2382 #else
2383         fatal("The getpgrp() function is unimplemented on this machine");
2384         break;
2385 #endif
2386     case O_SETPGRP:
2387 #ifdef HAS_SETPGRP
2388         argtype = (int)str_gnum(st[1]);
2389         anum = (int)str_gnum(st[2]);
2390 #ifdef TAINT
2391         TAINT_PROPER("setpgrp");
2392 #endif
2393         value = (double)(setpgrp(argtype,anum) >= 0);
2394         goto donumset;
2395 #else
2396         fatal("The setpgrp() function is unimplemented on this machine");
2397         break;
2398 #endif
2399     case O_GETPRIORITY:
2400 #ifdef HAS_GETPRIORITY
2401         argtype = (int)str_gnum(st[1]);
2402         anum = (int)str_gnum(st[2]);
2403         value = (double)getpriority(argtype,anum);
2404         goto donumset;
2405 #else
2406         fatal("The getpriority() function is unimplemented on this machine");
2407         break;
2408 #endif
2409     case O_SETPRIORITY:
2410 #ifdef HAS_SETPRIORITY
2411         argtype = (int)str_gnum(st[1]);
2412         anum = (int)str_gnum(st[2]);
2413         optype = (int)str_gnum(st[3]);
2414 #ifdef TAINT
2415         TAINT_PROPER("setpriority");
2416 #endif
2417         value = (double)(setpriority(argtype,anum,optype) >= 0);
2418         goto donumset;
2419 #else
2420         fatal("The setpriority() function is unimplemented on this machine");
2421         break;
2422 #endif
2423     case O_CHROOT:
2424 #ifdef HAS_CHROOT
2425         if (maxarg < 1)
2426             tmps = str_get(stab_val(defstab));
2427         else
2428             tmps = str_get(st[1]);
2429 #ifdef TAINT
2430         TAINT_PROPER("chroot");
2431 #endif
2432         value = (double)(chroot(tmps) >= 0);
2433         goto donumset;
2434 #else
2435         fatal("Unsupported function chroot");
2436         break;
2437 #endif
2438     case O_FCNTL:
2439     case O_IOCTL:
2440         if (maxarg <= 0)
2441             stab = last_in_stab;
2442         else if ((arg[1].arg_type & A_MASK) == A_WORD)
2443             stab = arg[1].arg_ptr.arg_stab;
2444         else
2445             stab = stabent(str_get(st[1]),TRUE);
2446         argtype = U_I(str_gnum(st[2]));
2447 #ifdef TAINT
2448         TAINT_PROPER("ioctl");
2449 #endif
2450         anum = do_ctl(optype,stab,argtype,st[3]);
2451         if (anum == -1)
2452             goto say_undef;
2453         if (anum != 0) {
2454             value = (double)anum;
2455             goto donumset;
2456         }
2457         str_set(str,"0 but true");
2458         STABSET(str);
2459         break;
2460     case O_FLOCK:
2461 #ifdef HAS_FLOCK
2462         if (maxarg <= 0)
2463             stab = last_in_stab;
2464         else if ((arg[1].arg_type & A_MASK) == A_WORD)
2465             stab = arg[1].arg_ptr.arg_stab;
2466         else
2467             stab = stabent(str_get(st[1]),TRUE);
2468         if (stab && stab_io(stab))
2469             fp = stab_io(stab)->ifp;
2470         else
2471             fp = Nullfp;
2472         if (fp) {
2473             argtype = (int)str_gnum(st[2]);
2474             value = (double)(flock(fileno(fp),argtype) >= 0);
2475         }
2476         else
2477             value = 0;
2478         goto donumset;
2479 #else
2480         fatal("The flock() function is unimplemented on this machine");
2481         break;
2482 #endif
2483     case O_UNSHIFT:
2484         ary = stab_array(arg[1].arg_ptr.arg_stab);
2485         if (arglast[2] - arglast[1] != 1)
2486             do_unshift(ary,arglast);
2487         else {
2488             STR *tmpstr = Str_new(52,0);        /* must copy the STR */
2489             str_sset(tmpstr,st[2]);
2490             aunshift(ary,1);
2491             (void)astore(ary,0,tmpstr);
2492         }
2493         value = (double)(ary->ary_fill + 1);
2494         goto donumset;
2495
2496     case O_TRY:
2497         sp = do_try(arg[1].arg_ptr.arg_cmd,
2498             gimme,arglast);
2499         goto array_return;
2500
2501     case O_EVALONCE:
2502         sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE,
2503             gimme,arglast);
2504         if (eval_root) {
2505             str_free(arg[1].arg_ptr.arg_str);
2506             arg[1].arg_ptr.arg_cmd = eval_root;
2507             arg[1].arg_type = (A_CMD|A_DONT);
2508             arg[0].arg_type = O_TRY;
2509         }
2510         goto array_return;
2511
2512     case O_REQUIRE:
2513     case O_DOFILE:
2514     case O_EVAL:
2515         if (maxarg < 1)
2516             tmpstr = stab_val(defstab);
2517         else
2518             tmpstr =
2519               (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
2520 #ifdef TAINT
2521         tainted |= tmpstr->str_tainted;
2522         TAINT_PROPER("eval");
2523 #endif
2524         sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE,
2525             gimme,arglast);
2526         goto array_return;
2527
2528     case O_FTRREAD:
2529         argtype = 0;
2530         anum = S_IRUSR;
2531         goto check_perm;
2532     case O_FTRWRITE:
2533         argtype = 0;
2534         anum = S_IWUSR;
2535         goto check_perm;
2536     case O_FTREXEC:
2537         argtype = 0;
2538         anum = S_IXUSR;
2539         goto check_perm;
2540     case O_FTEREAD:
2541         argtype = 1;
2542         anum = S_IRUSR;
2543         goto check_perm;
2544     case O_FTEWRITE:
2545         argtype = 1;
2546         anum = S_IWUSR;
2547         goto check_perm;
2548     case O_FTEEXEC:
2549         argtype = 1;
2550         anum = S_IXUSR;
2551       check_perm:
2552         if (mystat(arg,st[1]) < 0)
2553             goto say_undef;
2554         if (cando(anum,argtype,&statcache))
2555             goto say_yes;
2556         goto say_no;
2557
2558     case O_FTIS:
2559         if (mystat(arg,st[1]) < 0)
2560             goto say_undef;
2561         goto say_yes;
2562     case O_FTEOWNED:
2563     case O_FTROWNED:
2564         if (mystat(arg,st[1]) < 0)
2565             goto say_undef;
2566         if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
2567             goto say_yes;
2568         goto say_no;
2569     case O_FTZERO:
2570         if (mystat(arg,st[1]) < 0)
2571             goto say_undef;
2572         if (!statcache.st_size)
2573             goto say_yes;
2574         goto say_no;
2575     case O_FTSIZE:
2576         if (mystat(arg,st[1]) < 0)
2577             goto say_undef;
2578         value = (double)statcache.st_size;
2579         goto donumset;
2580
2581     case O_FTMTIME:
2582         if (mystat(arg,st[1]) < 0)
2583             goto say_undef;
2584         value = (double)(basetime - statcache.st_mtime) / 86400.0;
2585         goto donumset;
2586     case O_FTATIME:
2587         if (mystat(arg,st[1]) < 0)
2588             goto say_undef;
2589         value = (double)(basetime - statcache.st_atime) / 86400.0;
2590         goto donumset;
2591     case O_FTCTIME:
2592         if (mystat(arg,st[1]) < 0)
2593             goto say_undef;
2594         value = (double)(basetime - statcache.st_ctime) / 86400.0;
2595         goto donumset;
2596
2597     case O_FTSOCK:
2598         if (mystat(arg,st[1]) < 0)
2599             goto say_undef;
2600         if (S_ISSOCK(statcache.st_mode))
2601             goto say_yes;
2602         goto say_no;
2603     case O_FTCHR:
2604         if (mystat(arg,st[1]) < 0)
2605             goto say_undef;
2606         if (S_ISCHR(statcache.st_mode))
2607             goto say_yes;
2608         goto say_no;
2609     case O_FTBLK:
2610         if (mystat(arg,st[1]) < 0)
2611             goto say_undef;
2612         if (S_ISBLK(statcache.st_mode))
2613             goto say_yes;
2614         goto say_no;
2615     case O_FTFILE:
2616         if (mystat(arg,st[1]) < 0)
2617             goto say_undef;
2618         if (S_ISREG(statcache.st_mode))
2619             goto say_yes;
2620         goto say_no;
2621     case O_FTDIR:
2622         if (mystat(arg,st[1]) < 0)
2623             goto say_undef;
2624         if (S_ISDIR(statcache.st_mode))
2625             goto say_yes;
2626         goto say_no;
2627     case O_FTPIPE:
2628         if (mystat(arg,st[1]) < 0)
2629             goto say_undef;
2630         if (S_ISFIFO(statcache.st_mode))
2631             goto say_yes;
2632         goto say_no;
2633     case O_FTLINK:
2634         if (mylstat(arg,st[1]) < 0)
2635             goto say_undef;
2636         if (S_ISLNK(statcache.st_mode))
2637             goto say_yes;
2638         goto say_no;
2639     case O_SYMLINK:
2640 #ifdef HAS_SYMLINK
2641         tmps = str_get(st[1]);
2642         tmps2 = str_get(st[2]);
2643 #ifdef TAINT
2644         TAINT_PROPER("symlink");
2645 #endif
2646         value = (double)(symlink(tmps,tmps2) >= 0);
2647         goto donumset;
2648 #else
2649         fatal("Unsupported function symlink");
2650 #endif
2651     case O_READLINK:
2652 #ifdef HAS_SYMLINK
2653         if (maxarg < 1)
2654             tmps = str_get(stab_val(defstab));
2655         else
2656             tmps = str_get(st[1]);
2657         anum = readlink(tmps,buf,sizeof buf);
2658         if (anum < 0)
2659             goto say_undef;
2660         str_nset(str,buf,anum);
2661         break;
2662 #else
2663         goto say_undef;         /* just pretend it's a normal file */
2664 #endif
2665     case O_FTSUID:
2666 #ifdef S_ISUID
2667         anum = S_ISUID;
2668         goto check_xid;
2669 #else
2670         goto say_no;
2671 #endif
2672     case O_FTSGID:
2673 #ifdef S_ISGID
2674         anum = S_ISGID;
2675         goto check_xid;
2676 #else
2677         goto say_no;
2678 #endif
2679     case O_FTSVTX:
2680 #ifdef S_ISVTX
2681         anum = S_ISVTX;
2682 #else
2683         goto say_no;
2684 #endif
2685       check_xid:
2686         if (mystat(arg,st[1]) < 0)
2687             goto say_undef;
2688         if (statcache.st_mode & anum)
2689             goto say_yes;
2690         goto say_no;
2691     case O_FTTTY:
2692         if (arg[1].arg_type & A_DONT) {
2693             stab = arg[1].arg_ptr.arg_stab;
2694             tmps = "";
2695         }
2696         else
2697             stab = stabent(tmps = str_get(st[1]),FALSE);
2698         if (stab && stab_io(stab) && stab_io(stab)->ifp)
2699             anum = fileno(stab_io(stab)->ifp);
2700         else if (isDIGIT(*tmps))
2701             anum = atoi(tmps);
2702         else
2703             goto say_undef;
2704         if (isatty(anum))
2705             goto say_yes;
2706         goto say_no;
2707     case O_FTTEXT:
2708     case O_FTBINARY:
2709         str = do_fttext(arg,st[1]);
2710         break;
2711 #ifdef HAS_SOCKET
2712     case O_SOCKET:
2713         if ((arg[1].arg_type & A_MASK) == A_WORD)
2714             stab = arg[1].arg_ptr.arg_stab;
2715         else
2716             stab = stabent(str_get(st[1]),TRUE);
2717 #ifndef lint
2718         value = (double)do_socket(stab,arglast);
2719 #else
2720         (void)do_socket(stab,arglast);
2721 #endif
2722         goto donumset;
2723     case O_BIND:
2724         if ((arg[1].arg_type & A_MASK) == A_WORD)
2725             stab = arg[1].arg_ptr.arg_stab;
2726         else
2727             stab = stabent(str_get(st[1]),TRUE);
2728 #ifndef lint
2729         value = (double)do_bind(stab,arglast);
2730 #else
2731         (void)do_bind(stab,arglast);
2732 #endif
2733         goto donumset;
2734     case O_CONNECT:
2735         if ((arg[1].arg_type & A_MASK) == A_WORD)
2736             stab = arg[1].arg_ptr.arg_stab;
2737         else
2738             stab = stabent(str_get(st[1]),TRUE);
2739 #ifndef lint
2740         value = (double)do_connect(stab,arglast);
2741 #else
2742         (void)do_connect(stab,arglast);
2743 #endif
2744         goto donumset;
2745     case O_LISTEN:
2746         if ((arg[1].arg_type & A_MASK) == A_WORD)
2747             stab = arg[1].arg_ptr.arg_stab;
2748         else
2749             stab = stabent(str_get(st[1]),TRUE);
2750 #ifndef lint
2751         value = (double)do_listen(stab,arglast);
2752 #else
2753         (void)do_listen(stab,arglast);
2754 #endif
2755         goto donumset;
2756     case O_ACCEPT:
2757         if ((arg[1].arg_type & A_MASK) == A_WORD)
2758             stab = arg[1].arg_ptr.arg_stab;
2759         else
2760             stab = stabent(str_get(st[1]),TRUE);
2761         if ((arg[2].arg_type & A_MASK) == A_WORD)
2762             stab2 = arg[2].arg_ptr.arg_stab;
2763         else
2764             stab2 = stabent(str_get(st[2]),TRUE);
2765         do_accept(str,stab,stab2);
2766         STABSET(str);
2767         break;
2768     case O_GHBYNAME:
2769         if (maxarg < 1)
2770             goto say_undef;
2771     case O_GHBYADDR:
2772     case O_GHOSTENT:
2773         sp = do_ghent(optype,
2774           gimme,arglast);
2775         goto array_return;
2776     case O_GNBYNAME:
2777         if (maxarg < 1)
2778             goto say_undef;
2779     case O_GNBYADDR:
2780     case O_GNETENT:
2781         sp = do_gnent(optype,
2782           gimme,arglast);
2783         goto array_return;
2784     case O_GPBYNAME:
2785         if (maxarg < 1)
2786             goto say_undef;
2787     case O_GPBYNUMBER:
2788     case O_GPROTOENT:
2789         sp = do_gpent(optype,
2790           gimme,arglast);
2791         goto array_return;
2792     case O_GSBYNAME:
2793         if (maxarg < 1)
2794             goto say_undef;
2795     case O_GSBYPORT:
2796     case O_GSERVENT:
2797         sp = do_gsent(optype,
2798           gimme,arglast);
2799         goto array_return;
2800     case O_SHOSTENT:
2801         value = (double) sethostent((int)str_gnum(st[1]));
2802         goto donumset;
2803     case O_SNETENT:
2804         value = (double) setnetent((int)str_gnum(st[1]));
2805         goto donumset;
2806     case O_SPROTOENT:
2807         value = (double) setprotoent((int)str_gnum(st[1]));
2808         goto donumset;
2809     case O_SSERVENT:
2810         value = (double) setservent((int)str_gnum(st[1]));
2811         goto donumset;
2812     case O_EHOSTENT:
2813         value = (double) endhostent();
2814         goto donumset;
2815     case O_ENETENT:
2816         value = (double) endnetent();
2817         goto donumset;
2818     case O_EPROTOENT:
2819         value = (double) endprotoent();
2820         goto donumset;
2821     case O_ESERVENT:
2822         value = (double) endservent();
2823         goto donumset;
2824     case O_SOCKPAIR:
2825         if ((arg[1].arg_type & A_MASK) == A_WORD)
2826             stab = arg[1].arg_ptr.arg_stab;
2827         else
2828             stab = stabent(str_get(st[1]),TRUE);
2829         if ((arg[2].arg_type & A_MASK) == A_WORD)
2830             stab2 = arg[2].arg_ptr.arg_stab;
2831         else
2832             stab2 = stabent(str_get(st[2]),TRUE);
2833 #ifndef lint
2834         value = (double)do_spair(stab,stab2,arglast);
2835 #else
2836         (void)do_spair(stab,stab2,arglast);
2837 #endif
2838         goto donumset;
2839     case O_SHUTDOWN:
2840         if ((arg[1].arg_type & A_MASK) == A_WORD)
2841             stab = arg[1].arg_ptr.arg_stab;
2842         else
2843             stab = stabent(str_get(st[1]),TRUE);
2844 #ifndef lint
2845         value = (double)do_shutdown(stab,arglast);
2846 #else
2847         (void)do_shutdown(stab,arglast);
2848 #endif
2849         goto donumset;
2850     case O_GSOCKOPT:
2851     case O_SSOCKOPT:
2852         if ((arg[1].arg_type & A_MASK) == A_WORD)
2853             stab = arg[1].arg_ptr.arg_stab;
2854         else
2855             stab = stabent(str_get(st[1]),TRUE);
2856         sp = do_sopt(optype,stab,arglast);
2857         goto array_return;
2858     case O_GETSOCKNAME:
2859     case O_GETPEERNAME:
2860         if ((arg[1].arg_type & A_MASK) == A_WORD)
2861             stab = arg[1].arg_ptr.arg_stab;
2862         else
2863             stab = stabent(str_get(st[1]),TRUE);
2864         if (!stab)
2865             goto say_undef;
2866         sp = do_getsockname(optype,stab,arglast);
2867         goto array_return;
2868
2869 #else /* HAS_SOCKET not defined */
2870     case O_SOCKET:
2871     case O_BIND:
2872     case O_CONNECT:
2873     case O_LISTEN:
2874     case O_ACCEPT:
2875     case O_SOCKPAIR:
2876     case O_GHBYNAME:
2877     case O_GHBYADDR:
2878     case O_GHOSTENT:
2879     case O_GNBYNAME:
2880     case O_GNBYADDR:
2881     case O_GNETENT:
2882     case O_GPBYNAME:
2883     case O_GPBYNUMBER:
2884     case O_GPROTOENT:
2885     case O_GSBYNAME:
2886     case O_GSBYPORT:
2887     case O_GSERVENT:
2888     case O_SHOSTENT:
2889     case O_SNETENT:
2890     case O_SPROTOENT:
2891     case O_SSERVENT:
2892     case O_EHOSTENT:
2893     case O_ENETENT:
2894     case O_EPROTOENT:
2895     case O_ESERVENT:
2896     case O_SHUTDOWN:
2897     case O_GSOCKOPT:
2898     case O_SSOCKOPT:
2899     case O_GETSOCKNAME:
2900     case O_GETPEERNAME:
2901       badsock:
2902         fatal("Unsupported socket function");
2903 #endif /* HAS_SOCKET */
2904     case O_SSELECT:
2905 #ifdef HAS_SELECT
2906         sp = do_select(gimme,arglast);
2907         goto array_return;
2908 #else
2909         fatal("select not implemented");
2910 #endif
2911     case O_FILENO:
2912         if (maxarg < 1)
2913             goto say_undef;
2914         if ((arg[1].arg_type & A_MASK) == A_WORD)
2915             stab = arg[1].arg_ptr.arg_stab;
2916         else
2917             stab = stabent(str_get(st[1]),TRUE);
2918         if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
2919             goto say_undef;
2920         value = fileno(fp);
2921         goto donumset;
2922     case O_BINMODE:
2923         if (maxarg < 1)
2924             goto say_undef;
2925         if ((arg[1].arg_type & A_MASK) == A_WORD)
2926             stab = arg[1].arg_ptr.arg_stab;
2927         else
2928             stab = stabent(str_get(st[1]),TRUE);
2929         if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
2930             goto say_undef;
2931 #ifdef DOSISH
2932 #ifdef atarist
2933         if(fflush(fp))
2934            str_set(str, No);
2935         else
2936         {
2937             fp->_flag |= _IOBIN;
2938             str_set(str, Yes);
2939         }
2940 #else
2941         str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No);
2942 #endif
2943 #else
2944         str_set(str, Yes);
2945 #endif
2946         STABSET(str);
2947         break;
2948     case O_VEC:
2949         sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
2950         goto array_return;
2951     case O_GPWNAM:
2952     case O_GPWUID:
2953     case O_GPWENT:
2954 #ifdef HAS_PASSWD
2955         sp = do_gpwent(optype,
2956           gimme,arglast);
2957         goto array_return;
2958     case O_SPWENT:
2959         value = (double) setpwent();
2960         goto donumset;
2961     case O_EPWENT:
2962         value = (double) endpwent();
2963         goto donumset;
2964 #else
2965     case O_EPWENT:
2966     case O_SPWENT:
2967         fatal("Unsupported password function");
2968         break;
2969 #endif
2970     case O_GGRNAM:
2971     case O_GGRGID:
2972     case O_GGRENT:
2973 #ifdef HAS_GROUP
2974         sp = do_ggrent(optype,
2975           gimme,arglast);
2976         goto array_return;
2977     case O_SGRENT:
2978         value = (double) setgrent();
2979         goto donumset;
2980     case O_EGRENT:
2981         value = (double) endgrent();
2982         goto donumset;
2983 #else
2984     case O_EGRENT:
2985     case O_SGRENT:
2986         fatal("Unsupported group function");
2987         break;
2988 #endif
2989     case O_GETLOGIN:
2990 #ifdef HAS_GETLOGIN
2991         if (!(tmps = getlogin()))
2992             goto say_undef;
2993         str_set(str,tmps);
2994 #else
2995         fatal("Unsupported function getlogin");
2996 #endif
2997         break;
2998     case O_OPEN_DIR:
2999     case O_READDIR:
3000     case O_TELLDIR:
3001     case O_SEEKDIR:
3002     case O_REWINDDIR:
3003     case O_CLOSEDIR:
3004         if (maxarg < 1)
3005             goto say_undef;
3006         if ((arg[1].arg_type & A_MASK) == A_WORD)
3007             stab = arg[1].arg_ptr.arg_stab;
3008         else
3009             stab = stabent(str_get(st[1]),TRUE);
3010         if (!stab)
3011             goto say_undef;
3012         sp = do_dirop(optype,stab,gimme,arglast);
3013         goto array_return;
3014     case O_SYSCALL:
3015         value = (double)do_syscall(arglast);
3016         goto donumset;
3017     case O_PIPE_OP:
3018 #ifdef HAS_PIPE
3019         if ((arg[1].arg_type & A_MASK) == A_WORD)
3020             stab = arg[1].arg_ptr.arg_stab;
3021         else
3022             stab = stabent(str_get(st[1]),TRUE);
3023         if ((arg[2].arg_type & A_MASK) == A_WORD)
3024             stab2 = arg[2].arg_ptr.arg_stab;
3025         else
3026             stab2 = stabent(str_get(st[2]),TRUE);
3027         do_pipe(str,stab,stab2);
3028         STABSET(str);
3029 #else
3030         fatal("Unsupported function pipe");
3031 #endif
3032         break;
3033     }
3034
3035   normal_return:
3036     st[1] = str;
3037 #ifdef DEBUGGING
3038     if (debug) {
3039         dlevel--;
3040         if (debug & 8)
3041             deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
3042     }
3043 #endif
3044     stack_ary = stack->ary_array;
3045     stack_max = stack_ary + stack->ary_max;
3046     stack_sp = stack_ary + arglast[0] + 1;
3047     return arglast[0] + 1;
3048 }