eval.c

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