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

##### Functions

    apply             X
    do_aexec          X
    do_aprint         X
    do_assign         X
    do_close          X
    do_each           X
    do_eof            X
    do_exec           X
    do_join           X
    do_kv             X
    do_match          X
    do_open           X
    do_print          X
    do_push           X
    do_seek           X
    do_split          X
    do_sprintf        X
    do_stat           X
    do_subr           X
    do_subst          X
    do_tell           X
    do_time           X
    do_tms            X
    do_trans          X
    do_unshift        X
    eval              X
    init_eval         X
    nextargv          X

##### Variables

    debarg            X

##### Macros

    A                 X

       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: }

#### Defined functions

apply defined in line 891; used 2 times

- in line 2086-2089(2)

do_aexec defined in line 786; used 1 times

- in line 2037

do_aprint defined in line 749; used 1 times

- in line 1853

do_assign defined in line 974; used 1 times

- in line 1495

do_close defined in line 439; used 5 times

- in line 433, 1407, 1418, 1688
- in /usr/src/new/PORT/perl.1.0.16/perl.h line 128

do_each defined in line 1070; used 1 times

- in line 1692

do_eof defined in line 464; used 2 times

- in line 1892
- in /usr/src/new/PORT/perl.1.0.16/arg.h line 314

do_exec defined in line 814; used 1 times

- in line 2039

do_join defined in line 292; used 1 times

- in line 1809

do_kv defined in line 1033; used 1 times

- in line 1698

do_match defined in line 36; used 3 times

- in line 1478-1482(2)
- in /usr/src/new/PORT/perl.1.0.16/perl.h line 126

do_open defined in line 313; used 4 times

- in line 409, 422, 1670
- in /usr/src/new/PORT/perl.1.0.16/perl.h line 127

do_print defined in line 738; used 7 times

- in line 762, 768, 775-780(2), 1855-1857(2)
- in /usr/src/new/PORT/perl.1.0.16/perl.h line 129

do_push defined in line 849; used 2 times

- in line 962, 1756

do_seek defined in line 517; used 2 times

- in line 1901
- in /usr/src/new/PORT/perl.1.0.16/arg.h line 316

do_split defined in line 208; used 2 times

- in line 1788
- in /usr/src/new/PORT/perl.1.0.16/arg.h line 313

do_sprintf defined in line 664; used 2 times

- in line 761, 1796

do_stat defined in line 535; used 2 times

- in line 1958
- in /usr/src/new/PORT/perl.1.0.16/arg.h line 319

do_subr defined in line 951; used 1 times

- in line 1838

do_subst defined in line 112; used 3 times

- in line 1486-1490(2)
- in /usr/src/new/PORT/perl.1.0.16/perl.h line 131

do_tell defined in line 500; used 2 times

- in line 1896
- in /usr/src/new/PORT/perl.1.0.16/arg.h line 315

do_time defined in line 624; used 3 times

- in line 1949-1954(2)
- in /usr/src/new/PORT/perl.1.0.16/arg.h line 318

do_tms defined in line 591; used 2 times

- in line 1944
- in /usr/src/new/PORT/perl.1.0.16/arg.h line 317

do_trans defined in line 178; used 3 times

- in line 1679-1683(2)
- in /usr/src/new/PORT/perl.1.0.16/arg.h line 312

do_unshift defined in line 868; used 1 times

- in line 2114

eval defined in line 1226; used 24 times

- in line 55, 129, 166, 228, 301, 759, 796, 858, 877, 905, 988, 1010, 1285, 1312
- in /usr/src/new/PORT/perl.1.0.16/cmd.c line 264, 285, 294-298(2), 327
- in /usr/src/new/PORT/perl.1.0.16/form.c line 60, 104, 153, 210
- in /usr/src/new/PORT/perl.1.0.16/perl.h line 112

init_eval defined in line 1107; used 1 times

- in /usr/src/new/PORT/perl.1.0.16/perly.c line 113

nextargv defined in line 397; used 3 times

- in line 491, 1405, 1415

#### Defined variables

debarg defined in line 34; used 1 times

- in line 1652

#### Defined macros

A defined in line 1111; used 104 times

- in line 1112-1215(104)

Last modified: 2002-12-19 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 7265 |