2.11BSD#431 - /usr/src/new/PORT/perl.1.0.16/arg.c

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