eval.c

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