eval.c

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