# 2.11BSD#431 - /usr/src/new/PORT/perl.1.0.10/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.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

- in line 2062-2065(2)

do_aexec defined in line 767; used 1 times

- in line 2013

do_aprint defined in line 730; used 1 times

- in line 1834

do_assign defined in line 955; used 1 times

- in line 1476

do_close defined in line 420; used 5 times

- in line 414, 1388, 1399, 1669
- in /usr/src/new/PORT/perl.1.0.10/perl.h line 128

do_each defined in line 1051; used 1 times

- in line 1673

do_eof defined in line 445; used 2 times

- in line 1873
- in /usr/src/new/PORT/perl.1.0.10/arg.h line 314

do_exec defined in line 795; used 1 times

- in line 2015

do_join defined in line 273; used 1 times

- in line 1790

do_kv defined in line 1014; used 1 times

- in line 1679

do_match defined in line 30; used 3 times

- in line 1459-1463(2)
- in /usr/src/new/PORT/perl.1.0.10/perl.h line 126

do_open defined in line 294; used 4 times

- in line 390, 403, 1651
- in /usr/src/new/PORT/perl.1.0.10/perl.h line 127

do_print defined in line 719; used 7 times

- in line 743, 749, 756-761(2), 1836-1838(2)
- in /usr/src/new/PORT/perl.1.0.10/perl.h line 129

do_push defined in line 830; used 2 times

- in line 943, 1737

do_seek defined in line 498; used 2 times

- in line 1882
- in /usr/src/new/PORT/perl.1.0.10/arg.h line 316

do_split defined in line 202; used 2 times

- in line 1769
- in /usr/src/new/PORT/perl.1.0.10/arg.h line 313

do_sprintf defined in line 645; used 2 times

- in line 742, 1777

do_stat defined in line 516; used 2 times

- in line 1939
- in /usr/src/new/PORT/perl.1.0.10/arg.h line 319

do_subr defined in line 932; used 1 times

- in line 1819

do_subst defined in line 106; used 3 times

- in line 1467-1471(2)
- in /usr/src/new/PORT/perl.1.0.10/perl.h line 131

do_tell defined in line 481; used 2 times

- in line 1877
- in /usr/src/new/PORT/perl.1.0.10/arg.h line 315

do_time defined in line 605; used 3 times

- in line 1930-1935(2)
- in /usr/src/new/PORT/perl.1.0.10/arg.h line 318

do_tms defined in line 572; used 2 times

- in line 1925
- in /usr/src/new/PORT/perl.1.0.10/arg.h line 317

do_trans defined in line 172; used 3 times

- in line 1660-1664(2)
- in /usr/src/new/PORT/perl.1.0.10/arg.h line 312

do_unshift defined in line 849; used 1 times

- in line 2090

eval defined in line 1207; used 24 times

- in line 49, 123, 160, 222, 282, 740, 777, 839, 858, 886, 969, 991, 1266, 1293
- in /usr/src/new/PORT/perl.1.0.10/cmd.c line 264, 285, 294-298(2), 327
- in /usr/src/new/PORT/perl.1.0.10/form.c line 60, 104, 153, 210
- in /usr/src/new/PORT/perl.1.0.10/perl.h line 112

init_eval defined in line 1088; used 1 times

- in /usr/src/new/PORT/perl.1.0.10/perly.c line 112

nextargv defined in line 378; used 3 times

- in line 472, 1386, 1396

#### Defined variables

debarg defined in line 28; used 1 times

- in line 1633

#### Defined macros

A defined in line 1092; used 104 times

- in line 1093-1196(104)

Last modified: 1988-02-03 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 7088 |