eval.c

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