eval.c

   1 /* $Header: eval.c,v 3.0.1.4 90/02/28 17:36:59 lwall Locked $
   2  *
   3  *    Copyright (c) 1989, Larry Wall
   4  *
   5  *    You may distribute under the terms of the GNU General Public License
   6  *    as specified in the README file that comes with the perl 3.0 kit.
   7  *
   8  * $Log:        eval.c,v $
   9  * Revision 3.0.1.4  90/02/28  17:36:59  lwall
  10  * patch9: added pipe function
  11  * patch9: a return in scalar context wouldn't return array
  12  * patch9: !~ now always returns scalar even in array context
  13  * patch9: some machines can't cast float to long with high bit set
  14  * patch9: piped opens returned undef in child
  15  * patch9: @array in scalar context now returns length of array
  16  * patch9: chdir; coredumped
  17  * patch9: wait no longer ignores signals
  18  * patch9: mkdir now handles odd versions of /bin/mkdir
  19  * patch9: -l FILEHANDLE now disallowed
  20  *
  21  * Revision 3.0.1.3  89/12/21  20:03:05  lwall
  22  * patch7: errno may now be a macro with an lvalue
  23  * patch7: ANSI strerror() is now supported
  24  * patch7: send() didn't allow a TO argument
  25  * patch7: ord() now always returns positive even on signed char machines
  26  *
  27  * Revision 3.0.1.2  89/11/17  15:19:34  lwall
  28  * patch5: constant numeric subscripts get lost inside ?:
  29  *
  30  * Revision 3.0.1.1  89/11/11  04:31:51  lwall
  31  * patch2: mkdir and rmdir needed to quote argument when passed to shell
  32  * patch2: mkdir and rmdir now return better error codes
  33  * patch2: fileno, seekdir, rewinddir and closedir now disallow defaults
  34  *
  35  * Revision 3.0  89/10/18  15:17:04  lwall
  36  * 3.0 baseline
  37  *
  38  */
  39
  40 #include "EXTERN.h"
  41 #include "perl.h"
  42
  43 #include <signal.h>
  44
  45 #ifdef I_VFORK
  46 #   include <vfork.h>
  47 #endif
  48
  49 #ifdef VOIDSIG
  50 static void (*ihand)();
  51 static void (*qhand)();
  52 #else
  53 static int (*ihand)();
  54 static int (*qhand)();
  55 #endif
  56
  57 ARG *debarg;
  58 STR str_args;
  59 static STAB *stab2;
  60 static STIO *stio;
  61 static struct lstring *lstr;
  62 static char old_record_separator;
  63 extern int wantarray;
  64
  65 double sin(), cos(), atan2(), pow();
  66
  67 char *getlogin();
  68
  69 int
  70 eval(arg,gimme,sp)
  71 register ARG *arg;
  72 int gimme;
  73 register int sp;
  74 {
  75     register STR *str;
  76     register int anum;
  77     register int optype;
  78     register STR **st;
  79     int maxarg;
  80     double value;
  81     register char *tmps;
  82     char *tmps2;
  83     int argflags;
  84     int argtype;
  85     union argptr argptr;
  86     int arglast[8];     /* highest sp for arg--valid only for non-O_LIST args */
  87     unsigned long tmplong;
  88     long when;
  89     FILE *fp;
  90     STR *tmpstr;
  91     FCMD *form;
  92     STAB *stab;
  93     ARRAY *ary;
  94     bool assigning = FALSE;
  95     double exp(), log(), sqrt(), modf();
  96     char *crypt(), *getenv();
  97     extern void grow_dlevel();
  98
  99     if (!arg)
 100         goto say_undef;
 101     optype = arg->arg_type;
 102     maxarg = arg->arg_len;
 103     arglast[0] = sp;
 104     str = arg->arg_ptr.arg_str;
 105     if (sp + maxarg > stack->ary_max)
 106         astore(stack, sp + maxarg, Nullstr);
 107     st = stack->ary_array;
 108
 109 #ifdef DEBUGGING
 110     if (debug) {
 111         if (debug & 8) {
 112             deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
 113         }
 114         debname[dlevel] = opname[optype][0];
 115         debdelim[dlevel] = ':';
 116         if (++dlevel >= dlmax)
 117             grow_dlevel();
 118     }
 119 #endif
 120
 121 #include "evalargs.xc"
 122
 123     st += arglast[0];
 124     switch (optype) {
 125     case O_RCAT:
 126         STABSET(str);
 127         break;
 128     case O_ITEM:
 129         if (gimme == G_ARRAY)
 130             goto array_return;
 131         STR_SSET(str,st[1]);
 132         STABSET(str);
 133         break;
 134     case O_ITEM2:
 135         if (gimme == G_ARRAY)
 136             goto array_return;
 137         --anum;
 138         STR_SSET(str,st[arglast[anum]-arglast[0]]);
 139         STABSET(str);
 140         break;
 141     case O_ITEM3:
 142         if (gimme == G_ARRAY)
 143         goto array_return;
 144         --anum;
 145         STR_SSET(str,st[arglast[anum]-arglast[0]]);
 146         STABSET(str);
 147         break;
 148     case O_CONCAT:
 149         STR_SSET(str,st[1]);
 150         str_scat(str,st[2]);
 151         STABSET(str);
 152         break;
 153     case O_REPEAT:
 154         STR_SSET(str,st[1]);
 155         anum = (int)str_gnum(st[2]);
 156         if (anum >= 1) {
 157             tmpstr = Str_new(50, 0);
 158             str_sset(tmpstr,str);
 159             tmps = str_get(tmpstr);     /* force to be string */
 160             STR_GROW(str, (anum * str->str_cur) + 1);
 161             repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
 162             str->str_cur *= anum; str->str_ptr[str->str_cur] = '\0';
 163         }
 164         else
 165             str_sset(str,&str_no);
 166         STABSET(str);
 167         break;
 168     case O_MATCH:
 169         sp = do_match(str,arg,
 170           gimme,arglast);
 171         if (gimme == G_ARRAY)
 172             goto array_return;
 173         STABSET(str);
 174         break;
 175     case O_NMATCH:
 176         sp = do_match(str,arg,
 177           G_SCALAR,arglast);
 178         str_sset(str, str_true(str) ? &str_no : &str_yes);
 179         STABSET(str);
 180         break;
 181     case O_SUBST:
 182         sp = do_subst(str,arg,arglast[0]);
 183         goto array_return;
 184     case O_NSUBST:
 185         sp = do_subst(str,arg,arglast[0]);
 186         str = arg->arg_ptr.arg_str;
 187         str_set(str, str_true(str) ? No : Yes);
 188         goto array_return;
 189     case O_ASSIGN:
 190         if (arg[1].arg_flags & AF_ARYOK) {
 191             if (arg->arg_len == 1) {
 192                 arg->arg_type = O_LOCAL;
 193                 goto local;
 194             }
 195             else {
 196                 arg->arg_type = O_AASSIGN;
 197                 goto aassign;
 198             }
 199         }
 200         else {
 201             arg->arg_type = O_SASSIGN;
 202             goto sassign;
 203         }
 204     case O_LOCAL:
 205       local:
 206         arglast[2] = arglast[1];        /* push a null array */
 207         /* FALL THROUGH */
 208     case O_AASSIGN:
 209       aassign:
 210         sp = do_assign(arg,
 211           gimme,arglast);
 212         goto array_return;
 213     case O_SASSIGN:
 214       sassign:
 215         STR_SSET(str, st[2]);
 216         STABSET(str);
 217         break;
 218     case O_CHOP:
 219         st -= arglast[0];
 220         str = arg->arg_ptr.arg_str;
 221         for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
 222             do_chop(str,st[sp]);
 223         st += arglast[0];
 224         break;
 225     case O_DEFINED:
 226         if (arg[1].arg_type & A_DONT) {
 227             sp = do_defined(str,arg,
 228                   gimme,arglast);
 229             goto array_return;
 230         }
 231         else if (str->str_pok || str->str_nok)
 232             goto say_yes;
 233         goto say_no;
 234     case O_UNDEF:
 235         if (arg[1].arg_type & A_DONT) {
 236             sp = do_undef(str,arg,
 237               gimme,arglast);
 238             goto array_return;
 239         }
 240         else if (str != stab_val(defstab)) {
 241             str->str_pok = str->str_nok = 0;
 242             STABSET(str);
 243         }
 244         goto say_undef;
 245     case O_STUDY:
 246         sp = do_study(str,arg,
 247           gimme,arglast);
 248         goto array_return;
 249     case O_POW:
 250         value = str_gnum(st[1]);
 251         value = pow(value,str_gnum(st[2]));
 252         goto donumset;
 253     case O_MULTIPLY:
 254         value = str_gnum(st[1]);
 255         value *= str_gnum(st[2]);
 256         goto donumset;
 257     case O_DIVIDE:
 258         if ((value = str_gnum(st[2])) == 0.0)
 259             fatal("Illegal division by zero");
 260         value = str_gnum(st[1]) / value;
 261         goto donumset;
 262     case O_MODULO:
 263         tmplong = (long) str_gnum(st[2]);
 264         if (tmplong == 0L)
 265             fatal("Illegal modulus zero");
 266         when = (long)str_gnum(st[1]);
 267 #ifndef lint
 268         if (when >= 0)
 269             value = (double)(when % tmplong);
 270         else
 271             value = (double)(tmplong - (-when % tmplong));
 272 #endif
 273         goto donumset;
 274     case O_ADD:
 275         value = str_gnum(st[1]);
 276         value += str_gnum(st[2]);
 277         goto donumset;
 278     case O_SUBTRACT:
 279         value = str_gnum(st[1]);
 280         value -= str_gnum(st[2]);
 281         goto donumset;
 282     case O_LEFT_SHIFT:
 283         value = str_gnum(st[1]);
 284         anum = (int)str_gnum(st[2]);
 285 #ifndef lint
 286         value = (double)(((unsigned long)value) << anum);
 287 #endif
 288         goto donumset;
 289     case O_RIGHT_SHIFT:
 290         value = str_gnum(st[1]);
 291         anum = (int)str_gnum(st[2]);
 292 #ifndef lint
 293         value = (double)(((unsigned long)value) >> anum);
 294 #endif
 295         goto donumset;
 296     case O_LT:
 297         value = str_gnum(st[1]);
 298         value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
 299         goto donumset;
 300     case O_GT:
 301         value = str_gnum(st[1]);
 302         value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
 303         goto donumset;
 304     case O_LE:
 305         value = str_gnum(st[1]);
 306         value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
 307         goto donumset;
 308     case O_GE:
 309         value = str_gnum(st[1]);
 310         value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
 311         goto donumset;
 312     case O_EQ:
 313         if (dowarn) {
 314             if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
 315                 (!st[2]->str_nok && !looks_like_number(st[2])) )
 316                 warn("Possible use of == on string value");
 317         }
 318         value = str_gnum(st[1]);
 319         value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
 320         goto donumset;
 321     case O_NE:
 322         value = str_gnum(st[1]);
 323         value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
 324         goto donumset;
 325     case O_BIT_AND:
 326         if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
 327             value = str_gnum(st[1]);
 328 #ifndef lint
 329             value = (double)(((unsigned long)value) &
 330                         (unsigned long)str_gnum(st[2]));
 331 #endif
 332             goto donumset;
 333         }
 334         else
 335             do_vop(optype,str,st[1],st[2]);
 336         break;
 337     case O_XOR:
 338         if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
 339             value = str_gnum(st[1]);
 340 #ifndef lint
 341             value = (double)(((unsigned long)value) ^
 342                         (unsigned long)str_gnum(st[2]));
 343 #endif
 344             goto donumset;
 345         }
 346         else
 347             do_vop(optype,str,st[1],st[2]);
 348         break;
 349     case O_BIT_OR:
 350         if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
 351             value = str_gnum(st[1]);
 352 #ifndef lint
 353             value = (double)(((unsigned long)value) |
 354                         (unsigned long)str_gnum(st[2]));
 355 #endif
 356             goto donumset;
 357         }
 358         else
 359             do_vop(optype,str,st[1],st[2]);
 360         break;
 361 /* use register in evaluating str_true() */
 362     case O_AND:
 363         if (str_true(st[1])) {
 364             anum = 2;
 365             optype = O_ITEM2;
 366             argflags = arg[anum].arg_flags;
 367             if (gimme == G_ARRAY)
 368                 argflags |= AF_ARYOK;
 369             argtype = arg[anum].arg_type & A_MASK;
 370             argptr = arg[anum].arg_ptr;
 371             maxarg = anum = 1;
 372             sp = arglast[0];
 373             st -= sp;
 374             goto re_eval;
 375         }
 376         else {
 377             if (assigning) {
 378                 str_sset(str, st[1]);
 379                 STABSET(str);
 380             }
 381             else
 382                 str = st[1];
 383             break;
 384         }
 385     case O_OR:
 386         if (str_true(st[1])) {
 387             if (assigning) {
 388                 str_sset(str, st[1]);
 389                 STABSET(str);
 390             }
 391             else
 392                 str = st[1];
 393             break;
 394         }
 395         else {
 396             anum = 2;
 397             optype = O_ITEM2;
 398             argflags = arg[anum].arg_flags;
 399             if (gimme == G_ARRAY)
 400                 argflags |= AF_ARYOK;
 401             argtype = arg[anum].arg_type & A_MASK;
 402             argptr = arg[anum].arg_ptr;
 403             maxarg = anum = 1;
 404             sp = arglast[0];
 405             st -= sp;
 406             goto re_eval;
 407         }
 408     case O_COND_EXPR:
 409         anum = (str_true(st[1]) ? 2 : 3);
 410         optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
 411         argflags = arg[anum].arg_flags;
 412         if (gimme == G_ARRAY)
 413             argflags |= AF_ARYOK;
 414         argtype = arg[anum].arg_type & A_MASK;
 415         argptr = arg[anum].arg_ptr;
 416         maxarg = anum = 1;
 417         sp = arglast[0];
 418         st -= sp;
 419         goto re_eval;
 420     case O_COMMA:
 421         if (gimme == G_ARRAY)
 422             goto array_return;
 423         str = st[2];
 424         break;
 425     case O_NEGATE:
 426         value = -str_gnum(st[1]);
 427         goto donumset;
 428     case O_NOT:
 429         value = (double) !str_true(st[1]);
 430         goto donumset;
 431     case O_COMPLEMENT:
 432 #ifndef lint
 433         value = (double) ~(unsigned long)str_gnum(st[1]);
 434 #endif
 435         goto donumset;
 436     case O_SELECT:
 437         tmps = stab_name(defoutstab);
 438         if (maxarg > 0) {
 439             if ((arg[1].arg_type & A_MASK) == A_WORD)
 440                 defoutstab = arg[1].arg_ptr.arg_stab;
 441             else
 442                 defoutstab = stabent(str_get(st[1]),TRUE);
 443             if (!stab_io(defoutstab))
 444                 stab_io(defoutstab) = stio_new();
 445             curoutstab = defoutstab;
 446         }
 447         str_set(str, tmps);
 448         STABSET(str);
 449         break;
 450     case O_WRITE:
 451         if (maxarg == 0)
 452             stab = defoutstab;
 453         else if ((arg[1].arg_type & A_MASK) == A_WORD) {
 454             if (!(stab = arg[1].arg_ptr.arg_stab))
 455                 stab = defoutstab;
 456         }
 457         else
 458             stab = stabent(str_get(st[1]),TRUE);
 459         if (!stab_io(stab)) {
 460             str_set(str, No);
 461             STABSET(str);
 462             break;
 463         }
 464         curoutstab = stab;
 465         fp = stab_io(stab)->ofp;
 466         debarg = arg;
 467         if (stab_io(stab)->fmt_stab)
 468             form = stab_form(stab_io(stab)->fmt_stab);
 469         else
 470             form = stab_form(stab);
 471         if (!form || !fp) {
 472             if (dowarn) {
 473                 if (form)
 474                     warn("No format for filehandle");
 475                 else {
 476                     if (stab_io(stab)->ifp)
 477                         warn("Filehandle only opened for input");
 478                     else
 479                         warn("Write on closed filehandle");
 480                 }
 481             }
 482             str_set(str, No);
 483             STABSET(str);
 484             break;
 485         }
 486         format(&outrec,form,sp);
 487         do_write(&outrec,stab_io(stab),sp);
 488         if (stab_io(stab)->flags & IOF_FLUSH)
 489             (void)fflush(fp);
 490         str_set(str, Yes);
 491         STABSET(str);
 492         break;
 493     case O_DBMOPEN:
 494 #ifdef SOME_DBM
 495         if ((arg[1].arg_type & A_MASK) == A_WORD)
 496             stab = arg[1].arg_ptr.arg_stab;
 497         else
 498             stab = stabent(str_get(st[1]),TRUE);
 499         anum = (int)str_gnum(st[3]);
 500         value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
 501         goto donumset;
 502 #else
 503         fatal("No dbm or ndbm on this machine");
 504 #endif
 505     case O_DBMCLOSE:
 506 #ifdef SOME_DBM
 507         if ((arg[1].arg_type & A_MASK) == A_WORD)
 508             stab = arg[1].arg_ptr.arg_stab;
 509         else
 510             stab = stabent(str_get(st[1]),TRUE);
 511         hdbmclose(stab_hash(stab));
 512         goto say_yes;
 513 #else
 514         fatal("No dbm or ndbm on this machine");
 515 #endif
 516     case O_OPEN:
 517         if ((arg[1].arg_type & A_MASK) == A_WORD)
 518             stab = arg[1].arg_ptr.arg_stab;
 519         else
 520             stab = stabent(str_get(st[1]),TRUE);
 521         tmps = str_get(st[2]);
 522         if (do_open(stab,tmps,st[2]->str_cur)) {
 523             value = (double)forkprocess;
 524             stab_io(stab)->lines = 0;
 525             goto donumset;
 526         }
 527         else if (forkprocess == 0)              /* we are a new child */
 528             goto say_zero;
 529         else
 530             goto say_undef;
 531         break;
 532     case O_TRANS:
 533         value = (double) do_trans(str,arg);
 534         str = arg->arg_ptr.arg_str;
 535         goto donumset;
 536     case O_NTRANS:
 537         str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
 538         str = arg->arg_ptr.arg_str;
 539         break;
 540     case O_CLOSE:
 541         if (maxarg == 0)
 542             stab = defoutstab;
 543         else if ((arg[1].arg_type & A_MASK) == A_WORD)
 544             stab = arg[1].arg_ptr.arg_stab;
 545         else
 546             stab = stabent(str_get(st[1]),TRUE);
 547         str_set(str, do_close(stab,TRUE) ? Yes : No );
 548         STABSET(str);
 549         break;
 550     case O_EACH:
 551         sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
 552           gimme,arglast);
 553         goto array_return;
 554     case O_VALUES:
 555     case O_KEYS:
 556         sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
 557           gimme,arglast);
 558         goto array_return;
 559     case O_LARRAY:
 560         str->str_nok = str->str_pok = 0;
 561         str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
 562         str->str_state = SS_ARY;
 563         break;
 564     case O_ARRAY:
 565         ary = stab_array(arg[1].arg_ptr.arg_stab);
 566         maxarg = ary->ary_fill + 1;
 567         if (gimme == G_ARRAY) { /* array wanted */
 568             sp = arglast[0];
 569             st -= sp;
 570             if (maxarg > 0 && sp + maxarg > stack->ary_max) {
 571                 astore(stack,sp + maxarg, Nullstr);
 572                 st = stack->ary_array;
 573             }
 574             Copy(ary->ary_array, &st[sp+1], maxarg, STR*);
 575             sp += maxarg;
 576             goto array_return;
 577         }
 578         else {
 579             value = (double)maxarg;
 580             goto donumset;
 581         }
 582     case O_AELEM:
 583         anum = ((int)str_gnum(st[2])) - arybase;
 584         str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
 585         if (!str)
 586             goto say_undef;
 587         break;
 588     case O_DELETE:
 589         tmpstab = arg[1].arg_ptr.arg_stab;
 590         tmps = str_get(st[2]);
 591         str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
 592         if (tmpstab == envstab)
 593             setenv(tmps,Nullch);
 594         if (!str)
 595             goto say_undef;
 596         break;
 597     case O_LHASH:
 598         str->str_nok = str->str_pok = 0;
 599         str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
 600         str->str_state = SS_HASH;
 601         break;
 602     case O_HASH:
 603         if (gimme == G_ARRAY) { /* array wanted */
 604             sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
 605                 gimme,arglast);
 606             goto array_return;
 607         }
 608         else {
 609             tmpstab = arg[1].arg_ptr.arg_stab;
 610             sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
 611                 stab_hash(tmpstab)->tbl_max+1);
 612             str_set(str,buf);
 613         }
 614         break;
 615     case O_HELEM:
 616         tmpstab = arg[1].arg_ptr.arg_stab;
 617         tmps = str_get(st[2]);
 618         str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
 619         if (!str)
 620             goto say_undef;
 621         break;
 622     case O_LAELEM:
 623         anum = ((int)str_gnum(st[2])) - arybase;
 624         str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
 625         if (!str)
 626             fatal("Assignment to non-creatable value, subscript %d",anum);
 627         break;
 628     case O_LHELEM:
 629         tmpstab = arg[1].arg_ptr.arg_stab;
 630         tmps = str_get(st[2]);
 631         anum = st[2]->str_cur;
 632         str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
 633         if (!str)
 634             fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
 635         if (tmpstab == envstab)         /* heavy wizardry going on here */
 636             str_magic(str, tmpstab, 'E', tmps, anum);   /* str is now magic */
 637                                         /* he threw the brick up into the air */
 638         else if (tmpstab == sigstab)
 639             str_magic(str, tmpstab, 'S', tmps, anum);
 640 #ifdef SOME_DBM
 641         else if (stab_hash(tmpstab)->tbl_dbm)
 642             str_magic(str, tmpstab, 'D', tmps, anum);
 643 #endif
 644         break;
 645     case O_ASLICE:
 646         anum = TRUE;
 647         argtype = FALSE;
 648         goto do_slice_already;
 649     case O_HSLICE:
 650         anum = FALSE;
 651         argtype = FALSE;
 652         goto do_slice_already;
 653     case O_LASLICE:
 654         anum = TRUE;
 655         argtype = TRUE;
 656         goto do_slice_already;
 657     case O_LHSLICE:
 658         anum = FALSE;
 659         argtype = TRUE;
 660       do_slice_already:
 661         sp = do_slice(arg[1].arg_ptr.arg_stab,anum,argtype,
 662             gimme,arglast);
 663         goto array_return;
 664     case O_PUSH:
 665         if (arglast[2] - arglast[1] != 1)
 666             str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
 667         else {
 668             str = Str_new(51,0);                /* must copy the STR */
 669             str_sset(str,st[2]);
 670             (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
 671         }
 672         break;
 673     case O_POP:
 674         str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
 675         goto staticalization;
 676     case O_SHIFT:
 677         str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
 678       staticalization:
 679         if (!str)
 680             goto say_undef;
 681         if (ary->ary_flags & ARF_REAL)
 682             (void)str_2static(str);
 683         break;
 684     case O_UNPACK:
 685         sp = do_unpack(str,gimme,arglast);
 686         goto array_return;
 687     case O_SPLIT:
 688         value = str_gnum(st[3]);
 689         sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
 690           gimme,arglast);
 691         goto array_return;
 692     case O_LENGTH:
 693         if (maxarg < 1)
 694             value = (double)str_len(stab_val(defstab));
 695         else
 696             value = (double)str_len(st[1]);
 697         goto donumset;
 698     case O_SPRINTF:
 699         do_sprintf(str, sp-arglast[0], st+1);
 700         break;
 701     case O_SUBSTR:
 702         anum = ((int)str_gnum(st[2])) - arybase;        /* anum=where to start*/
 703         tmps = str_get(st[1]);          /* force conversion to string */
 704         if (argtype = (str == st[1]))
 705             str = arg->arg_ptr.arg_str;
 706         if (anum < 0)
 707             anum += st[1]->str_cur + arybase;
 708         if (anum < 0 || anum > st[1]->str_cur)
 709             str_nset(str,"",0);
 710         else {
 711             optype = (int)str_gnum(st[3]);
 712             if (optype < 0)
 713                 optype = 0;
 714             tmps += anum;
 715             anum = st[1]->str_cur - anum;       /* anum=how many bytes left*/
 716             if (anum > optype)
 717                 anum = optype;
 718             str_nset(str, tmps, anum);
 719             if (argtype) {                      /* it's an lvalue! */
 720                 lstr = (struct lstring*)str;
 721                 str->str_magic = st[1];
 722                 st[1]->str_rare = 's';
 723                 lstr->lstr_offset = tmps - str_get(st[1]);
 724                 lstr->lstr_len = anum;
 725             }
 726         }
 727         break;
 728     case O_PACK:
 729         (void)do_pack(str,arglast);
 730         break;
 731     case O_GREP:
 732         sp = do_grep(arg,str,gimme,arglast);
 733         goto array_return;
 734     case O_JOIN:
 735         do_join(str,arglast);
 736         break;
 737     case O_SLT:
 738         tmps = str_get(st[1]);
 739         value = (double) (str_cmp(st[1],st[2]) < 0);
 740         goto donumset;
 741     case O_SGT:
 742         tmps = str_get(st[1]);
 743         value = (double) (str_cmp(st[1],st[2]) > 0);
 744         goto donumset;
 745     case O_SLE:
 746         tmps = str_get(st[1]);
 747         value = (double) (str_cmp(st[1],st[2]) <= 0);
 748         goto donumset;
 749     case O_SGE:
 750         tmps = str_get(st[1]);
 751         value = (double) (str_cmp(st[1],st[2]) >= 0);
 752         goto donumset;
 753     case O_SEQ:
 754         tmps = str_get(st[1]);
 755         value = (double) str_eq(st[1],st[2]);
 756         goto donumset;
 757     case O_SNE:
 758         tmps = str_get(st[1]);
 759         value = (double) !str_eq(st[1],st[2]);
 760         goto donumset;
 761     case O_SUBR:
 762         sp = do_subr(arg,gimme,arglast);
 763         st = stack->ary_array + arglast[0];             /* maybe realloced */
 764         goto array_return;
 765     case O_DBSUBR:
 766         sp = do_dbsubr(arg,gimme,arglast);
 767         st = stack->ary_array + arglast[0];             /* maybe realloced */
 768         goto array_return;
 769     case O_SORT:
 770         if ((arg[1].arg_type & A_MASK) == A_WORD)
 771             stab = arg[1].arg_ptr.arg_stab;
 772         else
 773             stab = stabent(str_get(st[1]),TRUE);
 774         if (!stab)
 775             stab = defoutstab;
 776         sp = do_sort(str,stab,
 777           gimme,arglast);
 778         goto array_return;
 779     case O_REVERSE:
 780         sp = do_reverse(str,
 781           gimme,arglast);
 782         goto array_return;
 783     case O_WARN:
 784         if (arglast[2] - arglast[1] != 1) {
 785             do_join(str,arglast);
 786             tmps = str_get(st[1]);
 787         }
 788         else {
 789             str = st[2];
 790             tmps = str_get(st[2]);
 791         }
 792         if (!tmps || !*tmps)
 793             tmps = "Warning: something's wrong";
 794         warn("%s",tmps);
 795         goto say_yes;
 796     case O_DIE:
 797         if (arglast[2] - arglast[1] != 1) {
 798             do_join(str,arglast);
 799             tmps = str_get(st[1]);
 800         }
 801         else {
 802             str = st[2];
 803             tmps = str_get(st[2]);
 804         }
 805         if (!tmps || !*tmps)
 806             exit(1);
 807         fatal("%s",tmps);
 808         goto say_zero;
 809     case O_PRTF:
 810     case O_PRINT:
 811         if ((arg[1].arg_type & A_MASK) == A_WORD)
 812             stab = arg[1].arg_ptr.arg_stab;
 813         else
 814             stab = stabent(str_get(st[1]),TRUE);
 815         if (!stab)
 816             stab = defoutstab;
 817         if (!stab_io(stab)) {
 818             if (dowarn)
 819                 warn("Filehandle never opened");
 820             goto say_zero;
 821         }
 822         if (!(fp = stab_io(stab)->ofp)) {
 823             if (dowarn)  {
 824                 if (stab_io(stab)->ifp)
 825                     warn("Filehandle opened only for input");
 826                 else
 827                     warn("Print on closed filehandle");
 828             }
 829             goto say_zero;
 830         }
 831         else {
 832             if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
 833                 value = (double)do_aprint(arg,fp,arglast);
 834             else {
 835                 value = (double)do_print(st[2],fp);
 836                 if (orslen && optype == O_PRINT)
 837                     if (fwrite(ors, 1, orslen, fp) == 0)
 838                         goto say_zero;
 839             }
 840             if (stab_io(stab)->flags & IOF_FLUSH)
 841                 if (fflush(fp) == EOF)
 842                     goto say_zero;
 843         }
 844         goto donumset;
 845     case O_CHDIR:
 846         if (maxarg < 1)
 847             tmps = Nullch;
 848         else
 849             tmps = str_get(st[1]);
 850         if (!tmps || !*tmps) {
 851             tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
 852             if (tmpstr)
 853                 tmps = str_get(tmpstr);
 854         }
 855         if (!tmps || !*tmps) {
 856             tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
 857             if (tmpstr)
 858                 tmps = str_get(tmpstr);
 859         }
 860 #ifdef TAINT
 861         taintproper("Insecure dependency in chdir");
 862 #endif
 863         value = (double)(chdir(tmps) >= 0);
 864         goto donumset;
 865     case O_EXIT:
 866         if (maxarg < 1)
 867             anum = 0;
 868         else
 869             anum = (int)str_gnum(st[1]);
 870         exit(anum);
 871         goto say_zero;
 872     case O_RESET:
 873         if (maxarg < 1)
 874             tmps = "";
 875         else
 876             tmps = str_get(st[1]);
 877         str_reset(tmps,arg[2].arg_ptr.arg_hash);
 878         value = 1.0;
 879         goto donumset;
 880     case O_LIST:
 881         if (gimme == G_ARRAY)
 882             goto array_return;
 883         if (maxarg > 0)
 884             str = st[sp - arglast[0]];  /* unwanted list, return last item */
 885         else
 886             str = &str_undef;
 887         break;
 888     case O_EOF:
 889         if (maxarg <= 0)
 890             stab = last_in_stab;
 891         else if ((arg[1].arg_type & A_MASK) == A_WORD)
 892             stab = arg[1].arg_ptr.arg_stab;
 893         else
 894             stab = stabent(str_get(st[1]),TRUE);
 895         str_set(str, do_eof(stab) ? Yes : No);
 896         STABSET(str);
 897         break;
 898     case O_GETC:
 899         if (maxarg <= 0)
 900             stab = stdinstab;
 901         else if ((arg[1].arg_type & A_MASK) == A_WORD)
 902             stab = arg[1].arg_ptr.arg_stab;
 903         else
 904             stab = stabent(str_get(st[1]),TRUE);
 905         if (do_eof(stab))       /* make sure we have fp with something */
 906             str_set(str, No);
 907         else {
 908 #ifdef TAINT
 909             tainted = 1;
 910 #endif
 911             str_set(str," ");
 912             *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
 913         }
 914         STABSET(str);
 915         break;
 916     case O_TELL:
 917         if (maxarg <= 0)
 918             stab = last_in_stab;
 919         else if ((arg[1].arg_type & A_MASK) == A_WORD)
 920             stab = arg[1].arg_ptr.arg_stab;
 921         else
 922             stab = stabent(str_get(st[1]),TRUE);
 923 #ifndef lint
 924         value = (double)do_tell(stab);
 925 #else
 926         (void)do_tell(stab);
 927 #endif
 928         goto donumset;
 929     case O_RECV:
 930     case O_READ:
 931         if ((arg[1].arg_type & A_MASK) == A_WORD)
 932             stab = arg[1].arg_ptr.arg_stab;
 933         else
 934             stab = stabent(str_get(st[1]),TRUE);
 935         tmps = str_get(st[2]);
 936         anum = (int)str_gnum(st[3]);
 937         STR_GROW(st[2], anum+1), (tmps = str_get(st[2]));       /* sneaky */
 938         errno = 0;
 939         if (!stab_io(stab) || !stab_io(stab)->ifp)
 940             goto say_zero;
 941 #ifdef SOCKET
 942         else if (optype == O_RECV) {
 943             argtype = sizeof buf;
 944             optype = (int)str_gnum(st[4]);
 945             anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, optype,
 946                 buf, &argtype);
 947             if (anum >= 0) {
 948                 st[2]->str_cur = anum;
 949                 st[2]->str_ptr[anum] = '\0';
 950                 str_nset(str,buf,argtype);
 951             }
 952             else
 953                 str_sset(str,&str_undef);
 954             break;
 955         }
 956         else if (stab_io(stab)->type == 's') {
 957             argtype = sizeof buf;
 958             anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, 0,
 959                 buf, &argtype);
 960         }
 961 #else
 962         else if (optype == O_RECV)
 963             goto badsock;
 964 #endif
 965         else
 966             anum = fread(tmps, 1, anum, stab_io(stab)->ifp);
 967         if (anum < 0)
 968             goto say_undef;
 969         st[2]->str_cur = anum;
 970         st[2]->str_ptr[anum] = '\0';
 971         value = (double)anum;
 972         goto donumset;
 973     case O_SEND:
 974 #ifdef SOCKET
 975         if ((arg[1].arg_type & A_MASK) == A_WORD)
 976             stab = arg[1].arg_ptr.arg_stab;
 977         else
 978             stab = stabent(str_get(st[1]),TRUE);
 979         tmps = str_get(st[2]);
 980         anum = (int)str_gnum(st[3]);
 981         optype = sp - arglast[0];
 982         errno = 0;
 983         if (optype > 4)
 984             warn("Too many args on send");
 985         stio = stab_io(stab);
 986         if (!stio || !stio->ifp) {
 987             anum = -1;
 988             if (dowarn)
 989                 warn("Send on closed socket");
 990         }
 991         else if (optype >= 4) {
 992             tmps2 = str_get(st[4]);
 993             anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
 994               anum, tmps2, st[4]->str_cur);
 995         }
 996         else
 997             anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
 998         if (anum < 0)
 999             goto say_undef;
