arg.c

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