arg.c

   1 /* $Header: arg.c,v 1.0.1.7 88/02/02 11:22:19 root Exp $
   2  *
   3  * $Log:        arg.c,v $
   4  * Revision 1.0.1.7  88/02/02  11:22:19  root
   5  * patch13: fixed split(' ') to work right second time.  Added CRYPT dependency.
   6  *
   7  * Revision 1.0.1.6  88/02/01  17:32:26  root
   8  * patch12: made split(' ') behave like awk in ignoring leading white space.
   9  *
  10  * Revision 1.0.1.5  88/01/30  08:53:16  root
  11  * patch9: fixed some missing right parens introduced (?) by patch 2
  12  *
  13  * Revision 1.0.1.4  88/01/28  10:22:06  root
  14  * patch8: added eval operator.
  15  *
  16  * Revision 1.0.1.2  88/01/24  03:52:34  root
  17  * patch 2: added STATBLKS dependencies.
  18  *
  19  * Revision 1.0.1.1  88/01/21  21:27:10  root
  20  * Now defines signal return values correctly using VOIDSIG.
  21  *
  22  * Revision 1.0  87/12/18  13:04:33  root
  23  * Initial revision
  24  *
  25  */
  26
  27 #include <signal.h>
  28 #include "handy.h"
  29 #include "EXTERN.h"
  30 #include "search.h"
  31 #include "util.h"
  32 #include "perl.h"
  33
  34 ARG *debarg;
  35
  36 bool
  37 do_match(s,arg)
  38 register char *s;
  39 register ARG *arg;
  40 {
  41     register SPAT *spat = arg[2].arg_ptr.arg_spat;
  42     register char *d;
  43     register char *t;
  44
  45     if (!spat || !s)
  46         fatal("panic: do_match\n");
  47     if (spat->spat_flags & SPAT_USED) {
  48 #ifdef DEBUGGING
  49         if (debug & 8)
  50             deb("2.SPAT USED\n");
  51 #endif
  52         return FALSE;
  53     }
  54     if (spat->spat_runtime) {
  55         t = str_get(eval(spat->spat_runtime,Null(STR***)));
  56 #ifdef DEBUGGING
  57         if (debug & 8)
  58             deb("2.SPAT /%s/\n",t);
  59 #endif
  60         if (d = compile(&spat->spat_compex,t,TRUE,FALSE)) {
  61 #ifdef DEBUGGING
  62             deb("/%s/: %s\n", t, d);
  63 #endif
  64             return FALSE;
  65         }
  66         if (spat->spat_compex.complen <= 1 && curspat)
  67             spat = curspat;
  68         if (execute(&spat->spat_compex, s, TRUE, 0)) {
  69             if (spat->spat_compex.numsubs)
  70                 curspat = spat;
  71             return TRUE;
  72         }
  73         else
  74             return FALSE;
  75     }
  76     else {
  77 #ifdef DEBUGGING
  78         if (debug & 8) {
  79             char ch;
  80
  81             if (spat->spat_flags & SPAT_USE_ONCE)
  82                 ch = '?';
  83             else
  84                 ch = '/';
  85             deb("2.SPAT %c%s%c\n",ch,spat->spat_compex.precomp,ch);
  86         }
  87 #endif
  88         if (spat->spat_compex.complen <= 1 && curspat)
  89             spat = curspat;
  90         if (spat->spat_first) {
  91             if (spat->spat_flags & SPAT_SCANFIRST) {
  92                 str_free(spat->spat_first);
  93                 spat->spat_first = Nullstr;     /* disable optimization */
  94             }
  95             else if (*spat->spat_first->str_ptr != *s ||
  96               strnNE(spat->spat_first->str_ptr, s, spat->spat_flen) )
  97                 return FALSE;
  98         }
  99         if (execute(&spat->spat_compex, s, TRUE, 0)) {
 100             if (spat->spat_compex.numsubs)
 101                 curspat = spat;
 102             if (spat->spat_flags & SPAT_USE_ONCE)
 103                 spat->spat_flags |= SPAT_USED;
 104             return TRUE;
 105         }
 106         else
 107             return FALSE;
 108     }
 109     /*NOTREACHED*/
 110 }
 111
 112 int
 113 do_subst(str,arg)
 114 STR *str;
 115 register ARG *arg;
 116 {
 117     register SPAT *spat;
 118     register STR *dstr;
 119     register char *s;
 120     register char *m;
 121
 122     spat = arg[2].arg_ptr.arg_spat;
 123     s = str_get(str);
 124     if (!spat || !s)
 125         fatal("panic: do_subst\n");
 126     else if (spat->spat_runtime) {
 127         char *d;
 128
 129         m = str_get(eval(spat->spat_runtime,Null(STR***)));
 130         if (d = compile(&spat->spat_compex,m,TRUE,FALSE)) {
 131 #ifdef DEBUGGING
 132             deb("/%s/: %s\n", m, d);
 133 #endif
 134             return 0;
 135         }
 136     }
 137 #ifdef DEBUGGING
 138     if (debug & 8) {
 139         deb("2.SPAT /%s/\n",spat->spat_compex.precomp);
 140     }
 141 #endif
 142     if (spat->spat_compex.complen <= 1 && curspat)
 143         spat = curspat;
 144     if (spat->spat_first) {
 145         if (spat->spat_flags & SPAT_SCANFIRST) {
 146             str_free(spat->spat_first);
 147             spat->spat_first = Nullstr; /* disable optimization */
 148         }
 149         else if (*spat->spat_first->str_ptr != *s ||
 150           strnNE(spat->spat_first->str_ptr, s, spat->spat_flen) )
 151             return 0;
 152     }
 153     if (m = execute(&spat->spat_compex, s, TRUE, 1)) {
 154         int iters = 0;
 155
 156         dstr = str_new(str_len(str));
 157         if (spat->spat_compex.numsubs)
 158             curspat = spat;
 159         do {
 160             if (iters++ > 10000)
 161                 fatal("Substitution loop?\n");
 162             if (spat->spat_compex.numsubs)
 163                 s = spat->spat_compex.subbase;
 164             str_ncat(dstr,s,m-s);
 165             s = spat->spat_compex.subend[0];
 166             str_scat(dstr,eval(spat->spat_repl,Null(STR***)));
 167             if (spat->spat_flags & SPAT_USE_ONCE)
 168                 break;
 169         } while (m = execute(&spat->spat_compex, s, FALSE, 1));
 170         str_cat(dstr,s);
 171         str_replace(str,dstr);
 172         STABSET(str);
 173         return iters;
 174     }
 175     return 0;
 176 }
 177
 178 int
 179 do_trans(str,arg)
 180 STR *str;
 181 register ARG *arg;
 182 {
 183     register char *tbl;
 184     register char *s;
 185     register int matches = 0;
 186     register int ch;
 187
 188     tbl = arg[2].arg_ptr.arg_cval;
 189     s = str_get(str);
 190     if (!tbl || !s)
 191         fatal("panic: do_trans\n");
 192 #ifdef DEBUGGING
 193     if (debug & 8) {
 194         deb("2.TBL\n");
 195     }
 196 #endif
 197     while (*s) {
 198         if (ch = tbl[*s & 0377]) {
 199             matches++;
 200             *s = ch;
 201         }
 202         s++;
 203     }
 204     STABSET(str);
 205     return matches;
 206 }
 207
 208 int
 209 do_split(s,spat,retary)
 210 register char *s;
 211 register SPAT *spat;
 212 STR ***retary;
 213 {
 214     register STR *dstr;
 215     register char *m;
 216     register ARRAY *ary;
 217     static ARRAY *myarray = Null(ARRAY*);
 218     int iters = 0;
 219     STR **sarg;
 220     register char *e;
 221     int i;
 222
 223     if (!spat || !s)
 224         fatal("panic: do_split\n");
 225     else if (spat->spat_runtime) {
 226         char *d;
 227
 228         m = str_get(eval(spat->spat_runtime,Null(STR***)));
 229         if (!*m || (*m == ' ' && !m[1])) {
 230             m = "[ \\t\\n]+";
 231             spat->spat_flags |= SPAT_SKIPWHITE;
 232         }
 233         if (spat->spat_runtime->arg_type == O_ITEM &&
 234           spat->spat_runtime[1].arg_type == A_SINGLE) {
 235             arg_free(spat->spat_runtime);       /* it won't change, so */
 236             spat->spat_runtime = Nullarg;       /* no point compiling again */
 237         }
 238         if (d = compile(&spat->spat_compex,m,TRUE,FALSE)) {
 239 #ifdef DEBUGGING
 240             deb("/%s/: %s\n", m, d);
 241 #endif
 242             return FALSE;
 243         }
 244     }
 245 #ifdef DEBUGGING
 246     if (debug & 8) {
 247         deb("2.SPAT /%s/\n",spat->spat_compex.precomp);
 248     }
 249 #endif
 250     if (retary)
 251         ary = myarray;
 252     else
 253         ary = spat->spat_repl[1].arg_ptr.arg_stab->stab_array;
 254     if (!ary)
 255         myarray = ary = anew();
 256     ary->ary_fill = -1;
 257     if (spat->spat_flags & SPAT_SKIPWHITE) {
 258         while (isspace(*s))
 259             s++;
 260     }
 261     while (*s && (m = execute(&spat->spat_compex, s, (iters == 0), 1))) {
 262         if (spat->spat_compex.numsubs)
 263             s = spat->spat_compex.subbase;
 264         dstr = str_new(m-s);
 265         str_nset(dstr,s,m-s);
 266         astore(ary, iters++, dstr);
 267         if (iters > 10000)
 268             fatal("Substitution loop?\n");
 269         s = spat->spat_compex.subend[0];
 270     }
 271     if (*s) {                   /* ignore field after final "whitespace" */
 272         dstr = str_new(0);      /*   if they interpolate, it's null anyway */
 273         str_set(dstr,s);
 274         astore(ary, iters++, dstr);
 275     }
 276     else {
 277         while (iters > 0 && !*str_get(afetch(ary,iters-1)))
 278             iters--;
 279     }
 280     if (retary) {
 281         sarg = (STR**)safemalloc((iters+2)*sizeof(STR*));
 282
 283         sarg[0] = Nullstr;
 284         sarg[iters+1] = Nullstr;
 285         for (i = 1; i <= iters; i++)
 286             sarg[i] = afetch(ary,i-1);
 287         *retary = sarg;
 288     }
 289     return iters;
 290 }
 291
 292 void
 293 do_join(arg,delim,str)
 294 register ARG *arg;
 295 register char *delim;
 296 register STR *str;
 297 {
 298     STR **tmpary;       /* must not be register */
 299     register STR **elem;
 300
 301     (void)eval(arg[2].arg_ptr.arg_arg,&tmpary);
 302     elem = tmpary+1;
 303     if (*elem)
 304     str_sset(str,*elem++);
 305     for (; *elem; elem++) {
 306         str_cat(str,delim);
 307         str_scat(str,*elem);
 308     }
 309     STABSET(str);
 310     safefree((char*)tmpary);
 311 }
 312
 313 bool
 314 do_open(stab,name)
 315 STAB *stab;
 316 register char *name;
 317 {
 318     FILE *fp;
 319     int len = strlen(name);
 320     register STIO *stio = stab->stab_io;
 321
 322     while (len && isspace(name[len-1]))
 323         name[--len] = '\0';
 324     if (!stio)
 325         stio = stab->stab_io = stio_new();
 326     if (stio->fp) {
 327         if (stio->type == '|')
 328             pclose(stio->fp);
 329         else if (stio->type != '-')
 330             fclose(stio->fp);
 331         stio->fp = Nullfp;
 332     }
 333     stio->type = *name;
 334     if (*name == '|') {
 335         for (name++; isspace(*name); name++) ;
 336         fp = popen(name,"w");
 337     }
 338     else if (*name == '>' && name[1] == '>') {
 339         for (name += 2; isspace(*name); name++) ;
 340         fp = fopen(name,"a");
 341     }
 342     else if (*name == '>') {
 343         for (name++; isspace(*name); name++) ;
 344         if (strEQ(name,"-")) {
 345             fp = stdout;
 346             stio->type = '-';
 347         }
 348         else
 349             fp = fopen(name,"w");
 350     }
 351     else {
 352         if (*name == '<') {
 353             for (name++; isspace(*name); name++) ;
 354             if (strEQ(name,"-")) {
 355                 fp = stdin;
 356                 stio->type = '-';
 357             }
 358             else
 359                 fp = fopen(name,"r");
 360         }
 361         else if (name[len-1] == '|') {
 362             name[--len] = '\0';
 363             while (len && isspace(name[len-1]))
 364                 name[--len] = '\0';
 365             for (; isspace(*name); name++) ;
 366             fp = popen(name,"r");
 367             stio->type = '|';
 368         }
 369         else {
 370             stio->type = '<';
 371             for (; isspace(*name); name++) ;
 372             if (strEQ(name,"-")) {
 373                 fp = stdin;
 374                 stio->type = '-';
 375             }
 376             else
 377                 fp = fopen(name,"r");
 378         }
 379     }
 380     if (!fp)
 381         return FALSE;
 382     if (stio->type != '|' && stio->type != '-') {
 383         if (fstat(fileno(fp),&statbuf) < 0) {
 384             fclose(fp);
 385             return FALSE;
 386         }
 387         if ((statbuf.st_mode & S_IFMT) != S_IFREG &&
 388             (statbuf.st_mode & S_IFMT) != S_IFCHR) {
 389             fclose(fp);
 390             return FALSE;
 391         }
 392     }
 393     stio->fp = fp;
 394     return TRUE;
 395 }
 396
 397 FILE *
 398 nextargv(stab)
 399 register STAB *stab;
 400 {
 401     register STR *str;
 402     char *oldname;
 403
 404     while (alen(stab->stab_array) >= 0L) {
 405         str = ashift(stab->stab_array);
 406         str_sset(stab->stab_val,str);
 407         STABSET(stab->stab_val);
 408         oldname = str_get(stab->stab_val);
 409         if (do_open(stab,oldname)) {
 410             if (inplace) {
 411                 if (*inplace) {
 412                     str_cat(str,inplace);
 413 #ifdef RENAME
 414                     rename(oldname,str->str_ptr);
 415 #else
 416                     UNLINK(str->str_ptr);
 417                     link(oldname,str->str_ptr);
 418                     UNLINK(oldname);
 419 #endif
 420                 }
 421                 sprintf(tokenbuf,">%s",oldname);
 422                 do_open(argvoutstab,tokenbuf);
 423                 defoutstab = argvoutstab;
 424             }
 425             str_free(str);
 426             return stab->stab_io->fp;
 427         }
 428         else
 429             fprintf(stderr,"Can't open %s\n",str_get(str));
 430         str_free(str);
 431     }
 432     if (inplace) {
 433         do_close(argvoutstab,FALSE);
 434         defoutstab = stabent("stdout",TRUE);
 435     }
 436     return Nullfp;
 437 }
 438
 439 bool
 440 do_close(stab,explicit)
 441 STAB *stab;
 442 bool explicit;
 443 {
 444     bool retval = FALSE;
 445     register STIO *stio = stab->stab_io;
 446
 447     if (!stio)          /* never opened */
 448         return FALSE;
 449     if (stio->fp) {
 450         if (stio->type == '|')
 451             retval = (pclose(stio->fp) >= 0);
 452         else if (stio->type == '-')
 453             retval = TRUE;
 454         else
 455             retval = (fclose(stio->fp) != EOF);
 456         stio->fp = Nullfp;
 457     }
 458     if (explicit)
 459         stio->lines = 0;
 460     stio->type = ' ';
 461     return retval;
 462 }
 463
 464 bool
 465 do_eof(stab)
 466 STAB *stab;
 467 {
 468     register STIO *stio;
 469     int ch;
 470
 471     if (!stab)
 472         return TRUE;
 473
 474     stio = stab->stab_io;
 475     if (!stio)
 476         return TRUE;
 477
 478     while (stio->fp) {
 479
 480 #ifdef STDSTDIO                 /* (the code works without this) */
 481         if (stio->fp->_cnt)             /* cheat a little, since */
 482             return FALSE;               /* this is the most usual case */
 483 #endif
 484
 485         ch = getc(stio->fp);
 486         if (ch != EOF) {
 487             ungetc(ch, stio->fp);
 488             return FALSE;
 489         }
 490         if (stio->flags & IOF_ARGV) {   /* not necessarily a real EOF yet? */
 491             if (!nextargv(stab))        /* get another fp handy */
 492                 return TRUE;
 493         }
 494         else
 495             return TRUE;                /* normal fp, definitely end of file */
 496     }
 497     return TRUE;
 498 }
 499
 500 long
 501 do_tell(stab)
 502 STAB *stab;
 503 {
 504     register STIO *stio;
 505     int ch;
 506
 507     if (!stab)
 508         return -1L;
 509
 510     stio = stab->stab_io;
 511     if (!stio || !stio->fp)
 512         return -1L;
 513
 514     return ftell(stio->fp);
 515 }
 516
 517 bool
 518 do_seek(stab, pos, whence)
 519 STAB *stab;
 520 long pos;
 521 int whence;
 522 {
 523     register STIO *stio;
 524
 525     if (!stab)
 526         return FALSE;
 527
 528     stio = stab->stab_io;
 529     if (!stio || !stio->fp)
 530         return FALSE;
 531
 532     return fseek(stio->fp, pos, whence) >= 0;
 533 }
 534
 535 do_stat(arg,sarg,retary)
 536 register ARG *arg;
 537 register STR **sarg;
 538 STR ***retary;
 539 {
 540     register ARRAY *ary;
 541     static ARRAY *myarray = Null(ARRAY*);
 542     int max = 13;
 543     register int i;
 544
 545     ary = myarray;
 546     if (!ary)
 547         myarray = ary = anew();
 548     ary->ary_fill = -1;
 549     if (arg[1].arg_type == A_LVAL) {
 550         tmpstab = arg[1].arg_ptr.arg_stab;
 551         if (!tmpstab->stab_io ||
 552           fstat(fileno(tmpstab->stab_io->fp),&statbuf) < 0) {
 553             max = 0;
 554         }
 555     }
 556     else
 557         if (stat(str_get(sarg[1]),&statbuf) < 0)
 558             max = 0;
 559
 560     if (retary) {
 561         if (max) {
 562             apush(ary,str_nmake((double)statbuf.st_dev));
 563             apush(ary,str_nmake((double)statbuf.st_ino));
 564             apush(ary,str_nmake((double)statbuf.st_mode));
 565             apush(ary,str_nmake((double)statbuf.st_nlink));
 566             apush(ary,str_nmake((double)statbuf.st_uid));
 567             apush(ary,str_nmake((double)statbuf.st_gid));
 568             apush(ary,str_nmake((double)statbuf.st_rdev));
 569             apush(ary,str_nmake((double)statbuf.st_size));
 570             apush(ary,str_nmake((double)statbuf.st_atime));
 571             apush(ary,str_nmake((double)statbuf.st_mtime));
 572             apush(ary,str_nmake((double)statbuf.st_ctime));
 573 #ifdef STATBLOCKS
 574             apush(ary,str_nmake((double)statbuf.st_blksize));
 575             apush(ary,str_nmake((double)statbuf.st_blocks));
 576 #else
 577             apush(ary,str_make(""));
 578             apush(ary,str_make(""));
 579 #endif
 580         }
 581         sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
 582         sarg[0] = Nullstr;
 583         sarg[max+1] = Nullstr;
 584         for (i = 1; i <= max; i++)
 585             sarg[i] = afetch(ary,i-1);
 586         *retary = sarg;
 587     }
 588     return max;
 589 }
 590
 591 do_tms(retary)
 592 STR ***retary;
 593 {
 594     register ARRAY *ary;
 595     static ARRAY *myarray = Null(ARRAY*);
 596     register STR **sarg;
 597     int max = 4;
 598     register int i;
 599
 600     ary = myarray;
 601     if (!ary)
 602         myarray = ary = anew();
 603     ary->ary_fill = -1;
 604     if (times(&timesbuf) < 0)
 605         max = 0;
 606
 607     if (retary) {
 608         if (max) {
 609             apush(ary,str_nmake(((double)timesbuf.tms_utime)/60.0));
 610             apush(ary,str_nmake(((double)timesbuf.tms_stime)/60.0));
 611             apush(ary,str_nmake(((double)timesbuf.tms_cutime)/60.0));
 612             apush(ary,str_nmake(((double)timesbuf.tms_cstime)/60.0));
 613         }
 614         sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
 615         sarg[0] = Nullstr;
 616         sarg[max+1] = Nullstr;
 617         for (i = 1; i <= max; i++)
 618             sarg[i] = afetch(ary,i-1);
 619         *retary = sarg;
 620     }
 621     return max;
 622 }
 623
 624 do_time(tmbuf,retary)
 625 struct tm *tmbuf;
 626 STR ***retary;
 627 {
 628     register ARRAY *ary;
 629     static ARRAY *myarray = Null(ARRAY*);
 630     register STR **sarg;
 631     int max = 9;
 632     register int i;
 633     STR *str;
 634
 635     ary = myarray;
 636     if (!ary)
 637         myarray = ary = anew();
 638     ary->ary_fill = -1;
 639     if (!tmbuf)
 640         max = 0;
 641
 642     if (retary) {
 643         if (max) {
 644             apush(ary,str_nmake((double)tmbuf->tm_sec));
 645             apush(ary,str_nmake((double)tmbuf->tm_min));
 646             apush(ary,str_nmake((double)tmbuf->tm_hour));
 647             apush(ary,str_nmake((double)tmbuf->tm_mday));
 648             apush(ary,str_nmake((double)tmbuf->tm_mon));
 649             apush(ary,str_nmake((double)tmbuf->tm_year));
 650             apush(ary,str_nmake((double)tmbuf->tm_wday));
 651             apush(ary,str_nmake((double)tmbuf->tm_yday));
 652             apush(ary,str_nmake((double)tmbuf->tm_isdst));
 653         }
 654         sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
 655         sarg[0] = Nullstr;
 656         sarg[max+1] = Nullstr;
 657         for (i = 1; i <= max; i++)
 658             sarg[i] = afetch(ary,i-1);
 659         *retary = sarg;
 660     }
 661     return max;
 662 }
 663
 664 void
 665 do_sprintf(str,len,sarg)
 666 register STR *str;
 667 register int len;
 668 register STR **sarg;
 669 {
 670     register char *s;
 671     register char *t;
 672     bool dolong;
 673     char ch;
 674     static STR *sargnull = &str_no;
 675
 676     str_set(str,"");
 677     len--;                      /* don't count pattern string */
 678     sarg++;
 679     for (s = str_get(*(sarg++)); *s; len--) {
 680         if (len <= 0 || !*sarg) {
 681             sarg = &sargnull;
 682             len = 0;
 683         }
 684         dolong = FALSE;
 685         for (t = s; *t && *t != '%'; t++) ;
 686         if (!*t)
 687             break;              /* not enough % patterns, oh well */
 688         for (t++; *sarg && *t && t != s; t++) {
 689             switch (*t) {
 690             case '\0':
 691                 break;
 692             case '%':
 693                 ch = *(++t);
 694                 *t = '\0';
 695                 sprintf(buf,s);
 696                 s = t;
 697                 *(t--) = ch;
 698                 break;
 699             case 'l':
 700                 dolong = TRUE;
 701                 break;
 702             case 'D': case 'X': case 'O':
 703                 dolong = TRUE;
 704                 /* FALL THROUGH */
 705             case 'd': case 'x': case 'o': case 'c':
 706                 ch = *(++t);
 707                 *t = '\0';
 708                 if (dolong)
 709                     sprintf(buf,s,(long)str_gnum(*(sarg++)));
 710                 else
 711                     sprintf(buf,s,(int)str_gnum(*(sarg++)));
 712                 s = t;
 713                 *(t--) = ch;
 714                 break;
 715             case 'E': case 'e': case 'f': case 'G': case 'g':
 716                 ch = *(++t);
 717                 *t = '\0';
 718                 sprintf(buf,s,str_gnum(*(sarg++)));
 719                 s = t;
 720                 *(t--) = ch;
 721                 break;
 722             case 's':
 723                 ch = *(++t);
 724                 *t = '\0';
 725                 sprintf(buf,s,str_get(*(sarg++)));
 726                 s = t;
 727                 *(t--) = ch;
 728                 break;
 729             }
 730         }
 731         str_cat(str,buf);
 732     }
 733     if (*s)
 734         str_cat(str,s);
 735     STABSET(str);
 736 }
 737
 738 bool
 739 do_print(s,fp)
 740 char *s;
 741 FILE *fp;
 742 {
 743     if (!fp || !s)
 744         return FALSE;
 745     fputs(s,fp);
 746     return TRUE;
 747 }
 748
 749 bool
 750 do_aprint(arg,fp)
 751 register ARG *arg;
 752 register FILE *fp;
 753 {
 754     STR **tmpary;       /* must not be register */
 755     register STR **elem;
 756     register bool retval;
 757     double value;
 758
 759     (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
 760     if (arg->arg_type == O_PRTF) {
 761         do_sprintf(arg->arg_ptr.arg_str,32767,tmpary);
 762         retval = do_print(str_get(arg->arg_ptr.arg_str),fp);
 763     }
 764     else {
 765         retval = FALSE;
 766         for (elem = tmpary+1; *elem; elem++) {
 767             if (retval && ofs)
 768                 do_print(ofs, fp);
 769             if (ofmt && fp) {
 770                 if ((*elem)->str_nok || str_gnum(*elem) != 0.0)
 771                     fprintf(fp, ofmt, str_gnum(*elem));
 772                 retval = TRUE;
 773             }
 774             else
 775                 retval = do_print(str_get(*elem), fp);
 776             if (!retval)
 777                 break;
 778         }
 779         if (ors)
 780             retval = do_print(ors, fp);
 781     }
 782     safefree((char*)tmpary);
 783     return retval;
 784 }
 785
 786 bool
 787 do_aexec(arg)
 788 register ARG *arg;
 789 {
 790     STR **tmpary;       /* must not be register */
 791     register STR **elem;
 792     register char **a;
 793     register int i;
 794     char **argv;
 795
 796     (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
 797     i = 0;
 798     for (elem = tmpary+1; *elem; elem++)
 799         i++;
 800     if (i) {
 801         argv = (char**)safemalloc((i+1)*sizeof(char*));
 802         a = argv;
 803         for (elem = tmpary+1; *elem; elem++) {
 804             *a++ = str_get(*elem);
 805         }
 806         *a = Nullch;
 807         execvp(argv[0],argv);
 808         safefree((char*)argv);
 809     }
 810     safefree((char*)tmpary);
 811     return FALSE;
 812 }
 813
 814 bool
 815 do_exec(cmd)
 816 char *cmd;
 817 {
 818     STR **tmpary;       /* must not be register */
 819     register char **a;
 820     register char *s;
 821     char **argv;
 822
 823     /* see if there are shell metacharacters in it */
 824
 825     for (s = cmd; *s; s++) {
 826         if (*s != ' ' && !isalpha(*s) && index("$&*(){}[]'\";\\|?<>~`",*s)) {
 827             execl("/bin/sh","sh","-c",cmd,0);
 828             return FALSE;
 829         }
 830     }
 831     argv = (char**)safemalloc(((s - cmd) / 2 + 2)*sizeof(char*));
 832
 833     a = argv;
 834     for (s = cmd; *s;) {
 835         while (isspace(*s)) s++;
 836         if (*s)
 837             *(a++) = s;
 838         while (*s && !isspace(*s)) s++;
 839         if (*s)
 840             *s++ = '\0';
 841     }
 842     *a = Nullch;
 843     if (argv[0])
 844         execvp(argv[0],argv);
 845     safefree((char*)argv);
 846     return FALSE;
 847 }
 848
 849 STR *
 850 do_push(arg,ary)
 851 register ARG *arg;
 852 register ARRAY *ary;
 853 {
 854     STR **tmpary;       /* must not be register */
 855     register STR **elem;
 856     register STR *str = &str_no;
 857
 858     (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
 859     for (elem = tmpary+1; *elem; elem++) {
 860         str = str_new(0);
 861         str_sset(str,*elem);
 862         apush(ary,str);
 863     }
 864     safefree((char*)tmpary);
 865     return str;
 866 }
 867
 868 do_unshift(arg,ary)
 869 register ARG *arg;
 870 register ARRAY *ary;
 871 {
 872     STR **tmpary;       /* must not be register */
 873     register STR **elem;
 874     register STR *str = &str_no;
 875     register int i;
 876
 877     (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
 878     i = 0;
 879     for (elem = tmpary+1; *elem; elem++)
 880         i++;
 881     aunshift(ary,i);
 882     i = 0;
 883     for (elem = tmpary+1; *elem; elem++) {
 884         str = str_new(0);
 885         str_sset(str,*elem);
 886         astore(ary,i++,str);
 887     }
 888     safefree((char*)tmpary);
 889 }
 890
 891 apply(type,arg,sarg)
 892 int type;
 893 register ARG *arg;
 894 STR **sarg;
 895 {
 896     STR **tmpary;       /* must not be register */
 897     register STR **elem;
 898     register int i;
 899     register int val;
 900     register int val2;
 901
 902     if (sarg)
 903         tmpary = sarg;
 904     else
 905         (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
 906     i = 0;
 907     for (elem = tmpary+1; *elem; elem++)
 908         i++;
 909     switch (type) {
 910     case O_CHMOD:
 911         if (--i > 0) {
 912             val = (int)str_gnum(tmpary[1]);
 913             for (elem = tmpary+2; *elem; elem++)
 914                 if (chmod(str_get(*elem),val))
 915                     i--;
 916         }
 917         break;
 918     case O_CHOWN:
 919         if (i > 2) {
 920             i -= 2;
 921             val = (int)str_gnum(tmpary[1]);
 922             val2 = (int)str_gnum(tmpary[2]);
 923             for (elem = tmpary+3; *elem; elem++)
 924                 if (chown(str_get(*elem),val,val2))
 925                     i--;
 926         }
 927         else
 928             i = 0;
 929         break;
 930     case O_KILL:
 931         if (--i > 0) {
 932             val = (int)str_gnum(tmpary[1]);
 933             if (val < 0)
 934                 val = -val;
 935             for (elem = tmpary+2; *elem; elem++)
 936                 if (kill(atoi(str_get(*elem)),val))
 937                     i--;
 938         }
 939         break;
 940     case O_UNLINK:
 941         for (elem = tmpary+1; *elem; elem++)
 942             if (UNLINK(str_get(*elem)))
 943                 i--;
 944         break;
 945     }
 946     if (!sarg)
 947         safefree((char*)tmpary);
 948     return i;
 949 }
 950
 951 STR *
 952 do_subr(arg,sarg)
 953 register ARG *arg;
 954 register char **sarg;
 955 {
 956     ARRAY *savearray;
 957     STR *str;
 958
 959     savearray = defstab->stab_array;
 960     defstab->stab_array = anew();
 961     if (arg[1].arg_flags & AF_SPECIAL)
 962         (void)do_push(arg,defstab->stab_array);
 963     else if (arg[1].arg_type != A_NULL) {
 964         str = str_new(0);
 965         str_sset(str,sarg[1]);
 966         apush(defstab->stab_array,str);
 967     }
 968     str = cmd_exec(arg[2].arg_ptr.arg_stab->stab_sub);
 969     afree(defstab->stab_array);  /* put back old $_[] */
 970     defstab->stab_array = savearray;
 971     return str;
 972 }
 973
 974 void
 975 do_assign(retstr,arg)
 976 STR *retstr;
 977 register ARG *arg;
 978 {
 979     STR **tmpary;       /* must not be register */
 980     register ARG *larg = arg[1].arg_ptr.arg_arg;
 981     register STR **elem;
 982     register STR *str;
 983     register ARRAY *ary;
 984     register int i;
 985     register int lasti;
 986     char *s;
 987
 988     (void)eval(arg[2].arg_ptr.arg_arg,&tmpary);
 989
 990     if (arg->arg_flags & AF_COMMON) {
 991         if (*(tmpary+1)) {
 992             for (elem=tmpary+2; *elem; elem++) {
 993                 *elem = str_static(*elem);
 994             }
 995         }
 996     }
 997     if (larg->arg_type == O_LIST) {
 998         lasti = larg->arg_len;
 999         for (i=1,elem=tmpary+1; i <= lasti; i++) {
1000             if (*elem)
1001                 s = str_get(*(elem++));
1002             else
1003                 s = "";
1004             switch (larg[i].arg_type) {
1005             case A_STAB:
1006             case A_LVAL:
1007                 str = STAB_STR(larg[i].arg_ptr.arg_stab);
1008                 break;
1009             case A_LEXPR:
1010                 str = eval(larg[i].arg_ptr.arg_arg,Null(STR***));
1011                 break;
1012             }
1013             str_set(str,s);
1014             STABSET(str);
1015         }
1016         i = elem - tmpary - 1;
1017     }
1018     else {                      /* should be an array name */
1019         ary = larg[1].arg_ptr.arg_stab->stab_array;
1020         for (i=0,elem=tmpary+1; *elem; i++) {
1021             str = str_new(0);
1022             if (*elem)
1023                 str_sset(str,*(elem++));
1024             astore(ary,i,str);
1025         }
1026         ary->ary_fill = i - 1;  /* they can get the extra ones back by */
1027     }                           /*   setting an element larger than old fill */
1028     str_numset(retstr,(double)i);
1029     STABSET(retstr);
1030     safefree((char*)tmpary);
1031 }
1032
1033 int
1034 do_kv(hash,kv,sarg,retary)
1035 HASH *hash;
1036 int kv;
1037 register STR **sarg;
1038 STR ***retary;
1039 {
1040     register ARRAY *ary;
1041     int max = 0;
1042     int i;
1043     static ARRAY *myarray = Null(ARRAY*);
1044     register HENT *entry;
1045
1046     ary = myarray;
1047     if (!ary)
1048         myarray = ary = anew();
1049     ary->ary_fill = -1;
1050
1051     hiterinit(hash);
1052     while (entry = hiternext(hash)) {
1053         max++;
1054         if (kv == O_KEYS)
1055             apush(ary,str_make(hiterkey(entry)));
1056         else
1057             apush(ary,str_make(str_get(hiterval(entry))));
1058     }
1059     if (retary) { /* array wanted */
1060         sarg = (STR**)saferealloc((char*)sarg,(max+2)*sizeof(STR*));
1061         sarg[0] = Nullstr;
1062         sarg[max+1] = Nullstr;
1063         for (i = 1; i <= max; i++)
1064             sarg[i] = afetch(ary,i-1);
1065         *retary = sarg;
1066     }
1067     return max;
1068 }
1069
1070 STR *
1071 do_each(hash,sarg,retary)
1072 HASH *hash;
1073 register STR **sarg;
1074 STR ***retary;
1075 {
1076     static STR *mystr = Nullstr;
1077     STR *retstr;
1078     HENT *entry = hiternext(hash);
1079
1080     if (mystr) {
1081         str_free(mystr);
1082         mystr = Nullstr;
1083     }
1084
1085     if (retary) { /* array wanted */
1086         if (entry) {
1087             sarg = (STR**)saferealloc((char*)sarg,4*sizeof(STR*));
1088             sarg[0] = Nullstr;
1089             sarg[3] = Nullstr;
1090             sarg[1] = mystr = str_make(hiterkey(entry));
1091             retstr = sarg[2] = hiterval(entry);
1092             *retary = sarg;
1093         }
1094         else {
1095             sarg = (STR**)saferealloc((char*)sarg,2*sizeof(STR*));
1096             sarg[0] = Nullstr;
1097             sarg[1] = retstr = Nullstr;
1098             *retary = sarg;
1099         }
1100     }
1101     else
1102         retstr = hiterval(entry);
1103
1104     return retstr;
1105 }
1106
1107 init_eval()
1108 {
1109     register int i;
1110
1111 #define A(e1,e2,e3) (e1+(e2<<1)+(e3<<2))
1112     opargs[O_ITEM] =            A(1,0,0);
1113     opargs[O_ITEM2] =           A(0,0,0);
1114     opargs[O_ITEM3] =           A(0,0,0);
1115     opargs[O_CONCAT] =          A(1,1,0);
1116     opargs[O_MATCH] =           A(1,0,0);
1117     opargs[O_NMATCH] =          A(1,0,0);
1118     opargs[O_SUBST] =           A(1,0,0);
1119     opargs[O_NSUBST] =          A(1,0,0);
1120     opargs[O_ASSIGN] =          A(1,1,0);
1121     opargs[O_MULTIPLY] =        A(1,1,0);
1122     opargs[O_DIVIDE] =          A(1,1,0);
1123     opargs[O_MODULO] =          A(1,1,0);
1124     opargs[O_ADD] =             A(1,1,0);
1125     opargs[O_SUBTRACT] =        A(1,1,0);
1126     opargs[O_LEFT_SHIFT] =      A(1,1,0);
1127     opargs[O_RIGHT_SHIFT] =     A(1,1,0);
1128     opargs[O_LT] =              A(1,1,0);
1129     opargs[O_GT] =              A(1,1,0);
1130     opargs[O_LE] =              A(1,1,0);
1131     opargs[O_GE] =              A(1,1,0);
1132     opargs[O_EQ] =              A(1,1,0);
1133     opargs[O_NE] =              A(1,1,0);
1134     opargs[O_BIT_AND] =         A(1,1,0);
1135     opargs[O_XOR] =             A(1,1,0);
1136     opargs[O_BIT_OR] =          A(1,1,0);
1137     opargs[O_AND] =             A(1,0,0);       /* don't eval arg 2 (yet) */
1138     opargs[O_OR] =              A(1,0,0);       /* don't eval arg 2 (yet) */
1139     opargs[O_COND_EXPR] =       A(1,0,0);       /* don't eval args 2 or 3 */
1140     opargs[O_COMMA] =           A(1,1,0);
1141     opargs[O_NEGATE] =          A(1,0,0);
1142     opargs[O_NOT] =             A(1,0,0);
1143     opargs[O_COMPLEMENT] =      A(1,0,0);
1144     opargs[O_WRITE] =           A(1,0,0);
1145     opargs[O_OPEN] =            A(1,1,0);
1146     opargs[O_TRANS] =           A(1,0,0);
1147     opargs[O_NTRANS] =          A(1,0,0);
1148     opargs[O_CLOSE] =           A(0,0,0);
1149     opargs[O_ARRAY] =           A(1,0,0);
1150     opargs[O_HASH] =            A(1,0,0);
1151     opargs[O_LARRAY] =          A(1,0,0);
1152     opargs[O_LHASH] =           A(1,0,0);
1153     opargs[O_PUSH] =            A(1,0,0);
1154     opargs[O_POP] =             A(0,0,0);
1155     opargs[O_SHIFT] =           A(0,0,0);
1156     opargs[O_SPLIT] =           A(1,0,0);
1157     opargs[O_LENGTH] =          A(1,0,0);
1158     opargs[O_SPRINTF] =         A(1,0,0);
1159     opargs[O_SUBSTR] =          A(1,1,1);
1160     opargs[O_JOIN] =            A(1,0,0);
1161     opargs[O_SLT] =             A(1,1,0);
1162     opargs[O_SGT] =             A(1,1,0);
1163     opargs[O_SLE] =             A(1,1,0);
1164     opargs[O_SGE] =             A(1,1,0);
1165     opargs[O_SEQ] =             A(1,1,0);
1166     opargs[O_SNE] =             A(1,1,0);
1167     opargs[O_SUBR] =            A(1,0,0);
1168     opargs[O_PRINT] =           A(1,0,0);
1169     opargs[O_CHDIR] =           A(1,0,0);
1170     opargs[O_DIE] =             A(1,0,0);
1171     opargs[O_EXIT] =            A(1,0,0);
1172     opargs[O_RESET] =           A(1,0,0);
1173     opargs[O_LIST] =            A(0,0,0);
1174     opargs[O_EOF] =             A(0,0,0);
1175     opargs[O_TELL] =            A(0,0,0);
1176     opargs[O_SEEK] =            A(0,1,1);
1177     opargs[O_LAST] =            A(1,0,0);
1178     opargs[O_NEXT] =            A(1,0,0);
1179     opargs[O_REDO] =            A(1,0,0);
1180     opargs[O_GOTO] =            A(1,0,0);
1181     opargs[O_INDEX] =           A(1,1,0);
1182     opargs[O_TIME] =            A(0,0,0);
1183     opargs[O_TMS] =             A(0,0,0);
1184     opargs[O_LOCALTIME] =       A(1,0,0);
1185     opargs[O_GMTIME] =          A(1,0,0);
1186     opargs[O_STAT] =            A(1,0,0);
1187     opargs[O_CRYPT] =           A(1,1,0);
1188     opargs[O_EXP] =             A(1,0,0);
1189     opargs[O_LOG] =             A(1,0,0);
1190     opargs[O_SQRT] =            A(1,0,0);
1191     opargs[O_INT] =             A(1,0,0);
1192     opargs[O_PRTF] =            A(1,0,0);
1193     opargs[O_ORD] =             A(1,0,0);
1194     opargs[O_SLEEP] =           A(1,0,0);
1195     opargs[O_FLIP] =            A(1,0,0);
1196     opargs[O_FLOP] =            A(0,1,0);
1197     opargs[O_KEYS] =            A(0,0,0);
1198     opargs[O_VALUES] =          A(0,0,0);
1199     opargs[O_EACH] =            A(0,0,0);
1200     opargs[O_CHOP] =            A(1,0,0);
1201     opargs[O_FORK] =            A(1,0,0);
1202     opargs[O_EXEC] =            A(1,0,0);
1203     opargs[O_SYSTEM] =          A(1,0,0);
1204     opargs[O_OCT] =             A(1,0,0);
1205     opargs[O_HEX] =             A(1,0,0);
1206     opargs[O_CHMOD] =           A(1,0,0);
1207     opargs[O_CHOWN] =           A(1,0,0);
1208     opargs[O_KILL] =            A(1,0,0);
1209     opargs[O_RENAME] =          A(1,1,0);
1210     opargs[O_UNLINK] =          A(1,0,0);
1211     opargs[O_UMASK] =           A(1,0,0);
1212     opargs[O_UNSHIFT] =         A(1,0,0);
1213     opargs[O_LINK] =            A(1,1,0);
1214     opargs[O_REPEAT] =          A(1,1,0);
1215     opargs[O_EVAL] =            A(1,0,0);
1216 }
1217
1218 #ifdef VOIDSIG
1219 static void (*ihand)();
1220 static void (*qhand)();
1221 #else
1222 static int (*ihand)();
1223 static int (*qhand)();
1224 #endif
1225
1226 STR *
1227 eval(arg,retary)
1228 register ARG *arg;
1229 STR ***retary;          /* where to return an array to, null if nowhere */
1230 {
1231     register STR *str;
1232     register int anum;
1233     register int optype;
1234     register int maxarg;
1235     double value;
1236     STR *quicksarg[5];
1237     register STR **sarg = quicksarg;
1238     register char *tmps;
1239     char *tmps2;
1240     int argflags;
1241     long tmplong;
1242     FILE *fp;
1243     STR *tmpstr;
1244     FCMD *form;
1245     STAB *stab;
1246     ARRAY *ary;
1247     bool assigning = FALSE;
1248     double exp(), log(), sqrt(), modf();
1249     char *crypt(), *getenv();
1250
1251     if (!arg)
1252         return &str_no;
1253     str = arg->arg_ptr.arg_str;
1254     optype = arg->arg_type;
1255     maxarg = arg->arg_len;
1256     if (maxarg > 3 || retary) {
1257         sarg = (STR **)safemalloc((maxarg+2) * sizeof(STR*));
1258     }
1259 #ifdef DEBUGGING
1260     if (debug & 8) {
1261         deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
1262     }
1263     debname[dlevel] = opname[optype][0];
1264     debdelim[dlevel++] = ':';
1265 #endif
1266     for (anum = 1; anum <= maxarg; anum++) {
1267         argflags = arg[anum].arg_flags;
1268         if (argflags & AF_SPECIAL)
1269             continue;
1270       re_eval:
1271         switch (arg[anum].arg_type) {
1272         default:
1273             sarg[anum] = &str_no;
1274 #ifdef DEBUGGING
1275             tmps = "NULL";
1276 #endif
1277             break;
1278         case A_EXPR:
1279 #ifdef DEBUGGING
1280             if (debug & 8) {
1281                 tmps = "EXPR";
1282                 deb("%d.EXPR =>\n",anum);
1283             }
1284 #endif
1285             sarg[anum] = eval(arg[anum].arg_ptr.arg_arg, Null(STR***));
1286             break;
1287         case A_CMD:
1288 #ifdef DEBUGGING
1289             if (debug & 8) {
1290                 tmps = "CMD";
1291                 deb("%d.CMD (%lx) =>\n",anum,arg[anum].arg_ptr.arg_cmd);
1292             }
1293 #endif
1294             sarg[anum] = cmd_exec(arg[anum].arg_ptr.arg_cmd);
1295             break;
1296         case A_STAB:
1297             sarg[anum] = STAB_STR(arg[anum].arg_ptr.arg_stab);
1298 #ifdef DEBUGGING
1299             if (debug & 8) {
1300                 sprintf(buf,"STAB $%s ==",arg[anum].arg_ptr.arg_stab->stab_name);
1301                 tmps = buf;
1302             }
1303 #endif
1304             break;
1305         case A_LEXPR:
1306 #ifdef DEBUGGING
1307             if (debug & 8) {
1308                 tmps = "LEXPR";
1309                 deb("%d.LEXPR =>\n",anum);
1310             }
1311 #endif
1312             str = eval(arg[anum].arg_ptr.arg_arg,Null(STR***));
1313             if (!str)
1314                 fatal("panic: A_LEXPR\n");
1315             goto do_crement;
1316         case A_LVAL:
1317 #ifdef DEBUGGING
1318             if (debug & 8) {
1319                 sprintf(buf,"LVAL $%s ==",arg[anum].arg_ptr.arg_stab->stab_name);
1320                 tmps = buf;
1321             }
1322 #endif
1323             str = STAB_STR(arg[anum].arg_ptr.arg_stab);
1324             if (!str)
1325                 fatal("panic: A_LVAL\n");
1326           do_crement:
1327             assigning = TRUE;
1328             if (argflags & AF_PRE) {
1329                 if (argflags & AF_UP)
1330                     str_inc(str);
1331                 else
1332                     str_dec(str);
1333                 STABSET(str);
1334                 sarg[anum] = str;
1335                 str = arg->arg_ptr.arg_str;
1336             }
1337             else if (argflags & AF_POST) {
1338                 sarg[anum] = str_static(str);
1339                 if (argflags & AF_UP)
1340                     str_inc(str);
1341                 else
1342                     str_dec(str);
1343                 STABSET(str);
1344                 str = arg->arg_ptr.arg_str;
1345             }
1346             else {
1347                 sarg[anum] = str;
1348             }
1349             break;
1350         case A_ARYLEN:
1351             sarg[anum] = str_static(&str_no);
1352             str_numset(sarg[anum],
1353                 (double)alen(arg[anum].arg_ptr.arg_stab->stab_array));
1354 #ifdef DEBUGGING
1355             tmps = "ARYLEN";
1356 #endif
1357             break;
1358         case A_SINGLE:
1359             sarg[anum] = arg[anum].arg_ptr.arg_str;
1360 #ifdef DEBUGGING
1361             tmps = "SINGLE";
1362 #endif
1363             break;
1364         case A_DOUBLE:
1365             (void) interp(str,str_get(arg[anum].arg_ptr.arg_str));
1366             sarg[anum] = str;
1367 #ifdef DEBUGGING
1368             tmps = "DOUBLE";
1369 #endif
1370             break;
1371         case A_BACKTICK:
1372             tmps = str_get(arg[anum].arg_ptr.arg_str);
1373             fp = popen(str_get(interp(str,tmps)),"r");
1374             tmpstr = str_new(80);
1375             str_set(str,"");
1376             if (fp) {
1377                 while (str_gets(tmpstr,fp) != Nullch) {
1378                     str_scat(str,tmpstr);
1379                 }
1380                 statusvalue = pclose(fp);
1381             }
1382             else
1383                 statusvalue = -1;
1384             str_free(tmpstr);
1385
1386             sarg[anum] = str;
1387 #ifdef DEBUGGING
1388             tmps = "BACK";
1389 #endif
1390             break;
1391         case A_READ:
1392             fp = Nullfp;
1393             last_in_stab = arg[anum].arg_ptr.arg_stab;
1394             if (last_in_stab->stab_io) {
1395                 fp = last_in_stab->stab_io->fp;
1396                 if (!fp && (last_in_stab->stab_io->flags & IOF_ARGV)) {
1397                     if (last_in_stab->stab_io->flags & IOF_START) {
1398                         last_in_stab->stab_io->flags &= ~IOF_START;
1399                         last_in_stab->stab_io->lines = 0;
1400                         if (alen(last_in_stab->stab_array) < 0L) {
1401                             tmpstr = str_make("-");     /* assume stdin */
1402                             apush(last_in_stab->stab_array, tmpstr);
1403                         }
1404                     }
1405                     fp = nextargv(last_in_stab);
1406                     if (!fp)    /* Note: fp != last_in_stab->stab_io->fp */
1407                         do_close(last_in_stab,FALSE);   /* now it does */
1408                 }
1409             }
1410           keepgoing:
1411             if (!fp)
1412                 sarg[anum] = &str_no;
1413             else if (!str_gets(str,fp)) {
1414                 if (last_in_stab->stab_io->flags & IOF_ARGV) {
1415                     fp = nextargv(last_in_stab);
1416                     if (fp)
1417                         goto keepgoing;
1418                     do_close(last_in_stab,FALSE);
1419                     last_in_stab->stab_io->flags |= IOF_START;
1420                 }
1421                 if (fp == stdin) {
1422                     clearerr(fp);
1423                 }
1424                 sarg[anum] = &str_no;
1425                 break;
1426             }
1427             else {
1428                 last_in_stab->stab_io->lines++;
1429                 sarg[anum] = str;
1430             }
1431 #ifdef DEBUGGING
1432             tmps = "READ";
1433 #endif
1434             break;
1435         }
1436 #ifdef DEBUGGING
1437         if (debug & 8)
1438             deb("%d.%s = '%s'\n",anum,tmps,str_peek(sarg[anum]));
1439 #endif
1440     }
1441     switch (optype) {
1442     case O_ITEM:
1443         if (str != sarg[1])
1444             str_sset(str,sarg[1]);
1445         STABSET(str);
1446         break;
1447     case O_ITEM2:
1448         if (str != sarg[2])
1449             str_sset(str,sarg[2]);
1450         STABSET(str);
1451         break;
1452     case O_ITEM3:
1453         if (str != sarg[3])
1454             str_sset(str,sarg[3]);
1455         STABSET(str);
1456         break;
1457     case O_CONCAT:
1458         if (str != sarg[1])
1459             str_sset(str,sarg[1]);
1460         str_scat(str,sarg[2]);
1461         STABSET(str);
1462         break;
1463     case O_REPEAT:
1464         if (str != sarg[1])
1465             str_sset(str,sarg[1]);
1466         anum = (long)str_gnum(sarg[2]);
1467         if (anum >= 1) {
1468             tmpstr = str_new(0);
1469             str_sset(tmpstr,str);
1470             for (anum--; anum; anum--)
1471                 str_scat(str,tmpstr);
1472         }
1473         else
1474             str_sset(str,&str_no);
1475         STABSET(str);
1476         break;
1477     case O_MATCH:
1478         str_set(str, do_match(str_get(sarg[1]),arg) ? Yes : No);
1479         STABSET(str);
1480         break;
1481     case O_NMATCH:
1482         str_set(str, do_match(str_get(sarg[1]),arg) ? No : Yes);
1483         STABSET(str);
1484         break;
1485     case O_SUBST:
1486         value = (double) do_subst(str, arg);
1487         str = arg->arg_ptr.arg_str;
1488         goto donumset;
1489     case O_NSUBST:
1490         str_set(arg->arg_ptr.arg_str, do_subst(str, arg) ? No : Yes);
1491         str = arg->arg_ptr.arg_str;
1492         break;
1493     case O_ASSIGN:
1494         if (arg[2].arg_flags & AF_SPECIAL)
1495             do_assign(str,arg);
1496         else {
1497             if (str != sarg[2])
1498                 str_sset(str, sarg[2]);
1499             STABSET(str);
1500         }
1501         break;
1502     case O_CHOP:
1503         tmps = str_get(str);
1504         tmps += str->str_cur - (str->str_cur != 0);
1505         str_set(arg->arg_ptr.arg_str,tmps);     /* remember last char */
1506         *tmps = '\0';                           /* wipe it out */
1507         str->str_cur = tmps - str->str_ptr;
1508         str->str_nok = 0;
1509         str = arg->arg_ptr.arg_str;
1510         break;
1511     case O_MULTIPLY:
1512         value = str_gnum(sarg[1]);
1513         value *= str_gnum(sarg[2]);
1514         goto donumset;
1515     case O_DIVIDE:
1516         value = str_gnum(sarg[1]);
1517         value /= str_gnum(sarg[2]);
1518         goto donumset;
1519     case O_MODULO:
1520         value = str_gnum(sarg[1]);
1521         value = (double)(((long)value) % (long)str_gnum(sarg[2]));
1522         goto donumset;
1523     case O_ADD:
1524         value = str_gnum(sarg[1]);
1525         value += str_gnum(sarg[2]);
1526         goto donumset;
1527     case O_SUBTRACT:
1528         value = str_gnum(sarg[1]);
1529         value -= str_gnum(sarg[2]);
1530         goto donumset;
1531     case O_LEFT_SHIFT:
1532         value = str_gnum(sarg[1]);
1533         value = (double)(((long)value) << (long)str_gnum(sarg[2]));
1534         goto donumset;
1535     case O_RIGHT_SHIFT:
1536         value = str_gnum(sarg[1]);
1537         value = (double)(((long)value) >> (long)str_gnum(sarg[2]));
1538         goto donumset;
1539     case O_LT:
1540         value = str_gnum(sarg[1]);
1541         value = (double)(value < str_gnum(sarg[2]));
1542         goto donumset;
1543     case O_GT:
1544         value = str_gnum(sarg[1]);
1545         value = (double)(value > str_gnum(sarg[2]));
1546         goto donumset;
1547     case O_LE:
1548         value = str_gnum(sarg[1]);
1549         value = (double)(value <= str_gnum(sarg[2]));
1550         goto donumset;
1551     case O_GE:
1552         value = str_gnum(sarg[1]);
1553         value = (double)(value >= str_gnum(sarg[2]));
1554         goto donumset;
1555     case O_EQ:
1556         value = str_gnum(sarg[1]);
1557         value = (double)(value == str_gnum(sarg[2]));
1558         goto donumset;
1559     case O_NE:
1560         value = str_gnum(sarg[1]);
1561         value = (double)(value != str_gnum(sarg[2]));
1562         goto donumset;
1563     case O_BIT_AND:
1564         value = str_gnum(sarg[1]);
1565         value = (double)(((long)value) & (long)str_gnum(sarg[2]));
1566         goto donumset;
1567     case O_XOR:
1568         value = str_gnum(sarg[1]);
1569         value = (double)(((long)value) ^ (long)str_gnum(sarg[2]));
1570         goto donumset;
1571     case O_BIT_OR:
1572         value = str_gnum(sarg[1]);
1573         value = (double)(((long)value) | (long)str_gnum(sarg[2]));
1574         goto donumset;
1575     case O_AND:
1576         if (str_true(sarg[1])) {
1577             anum = 2;
1578             optype = O_ITEM2;
1579             maxarg = 0;
1580             argflags = arg[anum].arg_flags;
1581             goto re_eval;
1582         }
1583         else {
1584             if (assigning) {
1585                 str_sset(str, sarg[1]);
1586                 STABSET(str);
1587             }
1588             else
1589                 str = sarg[1];
1590             break;
1591         }
1592     case O_OR:
1593         if (str_true(sarg[1])) {
1594             if (assigning) {
1595                 str_set(str, sarg[1]);
1596                 STABSET(str);
1597             }
1598             else
1599                 str = sarg[1];
1600             break;
1601         }
1602         else {
1603             anum = 2;
1604             optype = O_ITEM2;
1605             maxarg = 0;
1606             argflags = arg[anum].arg_flags;
1607             goto re_eval;
1608         }
1609     case O_COND_EXPR:
1610         anum = (str_true(sarg[1]) ? 2 : 3);
1611         optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
1612         maxarg = 0;
1613         argflags = arg[anum].arg_flags;
1614         goto re_eval;
1615     case O_COMMA:
1616         str = sarg[2];
1617         break;
1618     case O_NEGATE:
1619         value = -str_gnum(sarg[1]);
1620         goto donumset;
1621     case O_NOT:
1622         value = (double) !str_true(sarg[1]);
1623         goto donumset;
1624     case O_COMPLEMENT:
1625         value = (double) ~(long)str_gnum(sarg[1]);
1626         goto donumset;
1627     case O_SELECT:
1628         if (arg[1].arg_type == A_LVAL)
1629             defoutstab = arg[1].arg_ptr.arg_stab;
1630         else
1631             defoutstab = stabent(str_get(sarg[1]),TRUE);
1632         if (!defoutstab->stab_io)
1633             defoutstab->stab_io = stio_new();
1634         curoutstab = defoutstab;
1635         str_set(str,curoutstab->stab_io->fp ? Yes : No);
1636         STABSET(str);
1637         break;
1638     case O_WRITE:
1639         if (maxarg == 0)
1640             stab = defoutstab;
1641         else if (arg[1].arg_type == A_LVAL)
1642             stab = arg[1].arg_ptr.arg_stab;
1643         else
1644             stab = stabent(str_get(sarg[1]),TRUE);
1645         if (!stab->stab_io) {
1646             str_set(str, No);
1647             STABSET(str);
1648             break;
1649         }
1650         curoutstab = stab;
1651         fp = stab->stab_io->fp;
1652         debarg = arg;
1653         if (stab->stab_io->fmt_stab)
1654             form = stab->stab_io->fmt_stab->stab_form;
1655         else
1656             form = stab->stab_form;
1657         if (!form || !fp) {
1658             str_set(str, No);
1659             STABSET(str);
1660             break;
1661         }
1662         format(&outrec,form);
1663         do_write(&outrec,stab->stab_io);
1664         if (stab->stab_io->flags & IOF_FLUSH)
1665             fflush(fp);
1666         str_set(str, Yes);
1667         STABSET(str);
1668         break;
1669     case O_OPEN:
1670         if (do_open(arg[1].arg_ptr.arg_stab,str_get(sarg[2]))) {
1671             str_set(str, Yes);
1672             arg[1].arg_ptr.arg_stab->stab_io->lines = 0;
1673         }
1674         else
1675             str_set(str, No);
1676         STABSET(str);
1677         break;
1678     case O_TRANS:
1679         value = (double) do_trans(str,arg);
1680         str = arg->arg_ptr.arg_str;
1681         goto donumset;
1682     case O_NTRANS:
1683         str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
1684         str = arg->arg_ptr.arg_str;
1685         break;
1686     case O_CLOSE:
1687         str_set(str,
1688             do_close(arg[1].arg_ptr.arg_stab,TRUE) ? Yes : No );
1689         STABSET(str);
1690         break;
1691     case O_EACH:
1692         str_sset(str,do_each(arg[1].arg_ptr.arg_stab->stab_hash,sarg,retary));
1693         retary = Null(STR***);          /* do_each already did retary */
1694         STABSET(str);
1695         break;
1696     case O_VALUES:
1697     case O_KEYS:
1698         value = (double) do_kv(arg[1].arg_ptr.arg_stab->stab_hash,
1699           optype,sarg,retary);
1700         retary = Null(STR***);          /* do_keys already did retary */
1701         goto donumset;
1702     case O_ARRAY:
1703         if (maxarg == 1) {
1704             ary = arg[1].arg_ptr.arg_stab->stab_array;
1705             maxarg = ary->ary_fill;
1706             if (retary) { /* array wanted */
1707                 sarg =
1708                   (STR **)saferealloc((char*)sarg,(maxarg+3)*sizeof(STR*));
1709                 for (anum = 0; anum <= maxarg; anum++) {
1710                     sarg[anum+1] = str = afetch(ary,anum);
1711                 }
1712                 maxarg++;
1713             }
1714             else
1715                 str = afetch(ary,maxarg);
1716         }
1717         else
1718             str = afetch(arg[2].arg_ptr.arg_stab->stab_array,
1719                 ((int)str_gnum(sarg[1])) - arybase);
1720         if (!str)
1721             return &str_no;
1722         break;
1723     case O_HASH:
1724         tmpstab = arg[2].arg_ptr.arg_stab;              /* XXX */
1725         str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
1726         if (!str)
1727             return &str_no;
1728         break;
1729     case O_LARRAY:
1730         anum = ((int)str_gnum(sarg[1])) - arybase;
1731         str = afetch(arg[2].arg_ptr.arg_stab->stab_array,anum);
1732         if (!str || str == &str_no) {
1733             str = str_new(0);
1734             astore(arg[2].arg_ptr.arg_stab->stab_array,anum,str);
1735         }
1736         break;
1737     case O_LHASH:
1738         tmpstab = arg[2].arg_ptr.arg_stab;
1739         str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
1740         if (!str) {
1741             str = str_new(0);
1742             hstore(tmpstab->stab_hash,str_get(sarg[1]),str);
1743         }
1744         if (tmpstab == envstab) {       /* heavy wizardry going on here */
1745             str->str_link.str_magic = tmpstab;/* str is now magic */
1746             envname = savestr(str_get(sarg[1]));
1747                                         /* he threw the brick up into the air */
1748         }
1749         else if (tmpstab == sigstab) {  /* same thing, only different */
1750             str->str_link.str_magic = tmpstab;
1751             signame = savestr(str_get(sarg[1]));
1752         }
1753         break;
1754     case O_PUSH:
1755         if (arg[1].arg_flags & AF_SPECIAL)
1756             str = do_push(arg,arg[2].arg_ptr.arg_stab->stab_array);
1757         else {
1758             str = str_new(0);           /* must copy the STR */
1759             str_sset(str,sarg[1]);
1760             apush(arg[2].arg_ptr.arg_stab->stab_array,str);
1761         }
1762         break;
1763     case O_POP:
1764         str = apop(arg[1].arg_ptr.arg_stab->stab_array);
1765         if (!str)
1766             return &str_no;
1767 #ifdef STRUCTCOPY
1768         *(arg->arg_ptr.arg_str) = *str;
1769 #else
1770         bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
1771 #endif
1772         safefree((char*)str);
1773         str = arg->arg_ptr.arg_str;
1774         break;
1775     case O_SHIFT:
1776         str = ashift(arg[1].arg_ptr.arg_stab->stab_array);
1777         if (!str)
1778             return &str_no;
1779 #ifdef STRUCTCOPY
1780         *(arg->arg_ptr.arg_str) = *str;
1781 #else
1782         bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
1783 #endif
1784         safefree((char*)str);
1785         str = arg->arg_ptr.arg_str;
1786         break;
1787     case O_SPLIT:
1788         value = (double) do_split(str_get(sarg[1]),arg[2].arg_ptr.arg_spat,retary);
1789         retary = Null(STR***);          /* do_split already did retary */
1790         goto donumset;
1791     case O_LENGTH:
1792         value = (double) str_len(sarg[1]);
1793         goto donumset;
1794     case O_SPRINTF:
1795         sarg[maxarg+1] = Nullstr;
1796         do_sprintf(str,arg->arg_len,sarg);
1797         break;
1798     case O_SUBSTR:
1799         anum = ((int)str_gnum(sarg[2])) - arybase;
1800         for (tmps = str_get(sarg[1]); *tmps && anum > 0; tmps++,anum--) ;
1801         anum = (int)str_gnum(sarg[3]);
1802         if (anum >= 0 && strlen(tmps) > anum)
1803             str_nset(str, tmps, anum);
1804         else
1805             str_set(str, tmps);
1806         break;
1807     case O_JOIN:
1808         if (arg[2].arg_flags & AF_SPECIAL && arg[2].arg_type == A_EXPR)
1809             do_join(arg,str_get(sarg[1]),str);
1810         else
1811             ajoin(arg[2].arg_ptr.arg_stab->stab_array,str_get(sarg[1]),str);
1812         break;
1813     case O_SLT:
1814         tmps = str_get(sarg[1]);
1815         value = (double) strLT(tmps,str_get(sarg[2]));
1816         goto donumset;
1817     case O_SGT:
1818         tmps = str_get(sarg[1]);
1819         value = (double) strGT(tmps,str_get(sarg[2]));
1820         goto donumset;
1821     case O_SLE:
1822         tmps = str_get(sarg[1]);
1823         value = (double) strLE(tmps,str_get(sarg[2]));
1824         goto donumset;
1825     case O_SGE:
1826         tmps = str_get(sarg[1]);
1827         value = (double) strGE(tmps,str_get(sarg[2]));
1828         goto donumset;
1829     case O_SEQ:
1830         tmps = str_get(sarg[1]);
1831         value = (double) strEQ(tmps,str_get(sarg[2]));
1832         goto donumset;
1833     case O_SNE:
1834         tmps = str_get(sarg[1]);
1835         value = (double) strNE(tmps,str_get(sarg[2]));
1836         goto donumset;
1837     case O_SUBR:
1838         str_sset(str,do_subr(arg,sarg));
1839         STABSET(str);
1840         break;
1841     case O_PRTF:
1842     case O_PRINT:
1843         if (maxarg <= 1)
1844             stab = defoutstab;
1845         else {
1846             stab = arg[2].arg_ptr.arg_stab;
1847             if (!stab)
1848                 stab = defoutstab;
1849         }
1850         if (!stab->stab_io)
1851             value = 0.0;
1852         else if (arg[1].arg_flags & AF_SPECIAL)
1853             value = (double)do_aprint(arg,stab->stab_io->fp);
1854         else {
1855             value = (double)do_print(str_get(sarg[1]),stab->stab_io->fp);
1856             if (ors && optype == O_PRINT)
1857                 do_print(ors, stab->stab_io->fp);
1858         }
1859         if (stab->stab_io->flags & IOF_FLUSH)
1860             fflush(stab->stab_io->fp);
1861         goto donumset;
1862     case O_CHDIR:
1863         tmps = str_get(sarg[1]);
1864         if (!tmps || !*tmps)
1865             tmps = getenv("HOME");
1866         if (!tmps || !*tmps)
1867             tmps = getenv("LOGDIR");
1868         value = (double)(chdir(tmps) >= 0);
1869         goto donumset;
1870     case O_DIE:
1871         tmps = str_get(sarg[1]);
1872         if (!tmps || !*tmps)
1873             exit(1);
1874         fatal("%s\n",str_get(sarg[1]));
1875         value = 0.0;
1876         goto donumset;
1877     case O_EXIT:
1878         exit((int)str_gnum(sarg[1]));
1879         value = 0.0;
1880         goto donumset;
1881     case O_RESET:
1882         str_reset(str_get(sarg[1]));
1883         value = 1.0;
1884         goto donumset;
1885     case O_LIST:
1886         if (maxarg > 0)
1887             str = sarg[maxarg]; /* unwanted list, return last item */
1888         else
1889             str = &str_no;
1890         break;
1891     case O_EOF:
1892         str_set(str, do_eof(maxarg > 0 ? arg[1].arg_ptr.arg_stab : last_in_stab) ? Yes : No);
1893         STABSET(str);
1894         break;
1895     case O_TELL:
1896         value = (double)do_tell(maxarg > 0 ? arg[1].arg_ptr.arg_stab : last_in_stab);
1897         goto donumset;
1898         break;
1899     case O_SEEK:
1900         value = str_gnum(sarg[2]);
1901         str_set(str, do_seek(arg[1].arg_ptr.arg_stab,
1902           (long)value, (int)str_gnum(sarg[3]) ) ? Yes : No);
1903         STABSET(str);
1904         break;
1905     case O_REDO:
1906     case O_NEXT:
1907     case O_LAST:
1908         if (maxarg > 0) {
1909             tmps = str_get(sarg[1]);
1910             while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
1911               strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
1912 #ifdef DEBUGGING
1913                 if (debug & 4) {
1914                     deb("(Skipping label #%d %s)\n",loop_ptr,
1915                         loop_stack[loop_ptr].loop_label);
1916                 }
1917 #endif
1918                 loop_ptr--;
1919             }
1920 #ifdef DEBUGGING
1921             if (debug & 4) {
1922                 deb("(Found label #%d %s)\n",loop_ptr,
1923                     loop_stack[loop_ptr].loop_label);
1924             }
1925 #endif
1926         }
1927         if (loop_ptr < 0)
1928             fatal("Bad label: %s\n", maxarg > 0 ? tmps : "<null>");
1929         longjmp(loop_stack[loop_ptr].loop_env, optype);
1930     case O_GOTO:/* shudder */
1931         goto_targ = str_get(sarg[1]);
1932         longjmp(top_env, 1);
1933     case O_INDEX:
1934         tmps = str_get(sarg[1]);
1935         if (!(tmps2 = instr(tmps,str_get(sarg[2]))))
1936             value = (double)(-1 + arybase);
1937         else
1938             value = (double)(tmps2 - tmps + arybase);
1939         goto donumset;
1940     case O_TIME:
1941         value = (double) time(0);
1942         goto donumset;
1943     case O_TMS:
1944         value = (double) do_tms(retary);
1945         retary = Null(STR***);          /* do_tms already did retary */
1946         goto donumset;
1947     case O_LOCALTIME:
1948         tmplong = (long) str_gnum(sarg[1]);
1949         value = (double) do_time(localtime(&tmplong),retary);
1950         retary = Null(STR***);          /* do_localtime already did retary */
1951         goto donumset;
1952     case O_GMTIME:
1953         tmplong = (long) str_gnum(sarg[1]);
1954         value = (double) do_time(gmtime(&tmplong),retary);
1955         retary = Null(STR***);          /* do_gmtime already did retary */
1956         goto donumset;
1957     case O_STAT:
1958         value = (double) do_stat(arg,sarg,retary);
1959         retary = Null(STR***);          /* do_stat already did retary */
1960         goto donumset;
1961     case O_CRYPT:
1962 #ifdef CRYPT
1963         tmps = str_get(sarg[1]);
1964         str_set(str,crypt(tmps,str_get(sarg[2])));
1965 #else
1966         fatal(
1967           "The crypt() function is unimplemented due to excessive paranoia.");
1968 #endif
1969         break;
1970     case O_EXP:
1971         value = exp(str_gnum(sarg[1]));
1972         goto donumset;
1973     case O_LOG:
1974         value = log(str_gnum(sarg[1]));
1975         goto donumset;
1976     case O_SQRT:
1977         value = sqrt(str_gnum(sarg[1]));
1978         goto donumset;
1979     case O_INT:
1980         modf(str_gnum(sarg[1]),&value);
1981         goto donumset;
1982     case O_ORD:
1983         value = (double) *str_get(sarg[1]);
1984         goto donumset;
1985     case O_SLEEP:
1986         tmps = str_get(sarg[1]);
1987         time(&tmplong);
1988         if (!tmps || !*tmps)
1989             sleep((32767<<16)+32767);
1990         else
1991             sleep(atoi(tmps));
1992         value = (double)tmplong;
1993         time(&tmplong);
1994         value = ((double)tmplong) - value;
1995         goto donumset;
1996     case O_FLIP:
1997         if (str_true(sarg[1])) {
1998             str_numset(str,0.0);
1999             anum = 2;
2000             arg->arg_type = optype = O_FLOP;
2001             maxarg = 0;
2002             arg[2].arg_flags &= ~AF_SPECIAL;
2003             arg[1].arg_flags |= AF_SPECIAL;
2004             argflags = arg[anum].arg_flags;
2005             goto re_eval;
2006         }
2007         str_set(str,"");
2008         break;
2009     case O_FLOP:
2010         str_inc(str);
2011         if (str_true(sarg[2])) {
2012             arg->arg_type = O_FLIP;
2013             arg[1].arg_flags &= ~AF_SPECIAL;
2014             arg[2].arg_flags |= AF_SPECIAL;
2015             str_cat(str,"E0");
2016         }
2017         break;
2018     case O_FORK:
2019         value = (double)fork();
2020         goto donumset;
2021     case O_SYSTEM:
2022         if (anum = vfork()) {
2023             ihand = signal(SIGINT, SIG_IGN);
2024             qhand = signal(SIGQUIT, SIG_IGN);
2025             while ((maxarg = wait(&argflags)) != anum && maxarg != -1)
2026                 ;
2027             if (maxarg == -1)
2028                 argflags = -1;
2029             signal(SIGINT, ihand);
2030             signal(SIGQUIT, qhand);
2031             value = (double)argflags;
2032             goto donumset;
2033         }
2034         /* FALL THROUGH */
2035     case O_EXEC:
2036         if (arg[1].arg_flags & AF_SPECIAL)
2037             value = (double)do_aexec(arg);
2038         else {
2039             value = (double)do_exec(str_get(sarg[1]));
2040         }
2041         goto donumset;
2042     case O_HEX:
2043         maxarg = 4;
2044         goto snarfnum;
2045
2046     case O_OCT:
2047         maxarg = 3;
2048
2049       snarfnum:
2050         anum = 0;
2051         tmps = str_get(sarg[1]);
2052         for (;;) {
2053             switch (*tmps) {
2054             default:
2055                 goto out;
2056             case '8': case '9':
2057                 if (maxarg != 4)
2058                     goto out;
2059                 /* FALL THROUGH */
2060             case '0': case '1': case '2': case '3': case '4':
2061             case '5': case '6': case '7':
2062                 anum <<= maxarg;
2063                 anum += *tmps++ & 15;
2064                 break;
2065             case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
2066             case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
2067                 if (maxarg != 4)
2068                     goto out;
2069                 anum <<= 4;
2070                 anum += (*tmps++ & 7) + 9;
2071                 break;
2072             case 'x':
2073                 maxarg = 4;
2074                 tmps++;
2075                 break;
2076             }
2077         }
2078       out:
2079         value = (double)anum;
2080         goto donumset;
2081     case O_CHMOD:
2082     case O_CHOWN:
2083     case O_KILL:
2084     case O_UNLINK:
2085         if (arg[1].arg_flags & AF_SPECIAL)
2086             value = (double)apply(optype,arg,Null(STR**));
2087         else {
2088             sarg[2] = Nullstr;
2089             value = (double)apply(optype,arg,sarg);
2090         }
2091         goto donumset;
2092     case O_UMASK:
2093         value = (double)umask((int)str_gnum(sarg[1]));
2094         goto donumset;
2095     case O_RENAME:
2096         tmps = str_get(sarg[1]);
2097 #ifdef RENAME
2098         value = (double)(rename(tmps,str_get(sarg[2])) >= 0);
2099 #else
2100         tmps2 = str_get(sarg[2]);
2101         UNLINK(tmps2);
2102         if (!(anum = link(tmps,tmps2)))
2103             anum = UNLINK(tmps);
2104         value = (double)(anum >= 0);
2105 #endif
2106         goto donumset;
2107     case O_LINK:
2108         tmps = str_get(sarg[1]);
2109         value = (double)(link(tmps,str_get(sarg[2])) >= 0);
2110         goto donumset;
2111     case O_UNSHIFT:
2112         ary = arg[2].arg_ptr.arg_stab->stab_array;
2113         if (arg[1].arg_flags & AF_SPECIAL)
2114             do_unshift(arg,ary);
2115         else {
2116             str = str_new(0);           /* must copy the STR */
2117             str_sset(str,sarg[1]);
2118             aunshift(ary,1);
2119             astore(ary,0,str);
2120         }
2121         value = (double)(ary->ary_fill + 1);
2122         break;
2123     case O_EVAL:
2124         str_sset(str,
2125             do_eval(arg[1].arg_type != A_NULL ? sarg[1] : defstab->stab_val) );
2126         STABSET(str);
2127         break;
2128     }
2129 #ifdef DEBUGGING
2130     dlevel--;
2131     if (debug & 8)
2132         deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
2133 #endif
2134     goto freeargs;
2135
2136 donumset:
2137     str_numset(str,value);
2138     STABSET(str);
2139 #ifdef DEBUGGING
2140     dlevel--;
2141     if (debug & 8)
2142         deb("%s RETURNS \"%f\"\n",opname[optype],value);
2143 #endif
2144
2145 freeargs:
2146     if (sarg != quicksarg) {
2147         if (retary) {
2148             if (optype == O_LIST)
2149                 sarg[0] = &str_no;
2150             else
2151                 sarg[0] = Nullstr;
2152             sarg[maxarg+1] = Nullstr;
2153             *retary = sarg;     /* up to them to free it */
2154         }
2155         else
2156             safefree(sarg);
2157     }
2158     return str;
2159
2160 nullarray:
2161     maxarg = 0;
2162 #ifdef DEBUGGING
2163     dlevel--;
2164     if (debug & 8)
2165         deb("%s RETURNS ()\n",opname[optype],value);
2166 #endif
2167     goto freeargs;
2168 }