arg.c

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