eval.c

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