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

#### Defined functions

apply defined in line 850; used 2 times

- in line 2034-2037(2)

do_aexec defined in line 745; used 1 times

- in line 1985

do_aprint defined in line 708; used 1 times

- in line 1806

do_assign defined in line 933; used 1 times

- in line 1448

do_close defined in line 408; used 5 times

- in line 402, 1360, 1371, 1641
- in /usr/src/new/PORT/perl.1.0.0/perl.h line 101

do_each defined in line 1029; used 1 times

- in line 1645

do_eof defined in line 433; used 2 times

- in line 1845
- in /usr/src/new/PORT/perl.1.0.0/arg.h line 309

do_exec defined in line 773; used 1 times

- in line 1987

do_join defined in line 261; used 1 times

- in line 1762

do_kv defined in line 992; used 1 times

- in line 1651

do_match defined in line 18; used 3 times

- in line 1431-1435(2)
- in /usr/src/new/PORT/perl.1.0.0/perl.h line 99

do_open defined in line 282; used 4 times

- in line 378, 391, 1623
- in /usr/src/new/PORT/perl.1.0.0/perl.h line 100

do_print defined in line 697; used 7 times

- in line 721, 727, 734-739(2), 1808-1810(2)
- in /usr/src/new/PORT/perl.1.0.0/perl.h line 102

do_push defined in line 808; used 2 times

- in line 921, 1709

do_seek defined in line 486; used 2 times

- in line 1854
- in /usr/src/new/PORT/perl.1.0.0/arg.h line 311

do_split defined in line 190; used 2 times

- in line 1741
- in /usr/src/new/PORT/perl.1.0.0/arg.h line 308

do_sprintf defined in line 628; used 2 times

- in line 720, 1749

do_stat defined in line 504; used 2 times

- in line 1911
- in /usr/src/new/PORT/perl.1.0.0/arg.h line 314

do_subr defined in line 910; used 1 times

- in line 1791

do_subst defined in line 94; used 3 times

- in line 1439-1443(2)
- in /usr/src/new/PORT/perl.1.0.0/perl.h line 104

do_tell defined in line 469; used 2 times

- in line 1849
- in /usr/src/new/PORT/perl.1.0.0/arg.h line 310

do_time defined in line 588; used 3 times

- in line 1902-1907(2)
- in /usr/src/new/PORT/perl.1.0.0/arg.h line 313

do_tms defined in line 555; used 2 times

- in line 1897
- in /usr/src/new/PORT/perl.1.0.0/arg.h line 312

do_trans defined in line 160; used 3 times

- in line 1632-1636(2)
- in /usr/src/new/PORT/perl.1.0.0/arg.h line 307

do_unshift defined in line 827; used 1 times

- in line 2062

eval defined in line 1179; used 24 times

- in line 37, 111, 148, 210, 270, 718, 755, 817, 836, 864, 947, 969, 1238, 1265
- in /usr/src/new/PORT/perl.1.0.0/cmd.c line 261, 282, 291-295(2), 324
- in /usr/src/new/PORT/perl.1.0.0/form.c line 60, 104, 153, 210
- in /usr/src/new/PORT/perl.1.0.0/perl.h line 86

init_eval defined in line 1066; used 1 times

- in /usr/src/new/PORT/perl.1.0.0/perly.c line 102

nextargv defined in line 366; used 3 times

- in line 460, 1358, 1368

#### Defined variables

debarg defined in line 16; used 1 times

- in line 1605

#### Defined macros

A defined in line 1070; used 103 times

- in line 1071-1173(103)

Last modified: 1988-01-31 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 5466 |