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

Defined functions

apply defined in line 872; used 2 times
do_aexec defined in line 767; used 1 times
do_aprint defined in line 730; used 1 times
do_assign defined in line 955; used 1 times
do_close defined in line 420; used 5 times
do_each defined in line 1051; used 1 times
do_eof defined in line 445; used 2 times
do_exec defined in line 795; used 1 times
do_join defined in line 273; used 1 times
do_kv defined in line 1014; used 1 times
do_match defined in line 30; used 3 times
do_open defined in line 294; used 4 times
do_print defined in line 719; used 7 times
do_push defined in line 830; used 2 times
do_seek defined in line 498; used 2 times
do_split defined in line 202; used 2 times
do_sprintf defined in line 645; used 2 times
do_stat defined in line 516; used 2 times
do_subr defined in line 932; used 1 times
do_subst defined in line 106; used 3 times
do_tell defined in line 481; used 2 times
do_time defined in line 605; used 3 times
do_tms defined in line 572; used 2 times
do_trans defined in line 172; used 3 times
do_unshift defined in line 849; used 1 times
init_eval defined in line 1088; used 1 times
nextargv defined in line 378; used 3 times

Defined variables

debarg defined in line 28; used 1 times

Defined macros

A defined in line 1092; used 104 times
Last modified: 1988-02-03
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 980
Valid CSS Valid XHTML 1.0 Strict