eval.c

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