1000         value = (double)anum;
1001         goto donumset;
1002 #else
1003         goto badsock;
1004 #endif
1005     case O_SEEK:
1006         if ((arg[1].arg_type & A_MASK) == A_WORD)
1007             stab = arg[1].arg_ptr.arg_stab;
1008         else
1009             stab = stabent(str_get(st[1]),TRUE);
1010         value = str_gnum(st[2]);
1011         str_set(str, do_seek(stab,
1012           (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
1013         STABSET(str);
1014         break;
1015     case O_RETURN:
1016         tmps = "_SUB_";         /* just fake up a "last _SUB_" */
1017         optype = O_LAST;
1018         if (wantarray == G_ARRAY) {
1019             lastretstr = Nullstr;
1020             lastspbase = arglast[1];
1021             lastsize = arglast[2] - arglast[1];
1022         }
1023         else
1024             lastretstr = str_static(st[arglast[2] - arglast[0]]);
1025         goto dopop;
1026     case O_REDO:
1027     case O_NEXT:
1028     case O_LAST:
1029         if (maxarg > 0) {
1030             tmps = str_get(arg[1].arg_ptr.arg_str);
1031           dopop:
1032             while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
1033               strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
1034 #ifdef DEBUGGING
1035                 if (debug & 4) {
1036                     deb("(Skipping label #%d %s)\n",loop_ptr,
1037                         loop_stack[loop_ptr].loop_label);
1038                 }
1039 #endif
1040                 loop_ptr--;
1041             }
1042 #ifdef DEBUGGING
1043             if (debug & 4) {
1044                 deb("(Found label #%d %s)\n",loop_ptr,
1045                     loop_stack[loop_ptr].loop_label);
1046             }
1047 #endif
1048         }
1049         if (loop_ptr < 0)
1050             fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
1051         if (!lastretstr && optype == O_LAST && lastsize) {
1052             st -= arglast[0];
1053             st += lastspbase + 1;
1054             optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
1055             if (optype) {
1056                 for (anum = lastsize; anum > 0; anum--,st++)
1057                     st[optype] = str_static(st[0]);
1058             }
1059             longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
1060         }
1061         longjmp(loop_stack[loop_ptr].loop_env, optype);
1062     case O_DUMP:
1063     case O_GOTO:/* shudder */
1064         goto_targ = str_get(arg[1].arg_ptr.arg_str);
1065         if (!*goto_targ)
1066             goto_targ = Nullch;         /* just restart from top */
1067         if (optype == O_DUMP) {
1068             do_undump = 1;
1069             abort();
1070         }
1071         longjmp(top_env, 1);
1072     case O_INDEX:
1073         tmps = str_get(st[1]);
1074 #ifndef lint
1075         if (!(tmps2 = fbminstr((unsigned char*)tmps,
1076           (unsigned char*)tmps + st[1]->str_cur, st[2])))
1077 #else
1078         if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
1079 #endif
1080             value = (double)(-1 + arybase);
1081         else
1082             value = (double)(tmps2 - tmps + arybase);
1083         goto donumset;
1084     case O_RINDEX:
1085         tmps = str_get(st[1]);
1086         tmps2 = str_get(st[2]);
1087 #ifndef lint
1088         if (!(tmps2 = rninstr(tmps,  tmps  + st[1]->str_cur,
1089                               tmps2, tmps2 + st[2]->str_cur)))
1090 #else
1091         if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
1092 #endif
1093             value = (double)(-1 + arybase);
1094         else
1095             value = (double)(tmps2 - tmps + arybase);
1096         goto donumset;
1097     case O_TIME:
1098 #ifndef lint
1099         value = (double) time(Null(long*));
1100 #endif
1101         goto donumset;
1102     case O_TMS:
1103         sp = do_tms(str,gimme,arglast);
1104         goto array_return;
1105     case O_LOCALTIME:
1106         if (maxarg < 1)
1107             (void)time(&when);
1108         else
1109             when = (long)str_gnum(st[1]);
1110         sp = do_time(str,localtime(&when),
1111           gimme,arglast);
1112         goto array_return;
1113     case O_GMTIME:
1114         if (maxarg < 1)
1115             (void)time(&when);
1116         else
1117             when = (long)str_gnum(st[1]);
1118         sp = do_time(str,gmtime(&when),
1119           gimme,arglast);
1120         goto array_return;
1121     case O_LSTAT:
1122     case O_STAT:
1123         sp = do_stat(str,arg,
1124           gimme,arglast);
1125         goto array_return;
1126     case O_CRYPT:
1127 #ifdef CRYPT
1128         tmps = str_get(st[1]);
1129 #ifdef FCRYPT
1130         str_set(str,fcrypt(tmps,str_get(st[2])));
1131 #else
1132         str_set(str,crypt(tmps,str_get(st[2])));
1133 #endif
1134 #else
1135         fatal(
1136           "The crypt() function is unimplemented due to excessive paranoia.");
1137 #endif
1138         break;
1139     case O_ATAN2:
1140         value = str_gnum(st[1]);
1141         value = atan2(value,str_gnum(st[2]));
1142         goto donumset;
1143     case O_SIN:
1144         if (maxarg < 1)
1145             value = str_gnum(stab_val(defstab));
1146         else
1147             value = str_gnum(st[1]);
1148         value = sin(value);
1149         goto donumset;
1150     case O_COS:
1151         if (maxarg < 1)
1152             value = str_gnum(stab_val(defstab));
1153         else
1154             value = str_gnum(st[1]);
1155         value = cos(value);
1156         goto donumset;
1157     case O_RAND:
1158         if (maxarg < 1)
1159             value = 1.0;
1160         else
1161             value = str_gnum(st[1]);
1162         if (value == 0.0)
1163             value = 1.0;
1164 #if RANDBITS == 31
1165         value = rand() * value / 2147483648.0;
1166 #else
1167 #if RANDBITS == 16
1168         value = rand() * value / 65536.0;
1169 #else
1170 #if RANDBITS == 15
1171         value = rand() * value / 32768.0;
1172 #else
1173         value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1174 #endif
1175 #endif
1176 #endif
1177         goto donumset;
1178     case O_SRAND:
1179         if (maxarg < 1) {
1180             (void)time(&when);
1181             anum = when;
1182         }
1183         else
1184             anum = (int)str_gnum(st[1]);
1185         (void)srand(anum);
1186         goto say_yes;
1187     case O_EXP:
1188         if (maxarg < 1)
1189             value = str_gnum(stab_val(defstab));
1190         else
1191             value = str_gnum(st[1]);
1192         value = exp(value);
1193         goto donumset;
1194     case O_LOG:
1195         if (maxarg < 1)
1196             value = str_gnum(stab_val(defstab));
1197         else
1198             value = str_gnum(st[1]);
1199         value = log(value);
1200         goto donumset;
1201     case O_SQRT:
1202         if (maxarg < 1)
1203             value = str_gnum(stab_val(defstab));
1204         else
1205             value = str_gnum(st[1]);
1206         value = sqrt(value);
1207         goto donumset;
1208     case O_INT:
1209         if (maxarg < 1)
1210             value = str_gnum(stab_val(defstab));
1211         else
1212             value = str_gnum(st[1]);
1213         if (value >= 0.0)
1214             (void)modf(value,&value);
1215         else {
1216             (void)modf(-value,&value);
1217             value = -value;
1218         }
1219         goto donumset;
1220     case O_ORD:
1221         if (maxarg < 1)
1222             tmps = str_get(stab_val(defstab));
1223         else
1224             tmps = str_get(st[1]);
1225 #ifndef I286
1226         value = (double) (*tmps & 255);
1227 #else
1228         anum = (int) *tmps;
1229         value = (double) (anum & 255);
1230 #endif
1231         goto donumset;
1232     case O_SLEEP:
1233         if (maxarg < 1)
1234             tmps = Nullch;
1235         else
1236             tmps = str_get(st[1]);
1237         (void)time(&when);
1238         if (!tmps || !*tmps)
1239             sleep((32767<<16)+32767);
1240         else
1241             sleep((unsigned int)atoi(tmps));
1242 #ifndef lint
1243         value = (double)when;
1244         (void)time(&when);
1245         value = ((double)when) - value;
1246 #endif
1247         goto donumset;
1248     case O_RANGE:
1249         sp = do_range(gimme,arglast);
1250         goto array_return;
1251     case O_F_OR_R:
1252         if (gimme == G_ARRAY) {         /* it's a range */
1253             /* can we optimize to constant array? */
1254             if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
1255               (arg[2].arg_type & A_MASK) == A_SINGLE) {
1256                 st[2] = arg[2].arg_ptr.arg_str;
1257                 sp = do_range(gimme,arglast);
1258                 st = stack->ary_array;
1259                 maxarg = sp - arglast[0];
1260                 str_free(arg[1].arg_ptr.arg_str);
1261                 str_free(arg[2].arg_ptr.arg_str);
1262                 arg->arg_type = O_ARRAY;
1263                 arg[1].arg_type = A_STAB|A_DONT;
1264                 arg->arg_len = 1;
1265                 stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
1266                 ary = stab_array(stab);
1267                 afill(ary,maxarg - 1);
1268                 st += arglast[0]+1;
1269                 while (maxarg-- > 0)
1270                     ary->ary_array[maxarg] = str_smake(st[maxarg]);
1271                 goto array_return;
1272             }
1273             arg->arg_type = optype = O_RANGE;
1274             maxarg = arg->arg_len = 2;
1275             anum = 2;
1276             arg[anum].arg_flags &= ~AF_ARYOK;
1277             argflags = arg[anum].arg_flags;
1278             argtype = arg[anum].arg_type & A_MASK;
1279             arg[anum].arg_type = argtype;
1280             argptr = arg[anum].arg_ptr;
1281             sp = arglast[0];
1282             st -= sp;
1283             sp++;
1284             goto re_eval;
1285         }
1286         arg->arg_type = O_FLIP;
1287         /* FALL THROUGH */
1288     case O_FLIP:
1289         if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
1290           last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
1291           :
1292           str_true(st[1]) ) {
1293             str_numset(str,0.0);
1294             anum = 2;
1295             arg->arg_type = optype = O_FLOP;
1296             arg[2].arg_type &= ~A_DONT;
1297             arg[1].arg_type |= A_DONT;
1298             argflags = arg[2].arg_flags;
1299             argtype = arg[2].arg_type & A_MASK;
1300             argptr = arg[2].arg_ptr;
1301             sp = arglast[0];
1302             st -= sp;
1303             goto re_eval;
1304         }
1305         str_set(str,"");
1306         break;
1307     case O_FLOP:
1308         str_inc(str);
1309         if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
1310           last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
1311           :
1312           str_true(st[2]) ) {
1313             arg->arg_type = O_FLIP;
1314             arg[1].arg_type &= ~A_DONT;
1315             arg[2].arg_type |= A_DONT;
1316             str_cat(str,"E0");
1317         }
1318         break;
1319     case O_FORK:
1320         anum = fork();
1321         if (!anum && (tmpstab = stabent("$",allstabs)))
1322             str_numset(STAB_STR(tmpstab),(double)getpid());
1323         value = (double)anum;
1324         goto donumset;
1325     case O_WAIT:
1326 #ifndef lint
1327         /* ihand = signal(SIGINT, SIG_IGN); */
1328         /* qhand = signal(SIGQUIT, SIG_IGN); */
1329         anum = wait(&argflags);
1330         if (anum > 0)
1331             pidgone(anum,argflags);
1332         value = (double)anum;
1333 #else
1334         /* ihand = qhand = 0; */
1335 #endif
1336         /* (void)signal(SIGINT, ihand); */
1337         /* (void)signal(SIGQUIT, qhand); */
1338         statusvalue = (unsigned short)argflags;
1339         goto donumset;
1340     case O_SYSTEM:
1341 #ifdef TAINT
1342         if (arglast[2] - arglast[1] == 1) {
1343             taintenv();
1344             tainted |= st[2]->str_tainted;
1345             taintproper("Insecure dependency in system");
1346         }
1347 #endif
1348         while ((anum = vfork()) == -1) {
1349             if (errno != EAGAIN) {
1350                 value = -1.0;
1351                 goto donumset;
1352             }
1353             sleep(5);
1354         }
1355         if (anum > 0) {
1356 #ifndef lint
1357             ihand = signal(SIGINT, SIG_IGN);
1358             qhand = signal(SIGQUIT, SIG_IGN);
1359             while ((argtype = wait(&argflags)) != anum && argtype >= 0)
1360                 pidgone(argtype,argflags);
1361 #else
1362             ihand = qhand = 0;
1363 #endif
1364             (void)signal(SIGINT, ihand);
1365             (void)signal(SIGQUIT, qhand);
1366             statusvalue = (unsigned short)argflags;
1367             if (argtype == -1)
1368                 value = -1.0;
1369             else {
1370                 value = (double)((unsigned int)argflags & 0xffff);
1371             }
1372             goto donumset;
1373         }
1374         if ((arg[1].arg_type & A_MASK) == A_STAB)
1375             value = (double)do_aexec(st[1],arglast);
1376         else if (arglast[2] - arglast[1] != 1)
1377             value = (double)do_aexec(Nullstr,arglast);
1378         else {
1379             value = (double)do_exec(str_get(str_static(st[2])));
1380         }
1381         _exit(-1);
1382     case O_EXEC:
1383         if ((arg[1].arg_type & A_MASK) == A_STAB)
1384             value = (double)do_aexec(st[1],arglast);
1385         else if (arglast[2] - arglast[1] != 1)
1386             value = (double)do_aexec(Nullstr,arglast);
1387         else {
1388             value = (double)do_exec(str_get(str_static(st[2])));
1389         }
1390         goto donumset;
1391     case O_HEX:
1392         argtype = 4;
1393         goto snarfnum;
1394
1395     case O_OCT:
1396         argtype = 3;
1397
1398       snarfnum:
1399         anum = 0;
1400         if (maxarg < 1)
1401             tmps = str_get(stab_val(defstab));
1402         else
1403             tmps = str_get(st[1]);
1404         for (;;) {
1405             switch (*tmps) {
1406             default:
1407                 goto out;
1408             case '8': case '9':
1409                 if (argtype != 4)
1410                     goto out;
1411                 /* FALL THROUGH */
1412             case '0': case '1': case '2': case '3': case '4':
1413             case '5': case '6': case '7':
1414                 anum <<= argtype;
1415                 anum += *tmps++ & 15;
1416                 break;
1417             case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1418             case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
1419                 if (argtype != 4)
1420                     goto out;
1421                 anum <<= 4;
1422                 anum += (*tmps++ & 7) + 9;
1423                 break;
1424             case 'x':
1425                 argtype = 4;
1426                 tmps++;
1427                 break;
1428             }
1429         }
1430       out:
1431         value = (double)anum;
1432         goto donumset;
1433     case O_CHMOD:
1434     case O_CHOWN:
1435     case O_KILL:
1436     case O_UNLINK:
1437     case O_UTIME:
1438         value = (double)apply(optype,arglast);
1439         goto donumset;
1440     case O_UMASK:
1441         if (maxarg < 1) {
1442             anum = umask(0);
1443             (void)umask(anum);
1444         }
1445         else
1446             anum = umask((int)str_gnum(st[1]));
1447         value = (double)anum;
1448 #ifdef TAINT
1449         taintproper("Insecure dependency in umask");
1450 #endif
1451         goto donumset;
1452     case O_RENAME:
1453         tmps = str_get(st[1]);
1454         tmps2 = str_get(st[2]);
1455 #ifdef TAINT
1456         taintproper("Insecure dependency in rename");
1457 #endif
1458 #ifdef RENAME
1459         value = (double)(rename(tmps,tmps2) >= 0);
1460 #else
1461         if (euid || stat(tmps2,&statbuf) < 0 ||
1462           (statbuf.st_mode & S_IFMT) != S_IFDIR )
1463             (void)UNLINK(tmps2);        /* avoid unlinking a directory */
1464         if (!(anum = link(tmps,tmps2)))
1465             anum = UNLINK(tmps);
1466         value = (double)(anum >= 0);
1467 #endif
1468         goto donumset;
1469     case O_LINK:
1470         tmps = str_get(st[1]);
1471         tmps2 = str_get(st[2]);
1472 #ifdef TAINT
1473         taintproper("Insecure dependency in link");
1474 #endif
1475         value = (double)(link(tmps,tmps2) >= 0);
1476         goto donumset;
1477     case O_MKDIR:
1478         tmps = str_get(st[1]);
1479         anum = (int)str_gnum(st[2]);
1480 #ifdef TAINT
1481         taintproper("Insecure dependency in mkdir");
1482 #endif
1483 #ifdef MKDIR
1484         value = (double)(mkdir(tmps,anum) >= 0);
1485         goto donumset;
1486 #else
1487         (void)strcpy(buf,"mkdir ");
1488 #endif
1489 #if !defined(MKDIR) || !defined(RMDIR)
1490       one_liner:
1491         for (tmps2 = buf+6; *tmps; ) {
1492             *tmps2++ = '\\';
1493             *tmps2++ = *tmps++;
1494         }
1495         (void)strcpy(tmps2," 2>&1");
1496         rsfp = mypopen(buf,"r");
1497         if (rsfp) {
1498             *buf = '\0';
1499             tmps2 = fgets(buf,sizeof buf,rsfp);
1500             (void)mypclose(rsfp);
1501             if (tmps2 != Nullch) {
1502                 for (errno = 1; errno < sys_nerr; errno++) {
1503                     if (instr(buf,sys_errlist[errno]))  /* you don't see this */
1504                         goto say_zero;
1505                 }
1506                 errno = 0;
1507 #ifndef EACCES
1508 #define EACCES EPERM
1509 #endif
1510                 if (instr(buf,"cannot make"))
1511                     errno = EEXIST;
1512                 else if (instr(buf,"non-exist"))
1513                     errno = ENOENT;
1514                 else if (instr(buf,"does not exist"))
1515                     errno = ENOENT;
1516                 else if (instr(buf,"not empty"))
1517                     errno = EBUSY;
1518                 else if (instr(buf,"cannot access"))
1519                     errno = EACCES;
1520                 else
1521                     errno = EPERM;
1522                 goto say_zero;
1523             }
1524             else {      /* some mkdirs return no failure indication */
1525                 tmps = str_get(st[1]);
1526                 anum = (stat(tmps,&statbuf) >= 0);
1527                 if (optype == O_RMDIR)
1528                     anum = !anum;
1529                 if (anum)
1530                     errno = 0;
1531                 else
1532                     errno = EACCES;     /* a guess */
1533                 value = (double)anum;
1534             }
1535             goto donumset;
1536         }
1537         else
1538             goto say_zero;
1539 #endif
1540     case O_RMDIR:
1541         if (maxarg < 1)
1542             tmps = str_get(stab_val(defstab));
1543         else
1544             tmps = str_get(st[1]);
1545 #ifdef TAINT
1546         taintproper("Insecure dependency in rmdir");
1547 #endif
1548 #ifdef RMDIR
1549         value = (double)(rmdir(tmps) >= 0);
1550         goto donumset;
1551 #else
1552         (void)strcpy(buf,"rmdir ");
1553         goto one_liner;         /* see above in MKDIR */
1554 #endif
1555     case O_GETPPID:
1556         value = (double)getppid();
1557         goto donumset;
1558     case O_GETPGRP:
1559 #ifdef GETPGRP
1560         if (maxarg < 1)
1561             anum = 0;
1562         else
1563             anum = (int)str_gnum(st[1]);
1564         value = (double)getpgrp(anum);
1565         goto donumset;
1566 #else
1567         fatal("The getpgrp() function is unimplemented on this machine");
1568         break;
1569 #endif
1570     case O_SETPGRP:
1571 #ifdef SETPGRP
1572         argtype = (int)str_gnum(st[1]);
1573         anum = (int)str_gnum(st[2]);
1574 #ifdef TAINT
1575         taintproper("Insecure dependency in setpgrp");
1576 #endif
1577         value = (double)(setpgrp(argtype,anum) >= 0);
1578         goto donumset;
1579 #else
1580         fatal("The setpgrp() function is unimplemented on this machine");
1581         break;
1582 #endif
1583     case O_GETPRIORITY:
1584 #ifdef GETPRIORITY
1585         argtype = (int)str_gnum(st[1]);
1586         anum = (int)str_gnum(st[2]);
1587         value = (double)getpriority(argtype,anum);
1588         goto donumset;
1589 #else
1590         fatal("The getpriority() function is unimplemented on this machine");
1591         break;
1592 #endif
1593     case O_SETPRIORITY:
1594 #ifdef SETPRIORITY
1595         argtype = (int)str_gnum(st[1]);
1596         anum = (int)str_gnum(st[2]);
1597         optype = (int)str_gnum(st[3]);
1598 #ifdef TAINT
1599         taintproper("Insecure dependency in setpriority");
1600 #endif
1601         value = (double)(setpriority(argtype,anum,optype) >= 0);
1602         goto donumset;
1603 #else
1604         fatal("The setpriority() function is unimplemented on this machine");
1605         break;
1606 #endif
1607     case O_CHROOT:
1608         if (maxarg < 1)
1609             tmps = str_get(stab_val(defstab));
1610         else
1611             tmps = str_get(st[1]);
1612 #ifdef TAINT
1613         taintproper("Insecure dependency in chroot");
1614 #endif
1615         value = (double)(chroot(tmps) >= 0);
1616         goto donumset;
1617     case O_FCNTL:
1618     case O_IOCTL:
1619         if (maxarg <= 0)
1620             stab = last_in_stab;
1621         else if ((arg[1].arg_type & A_MASK) == A_WORD)
1622             stab = arg[1].arg_ptr.arg_stab;
1623         else
1624             stab = stabent(str_get(st[1]),TRUE);
1625         argtype = (unsigned int)str_gnum(st[2]);
1626 #ifdef TAINT
1627         taintproper("Insecure dependency in ioctl");
1628 #endif
1629         anum = do_ctl(optype,stab,argtype,st[3]);
1630         if (anum == -1)
1631             goto say_undef;
1632         if (anum != 0)
1633             goto donumset;
1634         str_set(str,"0 but true");
1635         STABSET(str);
1636         break;
1637     case O_FLOCK:
1638 #ifdef FLOCK
1639         if (maxarg <= 0)
1640             stab = last_in_stab;
1641         else if ((arg[1].arg_type & A_MASK) == A_WORD)
1642             stab = arg[1].arg_ptr.arg_stab;
1643         else
1644             stab = stabent(str_get(st[1]),TRUE);
1645         if (stab && stab_io(stab))
1646             fp = stab_io(stab)->ifp;
1647         else
1648             fp = Nullfp;
1649         if (fp) {
1650             argtype = (int)str_gnum(st[2]);
1651             value = (double)(flock(fileno(fp),argtype) >= 0);
1652         }
1653         else
1654             value = 0;
1655         goto donumset;
1656 #else
1657         fatal("The flock() function is unimplemented on this machine");
1658         break;
1659 #endif
1660     case O_UNSHIFT:
1661         ary = stab_array(arg[1].arg_ptr.arg_stab);
1662         if (arglast[2] - arglast[1] != 1)
1663             do_unshift(ary,arglast);
1664         else {
1665             str = Str_new(52,0);                /* must copy the STR */
1666             str_sset(str,st[2]);
1667             aunshift(ary,1);
1668             (void)astore(ary,0,str);
1669         }
1670         value = (double)(ary->ary_fill + 1);
1671         break;
1672     case O_DOFILE:
1673     case O_EVAL:
1674         if (maxarg < 1)
1675             tmpstr = stab_val(defstab);
1676         else
1677             tmpstr =
1678               (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
1679 #ifdef TAINT
1680         tainted |= tmpstr->str_tainted;
1681         taintproper("Insecure dependency in eval");
1682 #endif
1683         sp = do_eval(tmpstr, optype, arg[2].arg_ptr.arg_hash,
1684             gimme,arglast);
1685         goto array_return;
1686
1687     case O_FTRREAD:
1688         argtype = 0;
1689         anum = S_IREAD;
1690         goto check_perm;
1691     case O_FTRWRITE:
1692         argtype = 0;
1693         anum = S_IWRITE;
1694         goto check_perm;
1695     case O_FTREXEC:
1696         argtype = 0;
1697         anum = S_IEXEC;
1698         goto check_perm;
1699     case O_FTEREAD:
1700         argtype = 1;
1701         anum = S_IREAD;
1702         goto check_perm;
1703     case O_FTEWRITE:
1704         argtype = 1;
1705         anum = S_IWRITE;
1706         goto check_perm;
1707     case O_FTEEXEC:
1708         argtype = 1;
1709         anum = S_IEXEC;
1710       check_perm:
1711         if (mystat(arg,st[1]) < 0)
1712             goto say_undef;
1713         if (cando(anum,argtype,&statcache))
1714             goto say_yes;
1715         goto say_no;
1716
1717     case O_FTIS:
1718         if (mystat(arg,st[1]) < 0)
1719             goto say_undef;
1720         goto say_yes;
1721     case O_FTEOWNED:
1722     case O_FTROWNED:
1723         if (mystat(arg,st[1]) < 0)
1724             goto say_undef;
1725         if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
1726             goto say_yes;
1727         goto say_no;
1728     case O_FTZERO:
1729         if (mystat(arg,st[1]) < 0)
1730             goto say_undef;
1731         if (!statcache.st_size)
1732             goto say_yes;
1733         goto say_no;
1734     case O_FTSIZE:
1735         if (mystat(arg,st[1]) < 0)
1736             goto say_undef;
1737         if (statcache.st_size)
1738             goto say_yes;
1739         goto say_no;
1740
1741     case O_FTSOCK:
1742 #ifdef S_IFSOCK
1743         anum = S_IFSOCK;
1744         goto check_file_type;
1745 #else
1746         goto say_no;
1747 #endif
1748     case O_FTCHR:
1749         anum = S_IFCHR;
1750         goto check_file_type;
1751     case O_FTBLK:
1752         anum = S_IFBLK;
1753         goto check_file_type;
1754     case O_FTFILE:
1755         anum = S_IFREG;
1756         goto check_file_type;
1757     case O_FTDIR:
1758         anum = S_IFDIR;
1759       check_file_type:
1760         if (mystat(arg,st[1]) < 0)
1761             goto say_undef;
1762         if ((statcache.st_mode & S_IFMT) == anum )
1763             goto say_yes;
1764         goto say_no;
1765     case O_FTPIPE:
1766 #ifdef S_IFIFO
1767         anum = S_IFIFO;
1768         goto check_file_type;
1769 #else
1770         goto say_no;
1771 #endif
1772     case O_FTLINK:
1773         if (arg[1].arg_type & A_DONT)
1774             fatal("You must supply explicit filename with -l");
1775 #ifdef LSTAT
1776         if (lstat(str_get(st[1]),&statcache) < 0)
1777             goto say_undef;
1778         if ((statcache.st_mode & S_IFMT) == S_IFLNK )
1779             goto say_yes;
1780 #endif
1781         goto say_no;
1782     case O_SYMLINK:
1783 #ifdef SYMLINK
1784         tmps = str_get(st[1]);
1785         tmps2 = str_get(st[2]);
1786 #ifdef TAINT
1787         taintproper("Insecure dependency in symlink");
1788 #endif
1789         value = (double)(symlink(tmps,tmps2) >= 0);
1790         goto donumset;
1791 #else
1792         fatal("Unsupported function symlink()");
1793 #endif
1794     case O_READLINK:
1795 #ifdef SYMLINK
1796         if (maxarg < 1)
1797             tmps = str_get(stab_val(defstab));
1798         else
1799             tmps = str_get(st[1]);
1800         anum = readlink(tmps,buf,sizeof buf);
1801         if (anum < 0)
1802             goto say_undef;
1803         str_nset(str,buf,anum);
1804         break;
1805 #else
1806         fatal("Unsupported function readlink()");
1807 #endif
1808     case O_FTSUID:
1809         anum = S_ISUID;
1810         goto check_xid;
1811     case O_FTSGID:
1812         anum = S_ISGID;
1813         goto check_xid;
1814     case O_FTSVTX:
1815         anum = S_ISVTX;
1816       check_xid:
1817         if (mystat(arg,st[1]) < 0)
1818             goto say_undef;
1819         if (statcache.st_mode & anum)
1820             goto say_yes;
1821         goto say_no;
1822     case O_FTTTY:
1823         if (arg[1].arg_type & A_DONT) {
1824             stab = arg[1].arg_ptr.arg_stab;
1825             tmps = "";
1826         }
1827         else
1828             stab = stabent(tmps = str_get(st[1]),FALSE);
1829         if (stab && stab_io(stab) && stab_io(stab)->ifp)
1830             anum = fileno(stab_io(stab)->ifp);
1831         else if (isdigit(*tmps))
1832             anum = atoi(tmps);
1833         else
1834             goto say_undef;
1835         if (isatty(anum))
1836             goto say_yes;
1837         goto say_no;
1838     case O_FTTEXT:
1839     case O_FTBINARY:
1840         str = do_fttext(arg,st[1]);
1841         break;
1842 #ifdef SOCKET
1843     case O_SOCKET:
1844         if ((arg[1].arg_type & A_MASK) == A_WORD)
1845             stab = arg[1].arg_ptr.arg_stab;
1846         else
1847             stab = stabent(str_get(st[1]),TRUE);
1848 #ifndef lint
1849         value = (double)do_socket(stab,arglast);
1850 #else
1851         (void)do_socket(stab,arglast);
1852 #endif
1853         goto donumset;
1854     case O_BIND:
1855         if ((arg[1].arg_type & A_MASK) == A_WORD)
1856             stab = arg[1].arg_ptr.arg_stab;
1857         else
1858             stab = stabent(str_get(st[1]),TRUE);
1859 #ifndef lint
1860         value = (double)do_bind(stab,arglast);
1861 #else
1862         (void)do_bind(stab,arglast);
1863 #endif
1864         goto donumset;
1865     case O_CONNECT:
1866         if ((arg[1].arg_type & A_MASK) == A_WORD)
1867             stab = arg[1].arg_ptr.arg_stab;
1868         else
1869             stab = stabent(str_get(st[1]),TRUE);
1870 #ifndef lint
1871         value = (double)do_connect(stab,arglast);
1872 #else
1873         (void)do_connect(stab,arglast);
1874 #endif
1875         goto donumset;
1876     case O_LISTEN:
1877         if ((arg[1].arg_type & A_MASK) == A_WORD)
1878             stab = arg[1].arg_ptr.arg_stab;
1879         else
1880             stab = stabent(str_get(st[1]),TRUE);
1881 #ifndef lint
1882         value = (double)do_listen(stab,arglast);
1883 #else
1884         (void)do_listen(stab,arglast);
1885 #endif
1886         goto donumset;
1887     case O_ACCEPT:
1888         if ((arg[1].arg_type & A_MASK) == A_WORD)
1889             stab = arg[1].arg_ptr.arg_stab;
1890         else
1891             stab = stabent(str_get(st[1]),TRUE);
1892         if ((arg[2].arg_type & A_MASK) == A_WORD)
1893             stab2 = arg[2].arg_ptr.arg_stab;
1894         else
1895             stab2 = stabent(str_get(st[2]),TRUE);
1896         do_accept(str,stab,stab2);
1897         STABSET(str);
1898         break;
1899     case O_GHBYNAME:
1900         if (maxarg < 1)
1901             goto say_undef;
1902     case O_GHBYADDR:
1903     case O_GHOSTENT:
1904         sp = do_ghent(optype,
1905           gimme,arglast);
1906         goto array_return;
1907     case O_GNBYNAME:
1908         if (maxarg < 1)
1909             goto say_undef;
1910     case O_GNBYADDR:
1911     case O_GNETENT:
1912         sp = do_gnent(optype,
1913           gimme,arglast);
1914         goto array_return;
1915     case O_GPBYNAME:
1916         if (maxarg < 1)
1917             goto say_undef;
1918     case O_GPBYNUMBER:
1919     case O_GPROTOENT:
1920         sp = do_gpent(optype,
1921           gimme,arglast);
1922         goto array_return;
1923     case O_GSBYNAME:
1924         if (maxarg < 1)
1925             goto say_undef;
1926     case O_GSBYPORT:
1927     case O_GSERVENT:
1928         sp = do_gsent(optype,
1929           gimme,arglast);
1930         goto array_return;
1931     case O_SHOSTENT:
1932         value = (double) sethostent((int)str_gnum(st[1]));
1933         goto donumset;
1934     case O_SNETENT:
1935         value = (double) setnetent((int)str_gnum(st[1]));
1936         goto donumset;
1937     case O_SPROTOENT:
1938         value = (double) setprotoent((int)str_gnum(st[1]));
1939         goto donumset;
1940     case O_SSERVENT:
1941         value = (double) setservent((int)str_gnum(st[1]));
1942         goto donumset;
1943     case O_EHOSTENT:
1944         value = (double) endhostent();
1945         goto donumset;
1946     case O_ENETENT:
1947         value = (double) endnetent();
1948         goto donumset;
1949     case O_EPROTOENT:
1950         value = (double) endprotoent();
1951         goto donumset;
1952     case O_ESERVENT:
1953         value = (double) endservent();
1954         goto donumset;
1955     case O_SSELECT:
1956         sp = do_select(gimme,arglast);
1957         goto array_return;
1958     case O_SOCKETPAIR:
1959         if ((arg[1].arg_type & A_MASK) == A_WORD)
1960             stab = arg[1].arg_ptr.arg_stab;
1961         else
1962             stab = stabent(str_get(st[1]),TRUE);
1963         if ((arg[2].arg_type & A_MASK) == A_WORD)
1964             stab2 = arg[2].arg_ptr.arg_stab;
1965         else
1966             stab2 = stabent(str_get(st[2]),TRUE);
1967 #ifndef lint
1968         value = (double)do_spair(stab,stab2,arglast);
1969 #else
1970         (void)do_spair(stab,stab2,arglast);
1971 #endif
1972         goto donumset;
1973     case O_SHUTDOWN:
1974         if ((arg[1].arg_type & A_MASK) == A_WORD)
1975             stab = arg[1].arg_ptr.arg_stab;
1976         else
1977             stab = stabent(str_get(st[1]),TRUE);
1978 #ifndef lint
1979         value = (double)do_shutdown(stab,arglast);
1980 #else
1981         (void)do_shutdown(stab,arglast);
1982 #endif
1983         goto donumset;
1984     case O_GSOCKOPT:
1985     case O_SSOCKOPT:
1986         if ((arg[1].arg_type & A_MASK) == A_WORD)
1987             stab = arg[1].arg_ptr.arg_stab;
1988         else
1989             stab = stabent(str_get(st[1]),TRUE);
1990         sp = do_sopt(optype,stab,arglast);
1991         goto array_return;
1992     case O_GETSOCKNAME:
1993     case O_GETPEERNAME:
1994         if ((arg[1].arg_type & A_MASK) == A_WORD)
1995             stab = arg[1].arg_ptr.arg_stab;
1996         else
1997             stab = stabent(str_get(st[1]),TRUE);
1998         sp = do_getsockname(optype,stab,arglast);
1999         goto array_return;
2000
2001 #else /* SOCKET not defined */
2002     case O_SOCKET:
2003     case O_BIND:
2004     case O_CONNECT:
2005     case O_LISTEN:
2006     case O_ACCEPT:
2007     case O_SSELECT:
2008     case O_SOCKETPAIR:
2009     case O_GHBYNAME:
2010     case O_GHBYADDR:
2011     case O_GHOSTENT:
2012     case O_GNBYNAME:
2013     case O_GNBYADDR:
2014     case O_GNETENT:
2015     case O_GPBYNAME:
2016     case O_GPBYNUMBER:
2017     case O_GPROTOENT:
2018     case O_GSBYNAME:
2019     case O_GSBYPORT:
2020     case O_GSERVENT:
2021     case O_SHOSTENT:
2022     case O_SNETENT:
2023     case O_SPROTOENT:
2024     case O_SSERVENT:
2025     case O_EHOSTENT:
2026     case O_ENETENT:
2027     case O_EPROTOENT:
2028     case O_ESERVENT:
2029     case O_SHUTDOWN:
2030     case O_GSOCKOPT:
2031     case O_SSOCKOPT:
2032     case O_GETSOCKNAME:
2033     case O_GETPEERNAME:
2034       badsock:
2035         fatal("Unsupported socket function");
2036 #endif /* SOCKET */
2037     case O_FILENO:
2038         if (maxarg < 1)
2039             goto say_undef;
2040         if ((arg[1].arg_type & A_MASK) == A_WORD)
2041             stab = arg[1].arg_ptr.arg_stab;
2042         else
2043             stab = stabent(str_get(st[1]),TRUE);
2044         if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
2045             goto say_undef;
2046         value = fileno(fp);
2047         goto donumset;
2048     case O_VEC:
2049         sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
2050         goto array_return;
2051     case O_GPWNAM:
2052     case O_GPWUID:
2053     case O_GPWENT:
2054         sp = do_gpwent(optype,
2055           gimme,arglast);
2056         goto array_return;
2057     case O_SPWENT:
2058         value = (double) setpwent();
2059         goto donumset;
2060     case O_EPWENT:
2061         value = (double) endpwent();
2062         goto donumset;
2063     case O_GGRNAM:
2064     case O_GGRGID:
2065     case O_GGRENT:
2066         sp = do_ggrent(optype,
2067           gimme,arglast);
2068         goto array_return;
2069     case O_SGRENT:
2070         value = (double) setgrent();
2071         goto donumset;
2072     case O_EGRENT:
2073         value = (double) endgrent();
2074         goto donumset;
2075     case O_GETLOGIN:
2076         if (!(tmps = getlogin()))
2077             goto say_undef;
2078         str_set(str,tmps);
2079         break;
2080     case O_OPENDIR:
2081     case O_READDIR:
2082     case O_TELLDIR:
2083     case O_SEEKDIR:
2084     case O_REWINDDIR:
2085     case O_CLOSEDIR:
2086         if (maxarg < 1)
2087             goto say_undef;
2088         if ((arg[1].arg_type & A_MASK) == A_WORD)
2089             stab = arg[1].arg_ptr.arg_stab;
2090         else
2091             stab = stabent(str_get(st[1]),TRUE);
2092         sp = do_dirop(optype,stab,gimme,arglast);
2093         goto array_return;
2094     case O_SYSCALL:
2095         value = (double)do_syscall(arglast);
2096         goto donumset;
2097     case O_PIPE:
2098         if ((arg[1].arg_type & A_MASK) == A_WORD)
2099             stab = arg[1].arg_ptr.arg_stab;
2100         else
2101             stab = stabent(str_get(st[1]),TRUE);
2102         if ((arg[2].arg_type & A_MASK) == A_WORD)
2103             stab2 = arg[2].arg_ptr.arg_stab;
2104         else
2105             stab2 = stabent(str_get(st[2]),TRUE);
2106         do_pipe(str,stab,stab2);
2107         STABSET(str);
2108         break;
2109     }
2110
2111   normal_return:
2112     st[1] = str;
2113 #ifdef DEBUGGING
2114     if (debug) {
2115         dlevel--;
2116         if (debug & 8)
2117             deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
2118     }
2119 #endif
2120     return arglast[0] + 1;
2121
2122 array_return:
2123 #ifdef DEBUGGING
2124     if (debug) {
2125         dlevel--;
2126         if (debug & 8) {
2127             anum = sp - arglast[0];
2128             switch (anum) {
2129             case 0:
2130                 deb("%s RETURNS ()\n",opname[optype]);
2131                 break;
2132             case 1:
2133                 deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1]));
2134                 break;
2135             default:
2136                 deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\"\n",opname[optype],anum,
2137                   str_get(st[1]),anum==2?"":"...,",str_get(st[anum]));
2138                 break;
2139             }
2140         }
2141     }
2142 #endif
2143     return sp;
2144
2145 say_yes:
2146     str = &str_yes;
2147     goto normal_return;
2148
2149 say_no:
2150     str = &str_no;
2151     goto normal_return;
2152
2153 say_undef:
2154     str = &str_undef;
2155     goto normal_return;
2156
2157 say_zero:
2158     value = 0.0;
2159     /* FALL THROUGH */
2160
2161 donumset:
2162     str_numset(str,value);
2163     STABSET(str);
2164     st[1] = str;
2165 #ifdef DEBUGGING
2166     if (debug) {
2167         dlevel--;
2168         if (debug & 8)
2169             deb("%s RETURNS \"%f\"\n",opname[optype],value);
2170     }
2171 #endif
2172     return arglast[0] + 1;
2173 }