arg.c

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