eval.c

   1 /* $Header: eval.c,v 2.0 88/06/05 00:08:48 root Exp $
   2  *
   3  * $Log:        eval.c,v $
   4  * Revision 2.0  88/06/05  00:08:48  root
   5  * Baseline version 2.0.
   6  *
   7  */
   8
   9 #include "EXTERN.h"
  10 #include "perl.h"
  11
  12 #include <signal.h>
  13 #include <errno.h>
  14
  15 extern int errno;
  16
  17 #ifdef VOIDSIG
  18 static void (*ihand)();
  19 static void (*qhand)();
  20 #else
  21 static int (*ihand)();
  22 static int (*qhand)();
  23 #endif
  24
  25 ARG *debarg;
  26 STR str_args;
  27
  28 STR *
  29 eval(arg,retary,sargoff)
  30 register ARG *arg;
  31 STR ***retary;          /* where to return an array to, null if nowhere */
  32 int sargoff;            /* how many elements in sarg are already assigned */
  33 {
  34     register STR *str;
  35     register int anum;
  36     register int optype;
  37     int maxarg;
  38     int maxsarg;
  39     double value;
  40     STR *quicksarg[5];
  41     register STR **sarg = quicksarg;
  42     register char *tmps;
  43     char *tmps2;
  44     int argflags;
  45     int argtype;
  46     union argptr argptr;
  47     int cushion;
  48     unsigned long tmplong;
  49     long when;
  50     FILE *fp;
  51     STR *tmpstr;
  52     FCMD *form;
  53     STAB *stab;
  54     ARRAY *ary;
  55     bool assigning = FALSE;
  56     double exp(), log(), sqrt(), modf();
  57     char *crypt(), *getenv();
  58
  59     if (!arg)
  60         return &str_no;
  61     str = arg->arg_ptr.arg_str;
  62     optype = arg->arg_type;
  63     maxsarg = maxarg = arg->arg_len;
  64     if (maxsarg > 3 || retary) {
  65         if (sargoff >= 0) {     /* array already exists, just append to it */
  66             cushion = 10;
  67             sarg = (STR **)saferealloc((char*)*retary,
  68               (maxsarg+sargoff+2+cushion) * sizeof(STR*)) + sargoff;
  69               /* Note that sarg points into the middle of the array */
  70         }
  71         else {
  72             sargoff = cushion = 0;
  73             sarg = (STR **)safemalloc((maxsarg+2) * sizeof(STR*));
  74         }
  75     }
  76     else
  77         sargoff = 0;
  78 #ifdef DEBUGGING
  79     if (debug) {
  80         if (debug & 8) {
  81             deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
  82         }
  83         debname[dlevel] = opname[optype][0];
  84         debdelim[dlevel++] = ':';
  85     }
  86 #endif
  87     for (anum = 1; anum <= maxarg; anum++) {
  88         argflags = arg[anum].arg_flags;
  89         if (argflags & AF_SPECIAL)
  90             continue;
  91         argtype = arg[anum].arg_type;
  92         argptr = arg[anum].arg_ptr;
  93       re_eval:
  94         switch (argtype) {
  95         default:
  96             sarg[anum] = &str_no;
  97 #ifdef DEBUGGING
  98             tmps = "NULL";
  99 #endif
 100             break;
 101         case A_EXPR:
 102 #ifdef DEBUGGING
 103             if (debug & 8) {
 104                 tmps = "EXPR";
 105                 deb("%d.EXPR =>\n",anum);
 106             }
 107 #endif
 108             if (retary &&
 109               (optype == O_LIST || optype == O_ITEM2 || optype == O_ITEM3)) {
 110                 *retary = sarg - sargoff;
 111                 eval(argptr.arg_arg, retary, anum - 1 + sargoff);
 112                 sarg = *retary;         /* they do realloc it... */
 113                 argtype = maxarg - anum;        /* how many left? */
 114                 maxsarg = (int)(str_gnum(sarg[0])) + argtype;
 115                 sargoff = maxsarg - maxarg;
 116                 if (argtype > 9 - cushion) {    /* we don't have room left */
 117                     sarg = (STR **)saferealloc((char*)sarg,
 118                       (maxsarg+2+cushion) * sizeof(STR*));
 119                 }
 120                 sarg += sargoff;
 121             }
 122             else
 123                 sarg[anum] = eval(argptr.arg_arg, Null(STR***),-1);
 124             break;
 125         case A_CMD:
 126 #ifdef DEBUGGING
 127             if (debug & 8) {
 128                 tmps = "CMD";
 129                 deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
 130             }
 131 #endif
 132             sarg[anum] = cmd_exec(argptr.arg_cmd);
 133             break;
 134         case A_STAB:
 135             sarg[anum] = STAB_STR(argptr.arg_stab);
 136 #ifdef DEBUGGING
 137             if (debug & 8) {
 138                 sprintf(buf,"STAB $%s",argptr.arg_stab->stab_name);
 139                 tmps = buf;
 140             }
 141 #endif
 142             break;
 143         case A_LEXPR:
 144 #ifdef DEBUGGING
 145             if (debug & 8) {
 146                 tmps = "LEXPR";
 147                 deb("%d.LEXPR =>\n",anum);
 148             }
 149 #endif
 150             str = eval(argptr.arg_arg,Null(STR***),-1);
 151             if (!str)
 152                 fatal("panic: A_LEXPR");
 153             goto do_crement;
 154         case A_LVAL:
 155 #ifdef DEBUGGING
 156             if (debug & 8) {
 157                 sprintf(buf,"LVAL $%s",argptr.arg_stab->stab_name);
 158                 tmps = buf;
 159             }
 160 #endif
 161             str = STAB_STR(argptr.arg_stab);
 162             if (!str)
 163                 fatal("panic: A_LVAL");
 164           do_crement:
 165             assigning = TRUE;
 166             if (argflags & AF_PRE) {
 167                 if (argflags & AF_UP)
 168                     str_inc(str);
 169                 else
 170                     str_dec(str);
 171                 STABSET(str);
 172                 sarg[anum] = str;
 173                 str = arg->arg_ptr.arg_str;
 174             }
 175             else if (argflags & AF_POST) {
 176                 sarg[anum] = str_static(str);
 177                 if (argflags & AF_UP)
 178                     str_inc(str);
 179                 else
 180                     str_dec(str);
 181                 STABSET(str);
 182                 str = arg->arg_ptr.arg_str;
 183             }
 184             else {
 185                 sarg[anum] = str;
 186             }
 187             break;
 188         case A_LARYLEN:
 189             str = sarg[anum] =
 190               argptr.arg_stab->stab_array->ary_magic;
 191 #ifdef DEBUGGING
 192             tmps = "LARYLEN";
 193 #endif
 194             if (!str)
 195                 fatal("panic: A_LEXPR");
 196             goto do_crement;
 197         case A_ARYLEN:
 198             stab = argptr.arg_stab;
 199             sarg[anum] = stab->stab_array->ary_magic;
 200             str_numset(sarg[anum],(double)(stab->stab_array->ary_fill+arybase));
 201 #ifdef DEBUGGING
 202             tmps = "ARYLEN";
 203 #endif
 204             break;
 205         case A_SINGLE:
 206             sarg[anum] = argptr.arg_str;
 207 #ifdef DEBUGGING
 208             tmps = "SINGLE";
 209 #endif
 210             break;
 211         case A_DOUBLE:
 212             (void) interp(str,str_get(argptr.arg_str));
 213             sarg[anum] = str;
 214 #ifdef DEBUGGING
 215             tmps = "DOUBLE";
 216 #endif
 217             break;
 218         case A_BACKTICK:
 219             tmps = str_get(argptr.arg_str);
 220             fp = popen(str_get(interp(str,tmps)),"r");
 221             tmpstr = str_new(80);
 222             str_set(str,"");
 223             if (fp) {
 224                 while (str_gets(tmpstr,fp) != Nullch) {
 225                     str_scat(str,tmpstr);
 226                 }
 227                 statusvalue = pclose(fp);
 228             }
 229             else
 230                 statusvalue = -1;
 231             str_free(tmpstr);
 232
 233             sarg[anum] = str;
 234 #ifdef DEBUGGING
 235             tmps = "BACK";
 236 #endif
 237             break;
 238         case A_INDREAD:
 239             last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
 240             goto do_read;
 241         case A_GLOB:
 242             argflags |= AF_POST;        /* enable newline chopping */
 243         case A_READ:
 244             last_in_stab = argptr.arg_stab;
 245           do_read:
 246             fp = Nullfp;
 247             if (last_in_stab->stab_io) {
 248                 fp = last_in_stab->stab_io->fp;
 249                 if (!fp) {
 250                     if (last_in_stab->stab_io->flags & IOF_ARGV) {
 251                         if (last_in_stab->stab_io->flags & IOF_START) {
 252                             last_in_stab->stab_io->flags &= ~IOF_START;
 253                             last_in_stab->stab_io->lines = 0;
 254                             if (alen(last_in_stab->stab_array) < 0) {
 255                                 tmpstr = str_make("-"); /* assume stdin */
 256                                 apush(last_in_stab->stab_array, tmpstr);
 257                             }
 258                         }
 259                         fp = nextargv(last_in_stab);
 260                         if (!fp)  /* Note: fp != last_in_stab->stab_io->fp */
 261                             do_close(last_in_stab,FALSE);  /* now it does */
 262                     }
 263                     else if (argtype == A_GLOB) {
 264                         (void) interp(str,str_get(last_in_stab->stab_val));
 265                         tmps = str->str_ptr;
 266                         if (*tmps == '!')
 267                             sprintf(tokenbuf,"%s|",tmps+1);
 268                         else {
 269                             if (*tmps == ';')
 270                                 sprintf(tokenbuf, "%s", tmps+1);
 271                             else
 272                                 sprintf(tokenbuf, "echo %s", tmps);
 273                             strcat(tokenbuf,
 274                               "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
 275                         }
 276                         do_open(last_in_stab,tokenbuf);
 277                         fp = last_in_stab->stab_io->fp;
 278                     }
 279                 }
 280             }
 281             if (!fp && dowarn)
 282                 warn("Read on closed filehandle <%s>",last_in_stab->stab_name);
 283           keepgoing:
 284             if (!fp)
 285                 sarg[anum] = &str_no;
 286             else if (!str_gets(str,fp)) {
 287                 if (last_in_stab->stab_io->flags & IOF_ARGV) {
 288                     fp = nextargv(last_in_stab);
 289                     if (fp)
 290                         goto keepgoing;
 291                     do_close(last_in_stab,FALSE);
 292                     last_in_stab->stab_io->flags |= IOF_START;
 293                 }
 294                 else if (argflags & AF_POST) {
 295                     do_close(last_in_stab,FALSE);
 296                 }
 297                 if (fp == stdin) {
 298                     clearerr(fp);
 299                 }
 300                 sarg[anum] = &str_no;
 301                 if (retary) {
 302                     maxarg = anum - 1;
 303                     maxsarg = maxarg + sargoff;
 304                 }
 305                 break;
 306             }
 307             else {
 308                 last_in_stab->stab_io->lines++;
 309                 sarg[anum] = str;
 310                 if (argflags & AF_POST) {
 311                     if (str->str_cur > 0)
 312                         str->str_cur--;
 313                     str->str_ptr[str->str_cur] = '\0';
 314                 }
 315                 if (retary) {
 316                     sarg[anum] = str_static(sarg[anum]);
 317                     anum++;
 318                     if (anum > maxarg) {
 319                         maxarg = anum + anum;
 320                         maxsarg = maxarg + sargoff;
 321                         sarg = (STR **)saferealloc((char*)(sarg-sargoff),
 322                           (maxsarg+2+cushion) * sizeof(STR*)) + sargoff;
 323                     }
 324                     goto keepgoing;
 325                 }
 326             }
 327             if (retary) {
 328                 maxarg = anum - 1;
 329                 maxsarg = maxarg + sargoff;
 330             }
 331 #ifdef DEBUGGING
 332             tmps = "READ";
 333 #endif
 334             break;
 335         }
 336 #ifdef DEBUGGING
 337         if (debug & 8)
 338             deb("%d.%s = '%s'\n",anum,tmps,str_peek(sarg[anum]));
 339 #endif
 340     }
 341     switch (optype) {
 342     case O_ITEM:
 343         if (maxarg > arg->arg_len)
 344             goto array_return;
 345         if (str != sarg[1])
 346             str_sset(str,sarg[1]);
 347         STABSET(str);
 348         break;
 349     case O_ITEM2:
 350         if (str != sarg[--anum])
 351             str_sset(str,sarg[anum]);
 352         STABSET(str);
 353         break;
 354     case O_ITEM3:
 355         if (str != sarg[--anum])
 356             str_sset(str,sarg[anum]);
 357         STABSET(str);
 358         break;
 359     case O_CONCAT:
 360         if (str != sarg[1])
 361             str_sset(str,sarg[1]);
 362         str_scat(str,sarg[2]);
 363         STABSET(str);
 364         break;
 365     case O_REPEAT:
 366         if (str != sarg[1])
 367             str_sset(str,sarg[1]);
 368         anum = (int)str_gnum(sarg[2]);
 369         if (anum >= 1) {
 370             tmpstr = str_new(0);
 371             str_sset(tmpstr,str);
 372             while (--anum > 0)
 373                 str_scat(str,tmpstr);
 374         }
 375         else
 376             str_sset(str,&str_no);
 377         STABSET(str);
 378         break;
 379     case O_MATCH:
 380         str_sset(str, do_match(arg,
 381           retary,sarg,&maxsarg,sargoff,cushion));
 382         if (retary) {
 383             sarg = *retary;     /* they realloc it */
 384             goto array_return;
 385         }
 386         STABSET(str);
 387         break;
 388     case O_NMATCH:
 389         str_sset(str, do_match(arg,
 390           retary,sarg,&maxsarg,sargoff,cushion));
 391         if (retary) {
 392             sarg = *retary;     /* they realloc it */
 393             goto array_return;  /* ignore negation */
 394         }
 395         str_set(str, str_true(str) ? No : Yes);
 396         STABSET(str);
 397         break;
 398     case O_SUBST:
 399         value = (double) do_subst(str, arg);
 400         str = arg->arg_ptr.arg_str;
 401         goto donumset;
 402     case O_NSUBST:
 403         str_set(arg->arg_ptr.arg_str, do_subst(str, arg) ? No : Yes);
 404         str = arg->arg_ptr.arg_str;
 405         break;
 406     case O_ASSIGN:
 407         if (arg[1].arg_flags & AF_SPECIAL)
 408             do_assign(str,arg,sarg);
 409         else {
 410             if (str != sarg[2])
 411                 str_sset(str, sarg[2]);
 412             STABSET(str);
 413         }
 414         break;
 415     case O_CHOP:
 416         tmps = str_get(str);
 417         tmps += str->str_cur - (str->str_cur != 0);
 418         str_set(arg->arg_ptr.arg_str,tmps);     /* remember last char */
 419         *tmps = '\0';                           /* wipe it out */
 420         str->str_cur = tmps - str->str_ptr;
 421         str->str_nok = 0;
 422         str = arg->arg_ptr.arg_str;
 423         break;
 424     case O_STUDY:
 425         value = (double)do_study(str);
 426         str = arg->arg_ptr.arg_str;
 427         goto donumset;
 428     case O_MULTIPLY:
 429         value = str_gnum(sarg[1]);
 430         value *= str_gnum(sarg[2]);
 431         goto donumset;
 432     case O_DIVIDE:
 433         if ((value = str_gnum(sarg[2])) == 0.0)
 434             fatal("Illegal division by zero");
 435         value = str_gnum(sarg[1]) / value;
 436         goto donumset;
 437     case O_MODULO:
 438         if ((tmplong = (unsigned long) str_gnum(sarg[2])) == 0L)
 439             fatal("Illegal modulus zero");
 440         value = str_gnum(sarg[1]);
 441         value = (double)(((unsigned long)value) % tmplong);
 442         goto donumset;
 443     case O_ADD:
 444         value = str_gnum(sarg[1]);
 445         value += str_gnum(sarg[2]);
 446         goto donumset;
 447     case O_SUBTRACT:
 448         value = str_gnum(sarg[1]);
 449         value -= str_gnum(sarg[2]);
 450         goto donumset;
 451     case O_LEFT_SHIFT:
 452         value = str_gnum(sarg[1]);
 453         anum = (int)str_gnum(sarg[2]);
 454         value = (double)(((unsigned long)value) << anum);
 455         goto donumset;
 456     case O_RIGHT_SHIFT:
 457         value = str_gnum(sarg[1]);
 458         anum = (int)str_gnum(sarg[2]);
 459         value = (double)(((unsigned long)value) >> anum);
 460         goto donumset;
 461     case O_LT:
 462         value = str_gnum(sarg[1]);
 463         value = (double)(value < str_gnum(sarg[2]));
 464         goto donumset;
 465     case O_GT:
 466         value = str_gnum(sarg[1]);
 467         value = (double)(value > str_gnum(sarg[2]));
 468         goto donumset;
 469     case O_LE:
 470         value = str_gnum(sarg[1]);
 471         value = (double)(value <= str_gnum(sarg[2]));
 472         goto donumset;
 473     case O_GE:
 474         value = str_gnum(sarg[1]);
 475         value = (double)(value >= str_gnum(sarg[2]));
 476         goto donumset;
 477     case O_EQ:
 478         value = str_gnum(sarg[1]);
 479         value = (double)(value == str_gnum(sarg[2]));
 480         goto donumset;
 481     case O_NE:
 482         value = str_gnum(sarg[1]);
 483         value = (double)(value != str_gnum(sarg[2]));
 484         goto donumset;
 485     case O_BIT_AND:
 486         value = str_gnum(sarg[1]);
 487         value = (double)(((unsigned long)value) &
 488             (unsigned long)str_gnum(sarg[2]));
 489         goto donumset;
 490     case O_XOR:
 491         value = str_gnum(sarg[1]);
 492         value = (double)(((unsigned long)value) ^
 493             (unsigned long)str_gnum(sarg[2]));
 494         goto donumset;
 495     case O_BIT_OR:
 496         value = str_gnum(sarg[1]);
 497         value = (double)(((unsigned long)value) |
 498             (unsigned long)str_gnum(sarg[2]));
 499         goto donumset;
 500     case O_AND:
 501         if (str_true(sarg[1])) {
 502             anum = 2;
 503             optype = O_ITEM2;
 504             argflags = arg[anum].arg_flags;
 505             argtype = arg[anum].arg_type;
 506             argptr = arg[anum].arg_ptr;
 507             maxarg = anum = 1;
 508             goto re_eval;
 509         }
 510         else {
 511             if (assigning) {
 512                 str_sset(str, sarg[1]);
 513                 STABSET(str);
 514             }
 515             else
 516                 str = sarg[1];
 517             break;
 518         }
 519     case O_OR:
 520         if (str_true(sarg[1])) {
 521             if (assigning) {
 522                 str_sset(str, sarg[1]);
 523                 STABSET(str);
 524             }
 525             else
 526                 str = sarg[1];
 527             break;
 528         }
 529         else {
 530             anum = 2;
 531             optype = O_ITEM2;
 532             argflags = arg[anum].arg_flags;
 533             argtype = arg[anum].arg_type;
 534             argptr = arg[anum].arg_ptr;
 535             maxarg = anum = 1;
 536             goto re_eval;
 537         }
 538     case O_COND_EXPR:
 539         anum = (str_true(sarg[1]) ? 2 : 3);
 540         optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
 541         argflags = arg[anum].arg_flags;
 542         argtype = arg[anum].arg_type;
 543         argptr = arg[anum].arg_ptr;
 544         maxarg = anum = 1;
 545         goto re_eval;
 546     case O_COMMA:
 547         str = sarg[2];
 548         break;
 549     case O_NEGATE:
 550         value = -str_gnum(sarg[1]);
 551         goto donumset;
 552     case O_NOT:
 553         value = (double) !str_true(sarg[1]);
 554         goto donumset;
 555     case O_COMPLEMENT:
 556         value = (double) ~(long)str_gnum(sarg[1]);
 557         goto donumset;
 558     case O_SELECT:
 559         if (arg[1].arg_type == A_LVAL)
 560             defoutstab = arg[1].arg_ptr.arg_stab;
 561         else
 562             defoutstab = stabent(str_get(sarg[1]),TRUE);
 563         if (!defoutstab->stab_io)
 564             defoutstab->stab_io = stio_new();
 565         curoutstab = defoutstab;
 566         str_set(str,curoutstab->stab_io->fp ? Yes : No);
 567         STABSET(str);
 568         break;
 569     case O_WRITE:
 570         if (maxarg == 0)
 571             stab = defoutstab;
 572         else if (arg[1].arg_type == A_LVAL)
 573             stab = arg[1].arg_ptr.arg_stab;
 574         else
 575             stab = stabent(str_get(sarg[1]),TRUE);
 576         if (!stab->stab_io) {
 577             str_set(str, No);
 578             STABSET(str);
 579             break;
 580         }
 581         curoutstab = stab;
 582         fp = stab->stab_io->fp;
 583         debarg = arg;
 584         if (stab->stab_io->fmt_stab)
 585             form = stab->stab_io->fmt_stab->stab_form;
 586         else
 587             form = stab->stab_form;
 588         if (!form || !fp) {
 589             str_set(str, No);
 590             STABSET(str);
 591             break;
 592         }
 593         format(&outrec,form);
 594         do_write(&outrec,stab->stab_io);
 595         if (stab->stab_io->flags & IOF_FLUSH)
 596             fflush(fp);
 597         str_set(str, Yes);
 598         STABSET(str);
 599         break;
 600     case O_OPEN:
 601         if (arg[1].arg_type == A_WORD)
 602             stab = arg[1].arg_ptr.arg_stab;
 603         else
 604             stab = stabent(str_get(sarg[1]),TRUE);
 605         if (do_open(stab,str_get(sarg[2]))) {
 606             value = (double)forkprocess;
 607             stab->stab_io->lines = 0;
 608             goto donumset;
 609         }
 610         else
 611             str_set(str, No);
 612         STABSET(str);
 613         break;
 614     case O_TRANS:
 615         value = (double) do_trans(str,arg);
 616         str = arg->arg_ptr.arg_str;
 617         goto donumset;
 618     case O_NTRANS:
 619         str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
 620         str = arg->arg_ptr.arg_str;
 621         break;
 622     case O_CLOSE:
 623         if (arg[1].arg_type == A_WORD)
 624             stab = arg[1].arg_ptr.arg_stab;
 625         else
 626             stab = stabent(str_get(sarg[1]),TRUE);
 627         str_set(str, do_close(stab,TRUE) ? Yes : No );
 628         STABSET(str);
 629         break;
 630     case O_EACH:
 631         str_sset(str,do_each(arg[1].arg_ptr.arg_stab->stab_hash,
 632           retary,sarg,&maxsarg,sargoff,cushion));
 633         if (retary) {
 634             sarg = *retary;     /* they realloc it */
 635             goto array_return;
 636         }
 637         STABSET(str);
 638         break;
 639     case O_VALUES:
 640     case O_KEYS:
 641         value = (double) do_kv(arg[1].arg_ptr.arg_stab->stab_hash, optype,
 642           retary,sarg,&maxsarg,sargoff,cushion);
 643         if (retary) {
 644             sarg = *retary;     /* they realloc it */
 645             goto array_return;
 646         }
 647         goto donumset;
 648     case O_ARRAY:
 649         if (maxarg == 1) {
 650             ary = arg[1].arg_ptr.arg_stab->stab_array;
 651             maxarg = ary->ary_fill;
 652             maxsarg = maxarg + sargoff;
 653             if (retary) { /* array wanted */
 654                 sarg = (STR **)saferealloc((char*)(sarg-sargoff),
 655                   (maxsarg+3+cushion)*sizeof(STR*)) + sargoff;
 656                 for (anum = 0; anum <= maxarg; anum++) {
 657                     sarg[anum+1] = str = afetch(ary,anum);
 658                 }
 659                 maxarg++;
 660                 maxsarg++;
 661                 goto array_return;
 662             }
 663             else
 664                 str = afetch(ary,maxarg);
 665         }
 666         else
 667             str = afetch(arg[2].arg_ptr.arg_stab->stab_array,
 668                 ((int)str_gnum(sarg[1])) - arybase);
 669         if (!str)
 670             str = &str_no;
 671         break;
 672     case O_DELETE:
 673         tmpstab = arg[2].arg_ptr.arg_stab;              /* XXX */
 674         str = hdelete(tmpstab->stab_hash,str_get(sarg[1]));
 675         if (!str)
 676             str = &str_no;
 677         break;
 678     case O_HASH:
 679         tmpstab = arg[2].arg_ptr.arg_stab;              /* XXX */
 680         str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
 681         if (!str)
 682             str = &str_no;
 683         break;
 684     case O_LARRAY:
 685         anum = ((int)str_gnum(sarg[1])) - arybase;
 686         str = afetch(arg[2].arg_ptr.arg_stab->stab_array,anum);
 687         if (!str || str == &str_no) {
 688             str = str_new(0);
 689             astore(arg[2].arg_ptr.arg_stab->stab_array,anum,str);
 690         }
 691         break;
 692     case O_LHASH:
 693         tmpstab = arg[2].arg_ptr.arg_stab;
 694         str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
 695         if (!str) {
 696             str = str_new(0);
 697             hstore(tmpstab->stab_hash,str_get(sarg[1]),str);
 698         }
 699         if (tmpstab == envstab) {       /* heavy wizardry going on here */
 700             str->str_link.str_magic = tmpstab;/* str is now magic */
 701             envname = savestr(str_get(sarg[1]));
 702                                         /* he threw the brick up into the air */
 703         }
 704         else if (tmpstab == sigstab) {  /* same thing, only different */
 705             str->str_link.str_magic = tmpstab;
 706             signame = savestr(str_get(sarg[1]));
 707         }
 708         break;
 709     case O_PUSH:
 710         if (arg[1].arg_flags & AF_SPECIAL)
 711             str = do_push(arg,arg[2].arg_ptr.arg_stab->stab_array);
 712         else {
 713             str = str_new(0);           /* must copy the STR */
 714             str_sset(str,sarg[1]);
 715             apush(arg[2].arg_ptr.arg_stab->stab_array,str);
 716         }
 717         break;
 718     case O_POP:
 719         str = apop(arg[1].arg_ptr.arg_stab->stab_array);
 720         if (!str) {
 721             str = &str_no;
 722             break;
 723         }
 724 #ifdef STRUCTCOPY
 725         *(arg->arg_ptr.arg_str) = *str;
 726 #else
 727         bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
 728 #endif
 729         safefree((char*)str);
 730         str = arg->arg_ptr.arg_str;
 731         break;
 732     case O_SHIFT:
 733         str = ashift(arg[1].arg_ptr.arg_stab->stab_array);
 734         if (!str) {
 735             str = &str_no;
 736             break;
 737         }
 738 #ifdef STRUCTCOPY
 739         *(arg->arg_ptr.arg_str) = *str;
 740 #else
 741         bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
 742 #endif
 743         safefree((char*)str);
 744         str = arg->arg_ptr.arg_str;
 745         break;
 746     case O_SPLIT:
 747         value = (double) do_split(arg[2].arg_ptr.arg_spat,
 748           retary,sarg,&maxsarg,sargoff,cushion);
 749         if (retary) {
 750             sarg = *retary;     /* they realloc it */
 751             goto array_return;
 752         }
 753         goto donumset;
 754     case O_LENGTH:
 755         value = (double) str_len(sarg[1]);
 756         goto donumset;
 757     case O_SPRINTF:
 758         sarg[maxsarg+1] = Nullstr;
 759         do_sprintf(str,arg->arg_len,sarg);
 760         break;
 761     case O_SUBSTR:
 762         anum = ((int)str_gnum(sarg[2])) - arybase;
 763         for (tmps = str_get(sarg[1]); *tmps && anum > 0; tmps++,anum--) ;
 764         anum = (int)str_gnum(sarg[3]);
 765         if (anum >= 0 && strlen(tmps) > anum)
 766             str_nset(str, tmps, anum);
 767         else
 768             str_set(str, tmps);
 769         break;
 770     case O_JOIN:
 771         if (arg[2].arg_flags & AF_SPECIAL && arg[2].arg_type == A_EXPR)
 772             do_join(arg,str_get(sarg[1]),str);
 773         else
 774             ajoin(arg[2].arg_ptr.arg_stab->stab_array,str_get(sarg[1]),str);
 775         break;
 776     case O_SLT:
 777         tmps = str_get(sarg[1]);
 778         value = (double) strLT(tmps,str_get(sarg[2]));
 779         goto donumset;
 780     case O_SGT:
 781         tmps = str_get(sarg[1]);
 782         value = (double) strGT(tmps,str_get(sarg[2]));
 783         goto donumset;
 784     case O_SLE:
 785         tmps = str_get(sarg[1]);
 786         value = (double) strLE(tmps,str_get(sarg[2]));
 787         goto donumset;
 788     case O_SGE:
 789         tmps = str_get(sarg[1]);
 790         value = (double) strGE(tmps,str_get(sarg[2]));
 791         goto donumset;
 792     case O_SEQ:
 793         tmps = str_get(sarg[1]);
 794         value = (double) strEQ(tmps,str_get(sarg[2]));
 795         goto donumset;
 796     case O_SNE:
 797         tmps = str_get(sarg[1]);
 798         value = (double) strNE(tmps,str_get(sarg[2]));
 799         goto donumset;
 800     case O_SUBR:
 801         str_sset(str,do_subr(arg,sarg));
 802         STABSET(str);
 803         break;
 804     case O_SORT:
 805         if (maxarg <= 1)
 806             stab = defoutstab;
 807         else {
 808             if (arg[2].arg_type == A_WORD)
 809                 stab = arg[2].arg_ptr.arg_stab;
 810             else
 811                 stab = stabent(str_get(sarg[2]),TRUE);
 812             if (!stab)
 813                 stab = defoutstab;
 814         }
 815         value = (double)do_sort(arg,stab,
 816           retary,sarg,&maxsarg,sargoff,cushion);
 817         if (retary) {
 818             sarg = *retary;     /* they realloc it */
 819             goto array_return;
 820         }
 821         goto donumset;
 822     case O_PRTF:
 823     case O_PRINT:
 824         if (maxarg <= 1)
 825             stab = defoutstab;
 826         else {
 827             if (arg[2].arg_type == A_WORD)
 828                 stab = arg[2].arg_ptr.arg_stab;
 829             else
 830                 stab = stabent(str_get(sarg[2]),TRUE);
 831             if (!stab)
 832                 stab = defoutstab;
 833         }
 834         if (!stab->stab_io || !(fp = stab->stab_io->fp))
 835             value = 0.0;
 836         else {
 837             if (arg[1].arg_flags & AF_SPECIAL)
 838                 value = (double)do_aprint(arg,fp);
 839             else {
 840                 value = (double)do_print(sarg[1],fp);
 841                 if (ors && optype == O_PRINT)
 842                     fputs(ors, fp);
 843             }
 844             if (stab->stab_io->flags & IOF_FLUSH)
 845                 fflush(fp);
 846         }
 847         goto donumset;
 848     case O_CHDIR:
 849         tmps = str_get(sarg[1]);
 850         if (!tmps || !*tmps)
 851             tmps = getenv("HOME");
 852         if (!tmps || !*tmps)
 853             tmps = getenv("LOGDIR");
 854         value = (double)(chdir(tmps) >= 0);
 855         goto donumset;
 856     case O_DIE:
 857         tmps = str_get(sarg[1]);
 858         if (!tmps || !*tmps)
 859             exit(1);
 860         fatal("%s",str_get(sarg[1]));
 861         value = 0.0;
 862         goto donumset;
 863     case O_EXIT:
 864         exit((int)str_gnum(sarg[1]));
 865         value = 0.0;
 866         goto donumset;
 867     case O_RESET:
 868         str_reset(str_get(sarg[1]));
 869         value = 1.0;
 870         goto donumset;
 871     case O_LIST:
 872         if (arg->arg_flags & AF_LOCAL)
 873             savelist(sarg,maxsarg);
 874         if (maxarg > 0)
 875             str = sarg[maxsarg];        /* unwanted list, return last item */
 876         else
 877             str = &str_no;
 878         if (retary)
 879             goto array_return;
 880         break;
 881     case O_EOF:
 882         if (maxarg <= 0)
 883             stab = last_in_stab;
 884         else if (arg[1].arg_type == A_WORD)
 885             stab = arg[1].arg_ptr.arg_stab;
 886         else
 887             stab = stabent(str_get(sarg[1]),TRUE);
 888         str_set(str, do_eof(stab) ? Yes : No);
 889         STABSET(str);
 890         break;
 891     case O_TELL:
 892         if (maxarg <= 0)
 893             stab = last_in_stab;
 894         else if (arg[1].arg_type == A_WORD)
 895             stab = arg[1].arg_ptr.arg_stab;
 896         else
 897             stab = stabent(str_get(sarg[1]),TRUE);
 898         value = (double)do_tell(stab);
 899         goto donumset;
 900     case O_SEEK:
 901         if (arg[1].arg_type == A_WORD)
 902             stab = arg[1].arg_ptr.arg_stab;
 903         else
 904             stab = stabent(str_get(sarg[1]),TRUE);
 905         value = str_gnum(sarg[2]);
 906         str_set(str, do_seek(stab,
 907           (long)value, (int)str_gnum(sarg[3]) ) ? Yes : No);
 908         STABSET(str);
 909         break;
 910     case O_REDO:
 911     case O_NEXT:
 912     case O_LAST:
 913         if (maxarg > 0) {
 914             tmps = str_get(sarg[1]);
 915             while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
 916               strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
 917 #ifdef DEBUGGING
 918                 if (debug & 4) {
 919                     deb("(Skipping label #%d %s)\n",loop_ptr,
 920                         loop_stack[loop_ptr].loop_label);
 921                 }
 922 #endif
 923                 loop_ptr--;
 924             }
 925 #ifdef DEBUGGING
 926             if (debug & 4) {
 927                 deb("(Found label #%d %s)\n",loop_ptr,
 928                     loop_stack[loop_ptr].loop_label);
 929             }
 930 #endif
 931         }
 932         if (loop_ptr < 0)
 933             fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
 934         longjmp(loop_stack[loop_ptr].loop_env, optype);
 935     case O_GOTO:/* shudder */
 936         goto_targ = str_get(sarg[1]);
 937         longjmp(top_env, 1);
 938     case O_INDEX:
 939         tmps = str_get(sarg[1]);
 940         if (!(tmps2 = fbminstr(tmps, tmps + sarg[1]->str_cur, sarg[2])))
 941             value = (double)(-1 + arybase);
 942         else
 943             value = (double)(tmps2 - tmps + arybase);
 944         goto donumset;
 945     case O_TIME:
 946         value = (double) time(Null(long*));
 947         goto donumset;
 948     case O_TMS:
 949         value = (double) do_tms(retary,sarg,&maxsarg,sargoff,cushion);
 950         if (retary) {
 951             sarg = *retary;     /* they realloc it */
 952             goto array_return;
 953         }
 954         goto donumset;
 955     case O_LOCALTIME:
 956         when = (long)str_gnum(sarg[1]);
 957         value = (double)do_time(localtime(&when),
 958           retary,sarg,&maxsarg,sargoff,cushion);
 959         if (retary) {
 960             sarg = *retary;     /* they realloc it */
 961             goto array_return;
 962         }
 963         goto donumset;
 964     case O_GMTIME:
 965         when = (long)str_gnum(sarg[1]);
 966         value = (double)do_time(gmtime(&when),
 967           retary,sarg,&maxsarg,sargoff,cushion);
 968         if (retary) {
 969             sarg = *retary;     /* they realloc it */
 970             goto array_return;
 971         }
 972         goto donumset;
 973     case O_STAT:
 974         value = (double) do_stat(arg,
 975           retary,sarg,&maxsarg,sargoff,cushion);
 976         if (retary) {
 977             sarg = *retary;     /* they realloc it */
 978             goto array_return;
 979         }
 980         goto donumset;
 981     case O_CRYPT:
 982 #ifdef CRYPT
 983         tmps = str_get(sarg[1]);
 984         str_set(str,crypt(tmps,str_get(sarg[2])));
 985 #else
 986         fatal(
 987           "The crypt() function is unimplemented due to excessive paranoia.");
 988 #endif
 989         break;
 990     case O_EXP:
 991         value = exp(str_gnum(sarg[1]));
 992         goto donumset;
 993     case O_LOG:
 994         value = log(str_gnum(sarg[1]));
 995         goto donumset;
 996     case O_SQRT:
 997         value = sqrt(str_gnum(sarg[1]));
 998         goto donumset;
 999     case O_INT:
1000         value = str_gnum(sarg[1]);
1001         if (value >= 0.0)
1002             modf(value,&value);
1003         else {
1004             modf(-value,&value);
1005             value = -value;
1006         }
1007         goto donumset;
1008     case O_ORD:
1009         value = (double) *str_get(sarg[1]);
1010         goto donumset;
1011     case O_SLEEP:
1012         tmps = str_get(sarg[1]);
1013         time(&when);
1014         if (!tmps || !*tmps)
1015             sleep((32767<<16)+32767);
1016         else
1017             sleep((unsigned)atoi(tmps));
1018         value = (double)when;
1019         time(&when);
1020         value = ((double)when) - value;
1021         goto donumset;
1022     case O_FLIP:
1023         if (str_true(sarg[1])) {
1024             str_numset(str,0.0);
1025             anum = 2;
1026             arg->arg_type = optype = O_FLOP;
1027             arg[2].arg_flags &= ~AF_SPECIAL;
1028             arg[1].arg_flags |= AF_SPECIAL;
1029             argflags = arg[2].arg_flags;
1030             argtype = arg[2].arg_type;
1031             argptr = arg[2].arg_ptr;
1032             goto re_eval;
1033         }
1034         str_set(str,"");
1035         break;
1036     case O_FLOP:
1037         str_inc(str);
1038         if (str_true(sarg[2])) {
1039             arg->arg_type = O_FLIP;
1040             arg[1].arg_flags &= ~AF_SPECIAL;
1041             arg[2].arg_flags |= AF_SPECIAL;
1042             str_cat(str,"E0");
1043         }
1044         break;
1045     case O_FORK:
1046         value = (double)fork();
1047         goto donumset;
1048     case O_WAIT:
1049         ihand = signal(SIGINT, SIG_IGN);
1050         qhand = signal(SIGQUIT, SIG_IGN);
1051         value = (double)wait(&argflags);
1052         signal(SIGINT, ihand);
1053         signal(SIGQUIT, qhand);
1054         statusvalue = (unsigned short)argflags;
1055         goto donumset;
1056     case O_SYSTEM:
1057         while ((anum = vfork()) == -1) {
1058             if (errno != EAGAIN) {
1059                 value = -1.0;
1060                 goto donumset;
1061             }
1062             sleep(5);
1063         }
1064         if (anum > 0) {
1065             ihand = signal(SIGINT, SIG_IGN);
1066             qhand = signal(SIGQUIT, SIG_IGN);
1067             while ((argtype = wait(&argflags)) != anum && argtype != -1)
1068                 ;
1069             signal(SIGINT, ihand);
1070             signal(SIGQUIT, qhand);
1071             statusvalue = (unsigned short)argflags;
1072             if (argtype == -1)
1073                 value = -1.0;
1074             else {
1075                 value = (double)((unsigned int)argflags & 0xffff);
1076             }
1077             goto donumset;
1078         }
1079         if (arg[1].arg_flags & AF_SPECIAL)
1080             value = (double)do_aexec(arg);
1081         else {
1082             value = (double)do_exec(str_static(sarg[1]));
1083         }
1084         _exit(-1);
1085     case O_EXEC:
1086         if (arg[1].arg_flags & AF_SPECIAL)
1087             value = (double)do_aexec(arg);
1088         else {
1089             value = (double)do_exec(str_static(sarg[1]));
1090         }
1091         goto donumset;
1092     case O_HEX:
1093         argtype = 4;
1094         goto snarfnum;
1095
1096     case O_OCT:
1097         argtype = 3;
1098
1099       snarfnum:
1100         anum = 0;
1101         tmps = str_get(sarg[1]);
1102         for (;;) {
1103             switch (*tmps) {
1104             default:
1105                 goto out;
1106             case '8': case '9':
1107                 if (argtype != 4)
1108                     goto out;
1109                 /* FALL THROUGH */
1110             case '0': case '1': case '2': case '3': case '4':
1111             case '5': case '6': case '7':
1112                 anum <<= argtype;
1113                 anum += *tmps++ & 15;
1114                 break;
1115             case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1116             case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
1117                 if (argtype != 4)
1118                     goto out;
1119                 anum <<= 4;
1120                 anum += (*tmps++ & 7) + 9;
1121                 break;
1122             case 'x':
1123                 argtype = 4;
1124                 tmps++;
1125                 break;
1126             }
1127         }
1128       out:
1129         value = (double)anum;
1130         goto donumset;
1131     case O_CHMOD:
1132     case O_CHOWN:
1133     case O_KILL:
1134     case O_UNLINK:
1135     case O_UTIME:
1136         if (arg[1].arg_flags & AF_SPECIAL)
1137             value = (double)apply(optype,arg,Null(STR**));
1138         else {
1139             sarg[2] = Nullstr;
1140             value = (double)apply(optype,arg,sarg);
1141         }
1142         goto donumset;
1143     case O_UMASK:
1144         value = (double)umask((int)str_gnum(sarg[1]));
1145         goto donumset;
1146     case O_RENAME:
1147         tmps = str_get(sarg[1]);
1148 #ifdef RENAME
1149         value = (double)(rename(tmps,str_get(sarg[2])) >= 0);
1150 #else
1151         tmps2 = str_get(sarg[2]);
1152         if (euid || stat(tmps2,&statbuf) < 0 ||
1153           (statbuf.st_mode & S_IFMT) != S_IFDIR )
1154             UNLINK(tmps2);      /* avoid unlinking a directory */
1155         if (!(anum = link(tmps,tmps2)))
1156             anum = UNLINK(tmps);
1157         value = (double)(anum >= 0);
1158 #endif
1159         goto donumset;
1160     case O_LINK:
1161         tmps = str_get(sarg[1]);
1162         value = (double)(link(tmps,str_get(sarg[2])) >= 0);
1163         goto donumset;
1164     case O_UNSHIFT:
1165         ary = arg[2].arg_ptr.arg_stab->stab_array;
1166         if (arg[1].arg_flags & AF_SPECIAL)
1167             do_unshift(arg,ary);
1168         else {
1169             str = str_new(0);           /* must copy the STR */
1170             str_sset(str,sarg[1]);
1171             aunshift(ary,1);
1172             astore(ary,0,str);
1173         }
1174         value = (double)(ary->ary_fill + 1);
1175         break;
1176     case O_DOFILE:
1177     case O_EVAL:
1178         str_sset(str,
1179             do_eval(arg[1].arg_type != A_NULL ? sarg[1] : defstab->stab_val,
1180               optype) );
1181         STABSET(str);
1182         break;
1183
1184     case O_FTRREAD:
1185         argtype = 0;
1186         anum = S_IREAD;
1187         goto check_perm;
1188     case O_FTRWRITE:
1189         argtype = 0;
1190         anum = S_IWRITE;
1191         goto check_perm;
1192     case O_FTREXEC:
1193         argtype = 0;
1194         anum = S_IEXEC;
1195         goto check_perm;
1196     case O_FTEREAD:
1197         argtype = 1;
1198         anum = S_IREAD;
1199         goto check_perm;
1200     case O_FTEWRITE:
1201         argtype = 1;
1202         anum = S_IWRITE;
1203         goto check_perm;
1204     case O_FTEEXEC:
1205         argtype = 1;
1206         anum = S_IEXEC;
1207       check_perm:
1208         str = &str_no;
1209         if (mystat(arg,sarg[1]) < 0)
1210             break;
1211         if (cando(anum,argtype))
1212             str = &str_yes;
1213         break;
1214
1215     case O_FTIS:
1216         if (mystat(arg,sarg[1]) >= 0)
1217             str = &str_yes;
1218         else
1219             str = &str_no;
1220         break;
1221     case O_FTEOWNED:
1222     case O_FTROWNED:
1223         if (mystat(arg,sarg[1]) >= 0 &&
1224           statbuf.st_uid == (optype == O_FTEOWNED ? euid : uid) )
1225             str = &str_yes;
1226         else
1227             str = &str_no;
1228         break;
1229     case O_FTZERO:
1230         if (mystat(arg,sarg[1]) >= 0 && !statbuf.st_size)
1231             str = &str_yes;
1232         else
1233             str = &str_no;
1234         break;
1235     case O_FTSIZE:
1236         if (mystat(arg,sarg[1]) >= 0 && statbuf.st_size)
1237             str = &str_yes;
1238         else
1239             str = &str_no;
1240         break;
1241
1242     case O_FTSOCK:
1243 #ifdef S_IFSOCK
1244         anum = S_IFSOCK;
1245         goto check_file_type;
1246 #else
1247         str = &str_no;
1248         break;
1249 #endif
1250     case O_FTCHR:
1251         anum = S_IFCHR;
1252         goto check_file_type;
1253     case O_FTBLK:
1254         anum = S_IFBLK;
1255         goto check_file_type;
1256     case O_FTFILE:
1257         anum = S_IFREG;
1258         goto check_file_type;
1259     case O_FTDIR:
1260         anum = S_IFDIR;
1261       check_file_type:
1262         if (mystat(arg,sarg[1]) >= 0 &&
1263           (statbuf.st_mode & S_IFMT) == anum )
1264             str = &str_yes;
1265         else
1266             str = &str_no;
1267         break;
1268     case O_FTPIPE:
1269 #ifdef S_IFIFO
1270         anum = S_IFIFO;
1271         goto check_file_type;
1272 #else
1273         str = &str_no;
1274         break;
1275 #endif
1276     case O_FTLINK:
1277 #ifdef S_IFLNK
1278         if (lstat(str_get(sarg[1]),&statbuf) >= 0 &&
1279           (statbuf.st_mode & S_IFMT) == S_IFLNK )
1280             str = &str_yes;
1281         else
1282 #endif
1283             str = &str_no;
1284         break;
1285     case O_SYMLINK:
1286 #ifdef SYMLINK
1287         tmps = str_get(sarg[1]);
1288         value = (double)(symlink(tmps,str_get(sarg[2])) >= 0);
1289         goto donumset;
1290 #else
1291         fatal("Unsupported function symlink()");
1292 #endif
1293     case O_FTSUID:
1294         anum = S_ISUID;
1295         goto check_xid;
1296     case O_FTSGID:
1297         anum = S_ISGID;
1298         goto check_xid;
1299     case O_FTSVTX:
1300         anum = S_ISVTX;
1301       check_xid:
1302         if (mystat(arg,sarg[1]) >= 0 && statbuf.st_mode & anum)
1303             str = &str_yes;
1304         else
1305             str = &str_no;
1306         break;
1307     case O_FTTTY:
1308         if (arg[1].arg_flags & AF_SPECIAL) {
1309             stab = arg[1].arg_ptr.arg_stab;
1310             tmps = "";
1311         }
1312         else
1313             stab = stabent(tmps = str_get(sarg[1]),FALSE);
1314         if (stab && stab->stab_io && stab->stab_io->fp)
1315             anum = fileno(stab->stab_io->fp);
1316         else if (isdigit(*tmps))
1317             anum = atoi(tmps);
1318         else
1319             anum = -1;
1320         if (isatty(anum))
1321             str = &str_yes;
1322         else
1323             str = &str_no;
1324         break;
1325     case O_FTTEXT:
1326     case O_FTBINARY:
1327         str = do_fttext(arg,sarg[1]);
1328         break;
1329     }
1330     if (retary) {
1331         sarg[1] = str;
1332         maxsarg = sargoff + 1;
1333     }
1334 #ifdef DEBUGGING
1335     if (debug) {
1336         dlevel--;
1337         if (debug & 8)
1338             deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
1339     }
1340 #endif
1341     goto freeargs;
1342
1343 array_return:
1344 #ifdef DEBUGGING
1345     if (debug) {
1346         dlevel--;
1347         if (debug & 8)
1348             deb("%s RETURNS ARRAY OF %d ARGS\n",opname[optype],maxsarg-sargoff);
1349     }
1350 #endif
1351     goto freeargs;
1352
1353 donumset:
1354     str_numset(str,value);
1355     STABSET(str);
1356     if (retary) {
1357         sarg[1] = str;
1358         maxsarg = sargoff + 1;
1359     }
1360 #ifdef DEBUGGING
1361     if (debug) {
1362         dlevel--;
1363         if (debug & 8)
1364             deb("%s RETURNS \"%f\"\n",opname[optype],value);
1365     }
1366 #endif
1367
1368 freeargs:
1369     sarg -= sargoff;
1370     if (sarg != quicksarg) {
1371         if (retary) {
1372             sarg[0] = &str_args;
1373             str_numset(sarg[0], (double)(maxsarg));
1374             sarg[maxsarg+1] = Nullstr;
1375             *retary = sarg;     /* up to them to free it */
1376         }
1377         else
1378             safefree((char*)sarg);
1379     }
1380     return str;
1381 }
1382
1383 int
1384 ingroup(gid,effective)
1385 int gid;
1386 int effective;
1387 {
1388     if (gid == (effective ? getegid() : getgid()))
1389         return TRUE;
1390 #ifdef GETGROUPS
1391 #ifndef NGROUPS
1392 #define NGROUPS 32
1393 #endif
1394     {
1395         GIDTYPE gary[NGROUPS];
1396         int anum;
1397
1398         anum = getgroups(NGROUPS,gary);
1399         while (--anum >= 0)
1400             if (gary[anum] == gid)
1401                 return TRUE;
1402     }
1403 #endif
1404     return FALSE;
1405 }
1406
1407 /* Do the permissions allow some operation?  Assumes statbuf already set. */
1408
1409 int
1410 cando(bit, effective)
1411 int bit;
1412 int effective;
1413 {
1414     if ((effective ? euid : uid) == 0) {        /* root is special */
1415         if (bit == S_IEXEC) {
1416             if (statbuf.st_mode & 0111 ||
1417               (statbuf.st_mode & S_IFMT) == S_IFDIR )
1418                 return TRUE;
1419         }
1420         else
1421             return TRUE;                /* root reads and writes anything */
1422         return FALSE;
1423     }
1424     if (statbuf.st_uid == (effective ? euid : uid) ) {
1425         if (statbuf.st_mode & bit)
1426             return TRUE;        /* ok as "user" */
1427     }
1428     else if (ingroup((int)statbuf.st_gid,effective)) {
1429         if (statbuf.st_mode & bit >> 3)
1430             return TRUE;        /* ok as "group" */
1431     }
1432     else if (statbuf.st_mode & bit >> 6)
1433         return TRUE;    /* ok as "other" */
1434     return FALSE;
1435 }