arg.c

   1 /* $Header: arg.c,v 2.0 88/06/05 00:08:04 root Exp $
   2  *
   3  * $Log:        arg.c,v $
   4  * Revision 2.0  88/06/05  00:08:04  root
   5  * Baseline version 2.0.
   6  *
   7  */
   8
   9 #include "EXTERN.h"
  10 #include "perl.h"
  11
  12 #include <signal.h>
  13 #include <errno.h>
  14
  15 extern int errno;
  16
  17 STR *
  18 do_match(arg,retary,sarg,ptrmaxsarg,sargoff,cushion)
  19 register ARG *arg;
  20 STR ***retary;
  21 register STR **sarg;
  22 int *ptrmaxsarg;
  23 int sargoff;
  24 int cushion;
  25 {
  26     register SPAT *spat = arg[2].arg_ptr.arg_spat;
  27     register char *t;
  28     register char *s = str_get(sarg[1]);
  29     char *strend = s + sarg[1]->str_cur;
  30
  31     if (!spat)
  32         return &str_yes;
  33     if (!s)
  34         fatal("panic: do_match");
  35     if (retary) {
  36         *retary = sarg;         /* assume no match */
  37         *ptrmaxsarg = sargoff;
  38     }
  39     if (spat->spat_flags & SPAT_USED) {
  40 #ifdef DEBUGGING
  41         if (debug & 8)
  42             deb("2.SPAT USED\n");
  43 #endif
  44         return &str_no;
  45     }
  46     if (spat->spat_runtime) {
  47         t = str_get(eval(spat->spat_runtime,Null(STR***),-1));
  48 #ifdef DEBUGGING
  49         if (debug & 8)
  50             deb("2.SPAT /%s/\n",t);
  51 #endif
  52         spat->spat_regexp = regcomp(t,spat->spat_flags & SPAT_FOLD,1);
  53         if (!*spat->spat_regexp->precomp && lastspat)
  54             spat = lastspat;
  55         if (regexec(spat->spat_regexp, s, strend, TRUE, 0,
  56           sarg[1]->str_pok & 4 ? sarg[1] : Nullstr)) {
  57             if (spat->spat_regexp->subbase)
  58                 curspat = spat;
  59             lastspat = spat;
  60             goto gotcha;
  61         }
  62         else
  63             return &str_no;
  64     }
  65     else {
  66 #ifdef DEBUGGING
  67         if (debug & 8) {
  68             char ch;
  69
  70             if (spat->spat_flags & SPAT_ONCE)
  71                 ch = '?';
  72             else
  73                 ch = '/';
  74             deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
  75         }
  76 #endif
  77         if (!*spat->spat_regexp->precomp && lastspat)
  78             spat = lastspat;
  79         t = s;
  80         if (hint) {
  81             if (hint < s || hint > strend)
  82                 fatal("panic: hint in do_match");
  83             s = hint;
  84             hint = Nullch;
  85             if (spat->spat_regexp->regback >= 0) {
  86                 s -= spat->spat_regexp->regback;
  87                 if (s < t)
  88                     s = t;
  89             }
  90             else
  91                 s = t;
  92         }
  93         else if (spat->spat_short) {
  94             if (spat->spat_flags & SPAT_SCANFIRST) {
  95                 if (sarg[1]->str_pok == 5) {
  96                     if (screamfirst[spat->spat_short->str_rare] < 0)
  97                         goto nope;
  98                     else if (!(s = screaminstr(sarg[1],spat->spat_short)))
  99                         goto nope;
 100                     else if (spat->spat_flags & SPAT_ALL)
 101                         goto yup;
 102                 }
 103                 else if (!(s = fbminstr(s, strend, spat->spat_short)))
 104                     goto nope;
 105                 else if (spat->spat_flags & SPAT_ALL)
 106                     goto yup;
 107                 else if (spat->spat_regexp->regback >= 0) {
 108                     ++*(long*)&spat->spat_short->str_nval;
 109                     s -= spat->spat_regexp->regback;
 110                     if (s < t)
 111                         s = t;
 112                 }
 113                 else
 114                     s = t;
 115             }
 116             else if (!multiline && (*spat->spat_short->str_ptr != *s ||
 117               strnNE(spat->spat_short->str_ptr, s, spat->spat_slen) ))
 118                 goto nope;
 119             if (--*(long*)&spat->spat_short->str_nval < 0) {
 120                 str_free(spat->spat_short);
 121                 spat->spat_short = Nullstr;     /* opt is being useless */
 122             }
 123         }
 124         if (regexec(spat->spat_regexp, s, strend, s == t, 0,
 125           sarg[1]->str_pok & 4 ? sarg[1] : Nullstr)) {
 126             if (spat->spat_regexp->subbase)
 127                 curspat = spat;
 128             lastspat = spat;
 129             if (spat->spat_flags & SPAT_ONCE)
 130                 spat->spat_flags |= SPAT_USED;
 131             goto gotcha;
 132         }
 133         else
 134             return &str_no;
 135     }
 136     /*NOTREACHED*/
 137
 138   gotcha:
 139     if (retary && curspat == spat) {
 140         int iters, i, len;
 141
 142         iters = spat->spat_regexp->nparens;
 143         *ptrmaxsarg = iters + sargoff;
 144         sarg = (STR**)saferealloc((char*)(sarg - sargoff),
 145           (iters+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
 146
 147         for (i = 1; i <= iters; i++) {
 148             sarg[i] = str_static(&str_no);
 149             if (s = spat->spat_regexp->startp[i]) {
 150                 len = spat->spat_regexp->endp[i] - s;
 151                 if (len > 0)
 152                     str_nset(sarg[i],s,len);
 153             }
 154         }
 155         *retary = sarg;
 156     }
 157     return &str_yes;
 158
 159 yup:
 160     ++*(long*)&spat->spat_short->str_nval;
 161     return &str_yes;
 162
 163 nope:
 164     ++*(long*)&spat->spat_short->str_nval;
 165     return &str_no;
 166 }
 167
 168 int
 169 do_subst(str,arg)
 170 STR *str;
 171 register ARG *arg;
 172 {
 173     register SPAT *spat;
 174     register STR *dstr;
 175     register char *s = str_get(str);
 176     char *strend = s + str->str_cur;
 177     register char *m;
 178
 179     spat = arg[2].arg_ptr.arg_spat;
 180     if (!spat || !s)
 181         fatal("panic: do_subst");
 182     else if (spat->spat_runtime) {
 183         m = str_get(eval(spat->spat_runtime,Null(STR***),-1));
 184         spat->spat_regexp = regcomp(m,spat->spat_flags & SPAT_FOLD,1);
 185     }
 186 #ifdef DEBUGGING
 187     if (debug & 8) {
 188         deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
 189     }
 190 #endif
 191     if (!*spat->spat_regexp->precomp && lastspat)
 192         spat = lastspat;
 193     m = s;
 194     if (hint) {
 195         if (hint < s || hint > strend)
 196             fatal("panic: hint in do_match");
 197         s = hint;
 198         hint = Nullch;
 199         if (spat->spat_regexp->regback >= 0) {
 200             s -= spat->spat_regexp->regback;
 201             if (s < m)
 202                 s = m;
 203         }
 204         else
 205             s = m;
 206     }
 207     else if (spat->spat_short) {
 208         if (spat->spat_flags & SPAT_SCANFIRST) {
 209             if (str->str_pok == 5) {
 210                 if (screamfirst[spat->spat_short->str_rare] < 0)
 211                     goto nope;
 212                 else if (!(s = screaminstr(str,spat->spat_short)))
 213                     goto nope;
 214             }
 215             else if (!(s = fbminstr(s, strend, spat->spat_short)))
 216                 goto nope;
 217             else if (spat->spat_regexp->regback >= 0) {
 218                 ++*(long*)&spat->spat_short->str_nval;
 219                 s -= spat->spat_regexp->regback;
 220                 if (s < m)
 221                     s = m;
 222             }
 223             else
 224                 s = m;
 225         }
 226         else if (!multiline && (*spat->spat_short->str_ptr != *s ||
 227           strnNE(spat->spat_short->str_ptr, s, spat->spat_slen) ))
 228             goto nope;
 229         if (--*(long*)&spat->spat_short->str_nval < 0) {
 230             str_free(spat->spat_short);
 231             spat->spat_short = Nullstr; /* opt is being useless */
 232         }
 233     }
 234     if (regexec(spat->spat_regexp, s, strend, s == m, 1,
 235       str->str_pok & 4 ? str : Nullstr)) {
 236         int iters = 0;
 237
 238         dstr = str_new(str_len(str));
 239         str_nset(dstr,m,s-m);
 240         if (spat->spat_regexp->subbase)
 241             curspat = spat;
 242         lastspat = spat;
 243         do {
 244             m = spat->spat_regexp->startp[0];
 245             if (iters++ > 10000)
 246                 fatal("Substitution loop");
 247             if (spat->spat_regexp->subbase)
 248                 s = spat->spat_regexp->subbase;
 249             str_ncat(dstr,s,m-s);
 250             s = spat->spat_regexp->endp[0];
 251             str_scat(dstr,eval(spat->spat_repl,Null(STR***),-1));
 252             if (spat->spat_flags & SPAT_ONCE)
 253                 break;
 254         } while (regexec(spat->spat_regexp, s, strend, FALSE, 1, Nullstr));
 255         str_cat(dstr,s);
 256         str_replace(str,dstr);
 257         STABSET(str);
 258         return iters;
 259     }
 260     return 0;
 261
 262 nope:
 263     ++*(long*)&spat->spat_short->str_nval;
 264     return 0;
 265 }
 266
 267 int
 268 do_trans(str,arg)
 269 STR *str;
 270 register ARG *arg;
 271 {
 272     register char *tbl;
 273     register char *s;
 274     register int matches = 0;
 275     register int ch;
 276
 277     tbl = arg[2].arg_ptr.arg_cval;
 278     s = str_get(str);
 279     if (!tbl || !s)
 280         fatal("panic: do_trans");
 281 #ifdef DEBUGGING
 282     if (debug & 8) {
 283         deb("2.TBL\n");
 284     }
 285 #endif
 286     while (*s) {
 287         if (ch = tbl[*s & 0377]) {
 288             matches++;
 289             *s = ch;
 290         }
 291         s++;
 292     }
 293     STABSET(str);
 294     return matches;
 295 }
 296
 297 int
 298 do_split(spat,retary,sarg,ptrmaxsarg,sargoff,cushion)
 299 register SPAT *spat;
 300 STR ***retary;
 301 register STR **sarg;
 302 int *ptrmaxsarg;
 303 int sargoff;
 304 int cushion;
 305 {
 306     register char *s = str_get(sarg[1]);
 307     char *strend = s + sarg[1]->str_cur;
 308     register STR *dstr;
 309     register char *m;
 310     register ARRAY *ary;
 311     static ARRAY *myarray = Null(ARRAY*);
 312     int iters = 0;
 313     int i;
 314
 315     if (!spat || !s)
 316         fatal("panic: do_split");
 317     else if (spat->spat_runtime) {
 318         m = str_get(eval(spat->spat_runtime,Null(STR***),-1));
 319         if (!*m || (*m == ' ' && !m[1])) {
 320             m = "\\s+";
 321             spat->spat_flags |= SPAT_SKIPWHITE;
 322         }
 323         if (spat->spat_runtime->arg_type == O_ITEM &&
 324           spat->spat_runtime[1].arg_type == A_SINGLE) {
 325             arg_free(spat->spat_runtime);       /* it won't change, so */
 326             spat->spat_runtime = Nullarg;       /* no point compiling again */
 327         }
 328         spat->spat_regexp = regcomp(m,spat->spat_flags & SPAT_FOLD,1);
 329     }
 330 #ifdef DEBUGGING
 331     if (debug & 8) {
 332         deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
 333     }
 334 #endif
 335     if (retary)
 336         ary = myarray;
 337     else
 338         ary = spat->spat_repl[1].arg_ptr.arg_stab->stab_array;
 339     if (!ary)
 340         myarray = ary = anew(Nullstab);
 341     ary->ary_fill = -1;
 342     if (spat->spat_flags & SPAT_SKIPWHITE) {
 343         while (isspace(*s))
 344             s++;
 345     }
 346     if (spat->spat_short) {
 347         i = spat->spat_short->str_cur;
 348         while (*s && (m = fbminstr(s, strend, spat->spat_short))) {
 349             dstr = str_new(m-s);
 350             str_nset(dstr,s,m-s);
 351             astore(ary, iters++, dstr);
 352             if (iters > 10000)
 353                 fatal("Substitution loop");
 354             s = m + i;
 355         }
 356     }
 357     else {
 358         while (*s && regexec(spat->spat_regexp, s, strend, (iters == 0), 1,
 359           Nullstr)) {
 360             m = spat->spat_regexp->startp[0];
 361             if (spat->spat_regexp->subbase)
 362                 s = spat->spat_regexp->subbase;
 363             dstr = str_new(m-s);
 364             str_nset(dstr,s,m-s);
 365             astore(ary, iters++, dstr);
 366             if (iters > 10000)
 367                 fatal("Substitution loop");
 368             s = spat->spat_regexp->endp[0];
 369         }
 370     }
 371     if (*s) {                   /* ignore field after final "whitespace" */
 372         dstr = str_new(0);      /*   if they interpolate, it's null anyway */
 373         str_set(dstr,s);
 374         astore(ary, iters++, dstr);
 375     }
 376     else {
 377         while (iters > 0 && !*str_get(afetch(ary,iters-1)))
 378             iters--;
 379     }
 380     if (retary) {
 381         *ptrmaxsarg = iters + sargoff;
 382         sarg = (STR**)saferealloc((char*)(sarg - sargoff),
 383           (iters+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
 384
 385         for (i = 1; i <= iters; i++)
 386             sarg[i] = afetch(ary,i-1);
 387         *retary = sarg;
 388     }
 389     return iters;
 390 }
 391
 392 void
 393 do_join(arg,delim,str)
 394 register ARG *arg;
 395 register char *delim;
 396 register STR *str;
 397 {
 398     STR **tmpary;       /* must not be register */
 399     register STR **elem;
 400     register int items;
 401
 402     (void)eval(arg[2].arg_ptr.arg_arg,&tmpary,-1);
 403     items = (int)str_gnum(*tmpary);
 404     elem = tmpary+1;
 405     if (items-- > 0)
 406         str_sset(str,*elem++);
 407     for (; items > 0; items--,elem++) {
 408         str_cat(str,delim);
 409         str_scat(str,*elem);
 410     }
 411     STABSET(str);
 412     safefree((char*)tmpary);
 413 }
 414
 415 FILE *
 416 forkopen(name,mode)
 417 char *name;
 418 char *mode;
 419 {
 420     int pfd[2];
 421
 422     if (pipe(pfd) < 0)
 423         return Nullfp;
 424     while ((forkprocess = fork()) == -1) {
 425         if (errno != EAGAIN)
 426             return Nullfp;
 427         sleep(5);
 428     }
 429     if (*mode == 'w') {
 430         if (forkprocess) {
 431             close(pfd[0]);
 432             return fdopen(pfd[1],"w");
 433         }
 434         else {
 435             close(pfd[1]);
 436             close(0);
 437             dup(pfd[0]);        /* substitute our pipe for stdin */
 438             close(pfd[0]);
 439             return Nullfp;
 440         }
 441     }
 442     else {
 443         if (forkprocess) {
 444             close(pfd[1]);
 445             return fdopen(pfd[0],"r");
 446         }
 447         else {
 448             close(pfd[0]);
 449             close(1);
 450             if (dup(pfd[1]) == 0)
 451                 dup(pfd[1]);    /* substitute our pipe for stdout */
 452             close(pfd[1]);
 453             return Nullfp;
 454         }
 455     }
 456 }
 457
 458 bool
 459 do_open(stab,name)
 460 STAB *stab;
 461 register char *name;
 462 {
 463     FILE *fp;
 464     int len = strlen(name);
 465     register STIO *stio = stab->stab_io;
 466     char *myname = savestr(name);
 467     int result;
 468     int fd;
 469
 470     name = myname;
 471     forkprocess = 1;            /* assume true if no fork */
 472     while (len && isspace(name[len-1]))
 473         name[--len] = '\0';
 474     if (!stio)
 475         stio = stab->stab_io = stio_new();
 476     if (stio->fp) {
 477         fd = fileno(stio->fp);
 478         if (stio->type == '|')
 479             result = pclose(stio->fp);
 480         else if (stio->type != '-')
 481             result = fclose(stio->fp);
 482         else
 483             result = 0;
 484         if (result == EOF && fd > 2)
 485             fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
 486               stab->stab_name);
 487         stio->fp = Nullfp;
 488     }
 489     stio->type = *name;
 490     if (*name == '|') {
 491         for (name++; isspace(*name); name++) ;
 492         if (strNE(name,"-"))
 493             fp = popen(name,"w");
 494         else {
 495             fp = forkopen(name,"w");
 496             stio->subprocess = forkprocess;
 497             stio->type = '%';
 498         }
 499     }
 500     else if (*name == '>' && name[1] == '>') {
 501         stio->type = 'a';
 502         for (name += 2; isspace(*name); name++) ;
 503         fp = fopen(name,"a");
 504     }
 505     else if (*name == '>' && name[1] == '&') {
 506         for (name += 2; isspace(*name); name++) ;
 507         if (isdigit(*name))
 508             fd = atoi(name);
 509         else {
 510             stab = stabent(name,FALSE);
 511             if (stab->stab_io && stab->stab_io->fp) {
 512                 fd = fileno(stab->stab_io->fp);
 513                 stio->type = stab->stab_io->type;
 514             }
 515             else
 516                 fd = -1;
 517         }
 518         fp = fdopen(dup(fd),stio->type == 'a' ? "a" :
 519           (stio->type == '<' ? "r" : "w") );
 520     }
 521     else if (*name == '>') {
 522         for (name++; isspace(*name); name++) ;
 523         if (strEQ(name,"-")) {
 524             fp = stdout;
 525             stio->type = '-';
 526         }
 527         else
 528             fp = fopen(name,"w");
 529     }
 530     else {
 531         if (*name == '<') {
 532             for (name++; isspace(*name); name++) ;
 533             if (strEQ(name,"-")) {
 534                 fp = stdin;
 535                 stio->type = '-';
 536             }
 537             else
 538                 fp = fopen(name,"r");
 539         }
 540         else if (name[len-1] == '|') {
 541             name[--len] = '\0';
 542             while (len && isspace(name[len-1]))
 543                 name[--len] = '\0';
 544             for (; isspace(*name); name++) ;
 545             if (strNE(name,"-")) {
 546                 fp = popen(name,"r");
 547                 stio->type = '|';
 548             }
 549             else {
 550                 fp = forkopen(name,"r");
 551                 stio->subprocess = forkprocess;
 552                 stio->type = '%';
 553             }
 554         }
 555         else {
 556             stio->type = '<';
 557             for (; isspace(*name); name++) ;
 558             if (strEQ(name,"-")) {
 559                 fp = stdin;
 560                 stio->type = '-';
 561             }
 562             else
 563                 fp = fopen(name,"r");
 564         }
 565     }
 566     safefree(myname);
 567     if (!fp)
 568         return FALSE;
 569     if (stio->type &&
 570       stio->type != '|' && stio->type != '-' && stio->type != '%') {
 571         if (fstat(fileno(fp),&statbuf) < 0) {
 572             fclose(fp);
 573             return FALSE;
 574         }
 575         if ((statbuf.st_mode & S_IFMT) != S_IFREG &&
 576             (statbuf.st_mode & S_IFMT) != S_IFCHR) {
 577             fclose(fp);
 578             return FALSE;
 579         }
 580     }
 581     stio->fp = fp;
 582     return TRUE;
 583 }
 584
 585 FILE *
 586 nextargv(stab)
 587 register STAB *stab;
 588 {
 589     register STR *str;
 590     char *oldname;
 591     int filemode,fileuid,filegid;
 592
 593     while (alen(stab->stab_array) >= 0) {
 594         str = ashift(stab->stab_array);
 595         str_sset(stab->stab_val,str);
 596         STABSET(stab->stab_val);
 597         oldname = str_get(stab->stab_val);
 598         if (do_open(stab,oldname)) {
 599             if (inplace) {
 600                 filemode = statbuf.st_mode;
 601                 fileuid = statbuf.st_uid;
 602                 filegid = statbuf.st_gid;
 603                 if (*inplace) {
 604                     str_cat(str,inplace);
 605 #ifdef RENAME
 606                     rename(oldname,str->str_ptr);
 607 #else
 608                     UNLINK(str->str_ptr);
 609                     link(oldname,str->str_ptr);
 610                     UNLINK(oldname);
 611 #endif
 612                 }
 613                 else {
 614                     UNLINK(oldname);
 615                 }
 616                 sprintf(tokenbuf,">%s",oldname);
 617                 errno = 0;              /* in case sprintf set errno */
 618                 do_open(argvoutstab,tokenbuf);
 619                 defoutstab = argvoutstab;
 620 #ifdef FCHMOD
 621                 fchmod(fileno(argvoutstab->stab_io->fp),filemode);
 622 #else
 623                 chmod(oldname,filemode);
 624 #endif
 625 #ifdef FCHOWN
 626                 fchown(fileno(argvoutstab->stab_io->fp),fileuid,filegid);
 627 #else
 628                 chown(oldname,fileuid,filegid);
 629 #endif
 630             }
 631             str_free(str);
 632             return stab->stab_io->fp;
 633         }
 634         else
 635             fprintf(stderr,"Can't open %s\n",str_get(str));
 636         str_free(str);
 637     }
 638     if (inplace) {
 639         do_close(argvoutstab,FALSE);
 640         defoutstab = stabent("stdout",TRUE);
 641     }
 642     return Nullfp;
 643 }
 644
 645 bool
 646 do_close(stab,explicit)
 647 STAB *stab;
 648 bool explicit;
 649 {
 650     bool retval = FALSE;
 651     register STIO *stio = stab->stab_io;
 652     int status;
 653     int tmp;
 654
 655     if (!stio) {                /* never opened */
 656         if (dowarn && explicit)
 657             warn("Close on unopened file <%s>",stab->stab_name);
 658         return FALSE;
 659     }
 660     if (stio->fp) {
 661         if (stio->type == '|')
 662             retval = (pclose(stio->fp) >= 0);
 663         else if (stio->type == '-')
 664             retval = TRUE;
 665         else {
 666             retval = (fclose(stio->fp) != EOF);
 667             if (stio->type == '%' && stio->subprocess) {
 668                 while ((tmp = wait(&status)) != stio->subprocess && tmp != -1)
 669                     ;
 670                 if (tmp == -1)
 671                     statusvalue = -1;
 672                 else
 673                     statusvalue = (unsigned)status & 0xffff;
 674             }
 675         }
 676         stio->fp = Nullfp;
 677     }
 678     if (explicit)
 679         stio->lines = 0;
 680     stio->type = ' ';
 681     return retval;
 682 }
 683
 684 bool
 685 do_eof(stab)
 686 STAB *stab;
 687 {
 688     register STIO *stio;
 689     int ch;
 690
 691     if (!stab)                  /* eof() */
 692         stio = argvstab->stab_io;
 693     else
 694         stio = stab->stab_io;
 695
 696     if (!stio)
 697         return TRUE;
 698
 699     while (stio->fp) {
 700
 701 #ifdef STDSTDIO                 /* (the code works without this) */
 702         if (stio->fp->_cnt)             /* cheat a little, since */
 703             return FALSE;               /* this is the most usual case */
 704 #endif
 705
 706         ch = getc(stio->fp);
 707         if (ch != EOF) {
 708             ungetc(ch, stio->fp);
 709             return FALSE;
 710         }
 711         if (!stab) {                    /* not necessarily a real EOF yet? */
 712             if (!nextargv(argvstab))    /* get another fp handy */
 713                 return TRUE;
 714         }
 715         else
 716             return TRUE;                /* normal fp, definitely end of file */
 717     }
 718     return TRUE;
 719 }
 720
 721 long
 722 do_tell(stab)
 723 STAB *stab;
 724 {
 725     register STIO *stio;
 726
 727     if (!stab)
 728         goto phooey;
 729
 730     stio = stab->stab_io;
 731     if (!stio || !stio->fp)
 732         goto phooey;
 733
 734     return ftell(stio->fp);
 735
 736 phooey:
 737     if (dowarn)
 738         warn("tell() on unopened file");
 739     return -1L;
 740 }
 741
 742 bool
 743 do_seek(stab, pos, whence)
 744 STAB *stab;
 745 long pos;
 746 int whence;
 747 {
 748     register STIO *stio;
 749
 750     if (!stab)
 751         goto nuts;
 752
 753     stio = stab->stab_io;
 754     if (!stio || !stio->fp)
 755         goto nuts;
 756
 757     return fseek(stio->fp, pos, whence) >= 0;
 758
 759 nuts:
 760     if (dowarn)
 761         warn("seek() on unopened file");
 762     return FALSE;
 763 }
 764
 765 static CMD *sortcmd;
 766 static STAB *firststab = Nullstab;
 767 static STAB *secondstab = Nullstab;
 768
 769 do_sort(arg,stab,retary,sarg,ptrmaxsarg,sargoff,cushion)
 770 register ARG *arg;
 771 STAB *stab;
 772 STR ***retary;
 773 register STR **sarg;
 774 int *ptrmaxsarg;
 775 int sargoff;
 776 int cushion;
 777 {
 778     STR **tmpary;       /* must not be register */
 779     register STR **elem;
 780     register bool retval;
 781     register int max;
 782     register int i;
 783     int sortcmp();
 784     int sortsub();
 785     STR *oldfirst;
 786     STR *oldsecond;
 787
 788     (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
 789     max = (int)str_gnum(*tmpary);
 790
 791     if (retary) {
 792         sarg = (STR**)saferealloc((char*)(sarg - sargoff),
 793           (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
 794         for (i = 1; i <= max; i++)
 795             sarg[i] = tmpary[i];
 796         *retary = sarg;
 797         if (max > 1) {
 798             if (stab->stab_sub && (sortcmd = stab->stab_sub->cmd)) {
 799                 if (!firststab) {
 800                     firststab = stabent("a",TRUE);
 801                     secondstab = stabent("b",TRUE);
 802                 }
 803                 oldfirst = firststab->stab_val;
 804                 oldsecond = secondstab->stab_val;
 805                 qsort((char*)(sarg+1),max,sizeof(STR*),sortsub);
 806                 firststab->stab_val = oldfirst;
 807                 secondstab->stab_val = oldsecond;
 808             }
 809             else
 810                 qsort((char*)(sarg+1),max,sizeof(STR*),sortcmp);
 811         }
 812         while (max > 0 && !sarg[max])
 813             max--;
 814         *ptrmaxsarg = max + sargoff;
 815     }
 816     safefree((char*)tmpary);
 817     return max;
 818 }
 819
 820 int
 821 sortcmp(str1,str2)
 822 STR **str1;
 823 STR **str2;
 824 {
 825     char *tmps;
 826
 827     if (!*str1)
 828         return -1;
 829     if (!*str2)
 830         return 1;
 831     tmps = str_get(*str1);
 832     return strcmp(tmps,str_get(*str2));
 833 }
 834
 835 int
 836 sortsub(str1,str2)
 837 STR **str1;
 838 STR **str2;
 839 {
 840     STR *str;
 841
 842     if (!*str1)
 843         return -1;
 844     if (!*str2)
 845         return 1;
 846     firststab->stab_val = *str1;
 847     secondstab->stab_val = *str2;
 848     return (int)str_gnum(cmd_exec(sortcmd));
 849 }
 850
 851 do_stat(arg,retary,sarg,ptrmaxsarg,sargoff,cushion)
 852 register ARG *arg;
 853 STR ***retary;
 854 register STR **sarg;
 855 int *ptrmaxsarg;
 856 int sargoff;
 857 int cushion;
 858 {
 859     register ARRAY *ary;
 860     static ARRAY *myarray = Null(ARRAY*);
 861     int max = 13;
 862     register int i;
 863
 864     ary = myarray;
 865     if (!ary)
 866         myarray = ary = anew(Nullstab);
 867     ary->ary_fill = -1;
 868     if (arg[1].arg_type == A_LVAL) {
 869         tmpstab = arg[1].arg_ptr.arg_stab;
 870         if (!tmpstab->stab_io ||
 871           fstat(fileno(tmpstab->stab_io->fp),&statbuf) < 0) {
 872             max = 0;
 873         }
 874     }
 875     else
 876         if (stat(str_get(sarg[1]),&statbuf) < 0)
 877             max = 0;
 878
 879     if (retary) {
 880         if (max) {
 881             apush(ary,str_nmake((double)statbuf.st_dev));
 882             apush(ary,str_nmake((double)statbuf.st_ino));
 883             apush(ary,str_nmake((double)statbuf.st_mode));
 884             apush(ary,str_nmake((double)statbuf.st_nlink));
 885             apush(ary,str_nmake((double)statbuf.st_uid));
 886             apush(ary,str_nmake((double)statbuf.st_gid));
 887             apush(ary,str_nmake((double)statbuf.st_rdev));
 888             apush(ary,str_nmake((double)statbuf.st_size));
 889             apush(ary,str_nmake((double)statbuf.st_atime));
 890             apush(ary,str_nmake((double)statbuf.st_mtime));
 891             apush(ary,str_nmake((double)statbuf.st_ctime));
 892 #ifdef STATBLOCKS
 893             apush(ary,str_nmake((double)statbuf.st_blksize));
 894             apush(ary,str_nmake((double)statbuf.st_blocks));
 895 #else
 896             apush(ary,str_make(""));
 897             apush(ary,str_make(""));
 898 #endif
 899         }
 900         *ptrmaxsarg = max + sargoff;
 901         sarg = (STR**)saferealloc((char*)(sarg - sargoff),
 902           (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
 903         for (i = 1; i <= max; i++)
 904             sarg[i] = afetch(ary,i-1);
 905         *retary = sarg;
 906     }
 907     return max;
 908 }
 909
 910 do_tms(retary,sarg,ptrmaxsarg,sargoff,cushion)
 911 STR ***retary;
 912 STR **sarg;
 913 int *ptrmaxsarg;
 914 int sargoff;
 915 int cushion;
 916 {
 917     register ARRAY *ary;
 918     static ARRAY *myarray = Null(ARRAY*);
 919     int max = 4;
 920     register int i;
 921
 922     ary = myarray;
 923     if (!ary)
 924         myarray = ary = anew(Nullstab);
 925     ary->ary_fill = -1;
 926     times(&timesbuf);
 927
 928 #ifndef HZ
 929 #define HZ 60
 930 #endif
 931
 932     if (retary) {
 933         if (max) {
 934             apush(ary,str_nmake(((double)timesbuf.tms_utime)/HZ));
 935             apush(ary,str_nmake(((double)timesbuf.tms_stime)/HZ));
 936             apush(ary,str_nmake(((double)timesbuf.tms_cutime)/HZ));
 937             apush(ary,str_nmake(((double)timesbuf.tms_cstime)/HZ));
 938         }
 939         *ptrmaxsarg = max + sargoff;
 940         sarg = (STR**)saferealloc((char*)(sarg - sargoff),
 941           (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
 942         for (i = 1; i <= max; i++)
 943             sarg[i] = afetch(ary,i-1);
 944         *retary = sarg;
 945     }
 946     return max;
 947 }
 948
 949 do_time(tmbuf,retary,sarg,ptrmaxsarg,sargoff,cushion)
 950 struct tm *tmbuf;
 951 STR ***retary;
 952 STR **sarg;
 953 int *ptrmaxsarg;
 954 int sargoff;
 955 int cushion;
 956 {
 957     register ARRAY *ary;
 958     static ARRAY *myarray = Null(ARRAY*);
 959     int max = 9;
 960     register int i;
 961
 962     ary = myarray;
 963     if (!ary)
 964         myarray = ary = anew(Nullstab);
 965     ary->ary_fill = -1;
 966     if (!tmbuf)
 967         max = 0;
 968
 969     if (retary) {
 970         if (max) {
 971             apush(ary,str_nmake((double)tmbuf->tm_sec));
 972             apush(ary,str_nmake((double)tmbuf->tm_min));
 973             apush(ary,str_nmake((double)tmbuf->tm_hour));
 974             apush(ary,str_nmake((double)tmbuf->tm_mday));
 975             apush(ary,str_nmake((double)tmbuf->tm_mon));
 976             apush(ary,str_nmake((double)tmbuf->tm_year));
 977             apush(ary,str_nmake((double)tmbuf->tm_wday));
 978             apush(ary,str_nmake((double)tmbuf->tm_yday));
 979             apush(ary,str_nmake((double)tmbuf->tm_isdst));
 980         }
 981         *ptrmaxsarg = max + sargoff;
 982         sarg = (STR**)saferealloc((char*)(sarg - sargoff),
 983           (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
 984         for (i = 1; i <= max; i++)
 985             sarg[i] = afetch(ary,i-1);
 986         *retary = sarg;
 987     }
 988     return max;
 989 }
 990
 991 void
 992 do_sprintf(str,len,sarg)
 993 register STR *str;
 994 register int len;
 995 register STR **sarg;
 996 {
 997     register char *s;
 998     register char *t;
 999     bool dolong;
1000     char ch;
1001     static STR *sargnull = &str_no;
1002
1003     str_set(str,"");
1004     len--;                      /* don't count pattern string */
1005     sarg++;
1006     for (s = str_get(*(sarg++)); *s; len--) {
1007         if (len <= 0 || !*sarg) {
1008             sarg = &sargnull;
1009             len = 0;
1010         }
1011         dolong = FALSE;
1012         for (t = s; *t && *t != '%'; t++) ;
1013         if (!*t)
1014             break;              /* not enough % patterns, oh well */
1015         for (t++; *sarg && *t && t != s; t++) {
1016             switch (*t) {
1017             case '\0':
1018                 t--;
1019                 break;
1020             case '%':
1021                 ch = *(++t);
1022                 *t = '\0';
1023                 sprintf(buf,s);
1024                 s = t;
1025                 *(t--) = ch;
1026                 break;
1027             case 'l':
1028                 dolong = TRUE;
1029                 break;
1030             case 'D': case 'X': case 'O':
1031                 dolong = TRUE;
1032                 /* FALL THROUGH */
1033             case 'd': case 'x': case 'o': case 'c': case 'u':
1034                 ch = *(++t);
1035                 *t = '\0';
1036                 if (dolong)
1037                     sprintf(buf,s,(long)str_gnum(*(sarg++)));
1038                 else
1039                     sprintf(buf,s,(int)str_gnum(*(sarg++)));
1040                 s = t;
1041                 *(t--) = ch;
1042                 break;
1043             case 'E': case 'e': case 'f': case 'G': case 'g':
1044                 ch = *(++t);
1045                 *t = '\0';
1046                 sprintf(buf,s,str_gnum(*(sarg++)));
1047                 s = t;
1048                 *(t--) = ch;
1049                 break;
1050             case 's':
1051                 ch = *(++t);
1052                 *t = '\0';
1053                 if (strEQ(s,"%s")) {    /* some printfs fail on >128 chars */
1054                     *buf = '\0';
1055                     str_scat(str,*(sarg++));  /* so handle simple case */
1056                 }
1057                 else
1058                     sprintf(buf,s,str_get(*(sarg++)));
1059                 s = t;
1060                 *(t--) = ch;
1061                 break;
1062             }
1063         }
1064         str_cat(str,buf);
1065     }
1066     if (*s)
1067         str_cat(str,s);
1068     STABSET(str);
1069 }
1070
1071 bool
1072 do_print(str,fp)
1073 register STR *str;
1074 FILE *fp;
1075 {
1076     if (!fp) {
1077         if (dowarn)
1078             warn("print to unopened file");
1079         return FALSE;
1080     }
1081     if (!str)
1082         return FALSE;
1083     if (ofmt &&
1084       ((str->str_nok && str->str_nval != 0.0) || str_gnum(str) != 0.0) )
1085         fprintf(fp, ofmt, str->str_nval);
1086     else
1087         fputs(str_get(str),fp);
1088     return TRUE;
1089 }
1090
1091 bool
1092 do_aprint(arg,fp)
1093 register ARG *arg;
1094 register FILE *fp;
1095 {
1096     STR **tmpary;       /* must not be register */
1097     register STR **elem;
1098     register bool retval;
1099     register int items;
1100
1101     if (!fp) {
1102         if (dowarn)
1103             warn("print to unopened file");
1104         return FALSE;
1105     }
1106     (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
1107     items = (int)str_gnum(*tmpary);
1108     if (arg->arg_type == O_PRTF) {
1109         do_sprintf(arg->arg_ptr.arg_str,items,tmpary);
1110         retval = do_print(arg->arg_ptr.arg_str,fp);
1111     }
1112     else {
1113         retval = FALSE;
1114         for (elem = tmpary+1; items > 0; items--,elem++) {
1115             if (retval && ofs)
1116                 fputs(ofs, fp);
1117             retval = do_print(*elem, fp);
1118             if (!retval)
1119                 break;
1120         }
1121         if (ors)
1122             fputs(ors, fp);
1123     }
1124     safefree((char*)tmpary);
1125     return retval;
1126 }
1127
1128 bool
1129 do_aexec(arg)
1130 register ARG *arg;
1131 {
1132     STR **tmpary;       /* must not be register */
1133     register STR **elem;
1134     register char **a;
1135     register int items;
1136     char **argv;
1137
1138     (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
1139     items = (int)str_gnum(*tmpary);
1140     if (items) {
1141         argv = (char**)safemalloc((items+1)*sizeof(char*));
1142         a = argv;
1143         for (elem = tmpary+1; items > 0; items--,elem++) {
1144             if (*elem)
1145                 *a++ = str_get(*elem);
1146             else
1147                 *a++ = "";
1148         }
1149         *a = Nullch;
1150         execvp(argv[0],argv);
1151         safefree((char*)argv);
1152     }
1153     safefree((char*)tmpary);
1154     return FALSE;
1155 }
1156
1157 bool
1158 do_exec(str)
1159 STR *str;
1160 {
1161     register char **a;
1162     register char *s;
1163     char **argv;
1164     char *cmd = str_get(str);
1165
1166     /* see if there are shell metacharacters in it */
1167
1168     for (s = cmd; *s; s++) {
1169         if (*s != ' ' && !isalpha(*s) && index("$&*(){}[]'\";\\|?<>~`",*s)) {
1170             execl("/bin/sh","sh","-c",cmd,(char*)0);
1171             return FALSE;
1172         }
1173     }
1174     argv = (char**)safemalloc(((s - cmd) / 2 + 2)*sizeof(char*));
1175
1176     a = argv;
1177     for (s = cmd; *s;) {
1178         while (isspace(*s)) s++;
1179         if (*s)
1180             *(a++) = s;
1181         while (*s && !isspace(*s)) s++;
1182         if (*s)
1183             *s++ = '\0';
1184     }
1185     *a = Nullch;
1186     if (argv[0])
1187         execvp(argv[0],argv);
1188     safefree((char*)argv);
1189     return FALSE;
1190 }
1191
1192 STR *
1193 do_push(arg,ary)
1194 register ARG *arg;
1195 register ARRAY *ary;
1196 {
1197     STR **tmpary;       /* must not be register */
1198     register STR **elem;
1199     register STR *str = &str_no;
1200     register int items;
1201
1202     (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
1203     items = (int)str_gnum(*tmpary);
1204     for (elem = tmpary+1; items > 0; items--,elem++) {
1205         str = str_new(0);
1206         if (*elem)
1207             str_sset(str,*elem);
1208         apush(ary,str);
1209     }
1210     safefree((char*)tmpary);
1211     return str;
1212 }
1213
1214 do_unshift(arg,ary)
1215 register ARG *arg;
1216 register ARRAY *ary;
1217 {
1218     STR **tmpary;       /* must not be register */
1219     register STR **elem;
1220     register STR *str = &str_no;
1221     register int i;
1222     register int items;
1223
1224     (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
1225     items = (int)str_gnum(*tmpary);
1226     aunshift(ary,items);
1227     i = 0;
1228     for (elem = tmpary+1; i < items; i++,elem++) {
1229         str = str_new(0);
1230         str_sset(str,*elem);
1231         astore(ary,i,str);
1232     }
1233     safefree((char*)tmpary);
1234 }
1235
1236 apply(type,arg,sarg)
1237 int type;
1238 register ARG *arg;
1239 STR **sarg;
1240 {
1241     STR **tmpary;       /* must not be register */
1242     register STR **elem;
1243     register int items;
1244     register int val;
1245     register int val2;
1246     char *s;
1247
1248     if (sarg) {
1249         tmpary = sarg;
1250         items = 0;
1251         for (elem = tmpary+1; *elem; elem++)
1252             items++;
1253     }
1254     else {
1255         (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
1256         items = (int)str_gnum(*tmpary);
1257     }
1258     switch (type) {
1259     case O_CHMOD:
1260         if (--items > 0) {
1261             val = (int)str_gnum(tmpary[1]);
1262             for (elem = tmpary+2; *elem; elem++)
1263                 if (chmod(str_get(*elem),val))
1264                     items--;
1265         }
1266         break;
1267     case O_CHOWN:
1268         if (items > 2) {
1269             items -= 2;
1270             val = (int)str_gnum(tmpary[1]);
1271             val2 = (int)str_gnum(tmpary[2]);
1272             for (elem = tmpary+3; *elem; elem++)
1273                 if (chown(str_get(*elem),val,val2))
1274                     items--;
1275         }
1276         else
1277             items = 0;
1278         break;
1279     case O_KILL:
1280         if (--items > 0) {
1281             val = (int)str_gnum(tmpary[1]);
1282             if (val < 0) {
1283                 val = -val;
1284                 for (elem = tmpary+2; *elem; elem++)
1285 #ifdef KILLPG
1286                     if (killpg((int)(str_gnum(*elem)),val))     /* BSD */
1287 #else
1288                     if (kill(-(int)(str_gnum(*elem)),val))      /* SYSV */
1289 #endif
1290                         items--;
1291             }
1292             else {
1293                 for (elem = tmpary+2; *elem; elem++)
1294                     if (kill((int)(str_gnum(*elem)),val))
1295                         items--;
1296             }
1297         }
1298         break;
1299     case O_UNLINK:
1300         for (elem = tmpary+1; *elem; elem++) {
1301             s = str_get(*elem);
1302             if (euid || unsafe) {
1303                 if (UNLINK(s))
1304                     items--;
1305             }
1306             else {      /* don't let root wipe out directories without -U */
1307                 if (stat(s,&statbuf) < 0 ||
1308                   (statbuf.st_mode & S_IFMT) == S_IFDIR )
1309                     items--;
1310                 else {
1311                     if (UNLINK(s))
1312                         items--;
1313                 }
1314             }
1315         }
1316         break;
1317     case O_UTIME:
1318         if (items > 2) {
1319             struct {
1320                 long    atime,
1321                         mtime;
1322             } utbuf;
1323
1324             utbuf.atime = (long)str_gnum(tmpary[1]);    /* time accessed */
1325             utbuf.mtime = (long)str_gnum(tmpary[2]);    /* time modified */
1326             items -= 2;
1327             for (elem = tmpary+3; *elem; elem++)
1328                 if (utime(str_get(*elem),&utbuf))
1329                     items--;
1330         }
1331         else
1332             items = 0;
1333         break;
1334     }
1335     if (!sarg)
1336         safefree((char*)tmpary);
1337     return items;
1338 }
1339
1340 STR *
1341 do_subr(arg,sarg)
1342 register ARG *arg;
1343 register STR **sarg;
1344 {
1345     register SUBR *sub;
1346     ARRAY *savearray;
1347     STR *str;
1348     STAB *stab;
1349     char *oldfile = filename;
1350     int oldsave = savestack->ary_fill;
1351     int oldtmps_base = tmps_base;
1352
1353     if (arg[2].arg_type == A_WORD)
1354         stab = arg[2].arg_ptr.arg_stab;
1355     else
1356         stab = stabent(str_get(arg[2].arg_ptr.arg_stab->stab_val),TRUE);
1357     if (!stab) {
1358         if (dowarn)
1359             warn("Undefined subroutine called");
1360         return &str_no;
1361     }
1362     sub = stab->stab_sub;
1363     if (!sub) {
1364         if (dowarn)
1365             warn("Undefined subroutine \"%s\" called", stab->stab_name);
1366         return &str_no;
1367     }
1368     savearray = defstab->stab_array;
1369     defstab->stab_array = anew(defstab);
1370     if (arg[1].arg_flags & AF_SPECIAL)
1371         (void)do_push(arg,defstab->stab_array);
1372     else if (arg[1].arg_type != A_NULL) {
1373         str = str_new(0);
1374         str_sset(str,sarg[1]);
1375         apush(defstab->stab_array,str);
1376     }
1377     sub->depth++;
1378     if (sub->depth >= 2) {      /* save temporaries on recursion? */
1379         if (sub->depth == 100 && dowarn)
1380             warn("Deep recursion on subroutine \"%s\"",stab->stab_name);
1381         savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
1382     }
1383     filename = sub->filename;
1384     tmps_base = tmps_max;
1385
1386     str = cmd_exec(sub->cmd);           /* so do it already */
1387
1388     sub->depth--;       /* assuming no longjumps out of here */
1389     afree(defstab->stab_array);  /* put back old $_[] */
1390     defstab->stab_array = savearray;
1391     filename = oldfile;
1392     tmps_base = oldtmps_base;
1393     if (savestack->ary_fill > oldsave) {
1394         str = str_static(str);  /* in case restore wipes old str */
1395         restorelist(oldsave);
1396     }
1397     return str;
1398 }
1399
1400 void
1401 do_assign(retstr,arg,sarg)
1402 STR *retstr;
1403 register ARG *arg;
1404 register STR **sarg;
1405 {
1406     STR **tmpary;       /* must not be register */
1407     register ARG *larg = arg[1].arg_ptr.arg_arg;
1408     register STR **elem;
1409     register STR *str;
1410     register ARRAY *ary;
1411     register int i;
1412     register int items;
1413     STR *tmpstr;
1414
1415     if (arg[2].arg_flags & AF_SPECIAL) {
1416         (void)eval(arg[2].arg_ptr.arg_arg,&tmpary,-1);
1417         items = (int)str_gnum(*tmpary);
1418     }
1419     else {
1420         tmpary = sarg;
1421         sarg[1] = sarg[2];
1422         sarg[2] = Nullstr;
1423         items = 1;
1424     }
1425
1426     if (arg->arg_flags & AF_COMMON) {   /* always true currently, alas */
1427         if (*(tmpary+1)) {
1428             for (i=2,elem=tmpary+2; i <= items; i++,elem++) {
1429                 *elem = str_static(*elem);
1430             }
1431         }
1432     }
1433     if (larg->arg_type == O_LIST) {
1434         for (i=1,elem=tmpary+1; i <= larg->arg_len; i++) {
1435             switch (larg[i].arg_type) {
1436             case A_STAB:
1437             case A_LVAL:
1438                 str = STAB_STR(larg[i].arg_ptr.arg_stab);
1439                 break;
1440             case A_LEXPR:
1441                 str = eval(larg[i].arg_ptr.arg_arg,Null(STR***),-1);
1442                 break;
1443             }
1444             if (larg->arg_flags & AF_LOCAL) {
1445                 apush(savestack,str);   /* save pointer */
1446                 tmpstr = str_new(0);
1447                 str_sset(tmpstr,str);
1448                 apush(savestack,tmpstr); /* save value */
1449             }
1450             if (*elem)
1451                 str_sset(str,*(elem++));
1452             else
1453                 str_set(str,"");
1454             STABSET(str);
1455         }
1456     }
1457     else {                      /* should be an array name */
1458         ary = larg[1].arg_ptr.arg_stab->stab_array;
1459         for (i=0,elem=tmpary+1; i < items; i++) {
1460             str = str_new(0);
1461             if (*elem)
1462                 str_sset(str,*(elem++));
1463             astore(ary,i,str);
1464         }
1465         ary->ary_fill = items - 1;/* they can get the extra ones back by */
1466     }                           /*   setting $#ary larger than old fill */
1467     str_numset(retstr,(double)items);
1468     STABSET(retstr);
1469     if (tmpary != sarg);
1470         safefree((char*)tmpary);
1471 }
1472
1473 int
1474 do_kv(hash,kv,retary,sarg,ptrmaxsarg,sargoff,cushion)
1475 HASH *hash;
1476 int kv;
1477 STR ***retary;
1478 register STR **sarg;
1479 int *ptrmaxsarg;
1480 int sargoff;
1481 int cushion;
1482 {
1483     register ARRAY *ary;
1484     int max = 0;
1485     int i;
1486     static ARRAY *myarray = Null(ARRAY*);
1487     register HENT *entry;
1488
1489     ary = myarray;
1490     if (!ary)
1491         myarray = ary = anew(Nullstab);
1492     ary->ary_fill = -1;
1493
1494     hiterinit(hash);
1495     while (entry = hiternext(hash)) {
1496         max++;
1497         if (kv == O_KEYS)
1498             apush(ary,str_make(hiterkey(entry)));
1499         else
1500             apush(ary,str_make(str_get(hiterval(entry))));
1501     }
1502     if (retary) { /* array wanted */
1503         *ptrmaxsarg = max + sargoff;
1504         sarg = (STR**)saferealloc((char*)(sarg - sargoff),
1505           (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
1506         for (i = 1; i <= max; i++)
1507             sarg[i] = afetch(ary,i-1);
1508         *retary = sarg;
1509     }
1510     return max;
1511 }
1512
1513 STR *
1514 do_each(hash,retary,sarg,ptrmaxsarg,sargoff,cushion)
1515 HASH *hash;
1516 STR ***retary;
1517 STR **sarg;
1518 int *ptrmaxsarg;
1519 int sargoff;
1520 int cushion;
1521 {
1522     static STR *mystr = Nullstr;
1523     STR *retstr;
1524     HENT *entry = hiternext(hash);
1525
1526     if (mystr) {
1527         str_free(mystr);
1528         mystr = Nullstr;
1529     }
1530
1531     if (retary) { /* array wanted */
1532         if (entry) {
1533             *ptrmaxsarg = 2 + sargoff;
1534             sarg = (STR**)saferealloc((char*)(sarg - sargoff),
1535               (2+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
1536             sarg[1] = mystr = str_make(hiterkey(entry));
1537             retstr = sarg[2] = hiterval(entry);
1538             *retary = sarg;
1539         }
1540         else {
1541             *ptrmaxsarg = sargoff;
1542             sarg = (STR**)saferealloc((char*)(sarg - sargoff),
1543               (2+cushion+sargoff)*sizeof(STR*)) + sargoff;
1544             retstr = Nullstr;
1545             *retary = sarg;
1546         }
1547     }
1548     else
1549         retstr = hiterval(entry);
1550
1551     return retstr;
1552 }
1553
1554 int
1555 mystat(arg,str)
1556 ARG *arg;
1557 STR *str;
1558 {
1559     STIO *stio;
1560
1561     if (arg[1].arg_flags & AF_SPECIAL) {
1562         stio = arg[1].arg_ptr.arg_stab->stab_io;
1563         if (stio && stio->fp)
1564             return fstat(fileno(stio->fp), &statbuf);
1565         else {
1566             if (dowarn)
1567                 warn("Stat on unopened file <%s>",
1568                   arg[1].arg_ptr.arg_stab->stab_name);
1569             return -1;
1570         }
1571     }
1572     else
1573         return stat(str_get(str),&statbuf);
1574 }
1575
1576 STR *
1577 do_fttext(arg,str)
1578 register ARG *arg;
1579 STR *str;
1580 {
1581     int i;
1582     int len;
1583     int odd = 0;
1584     STDCHAR tbuf[512];
1585     register STDCHAR *s;
1586     register STIO *stio;
1587
1588     if (arg[1].arg_flags & AF_SPECIAL) {
1589         stio = arg[1].arg_ptr.arg_stab->stab_io;
1590         if (stio && stio->fp) {
1591 #ifdef STDSTDIO
1592             if (stio->fp->_cnt <= 0) {
1593                 i = getc(stio->fp);
1594                 ungetc(i,stio->fp);
1595             }
1596             if (stio->fp->_cnt <= 0)    /* null file is anything */
1597                 return &str_yes;
1598             len = stio->fp->_cnt + (stio->fp->_ptr - stio->fp->_base);
1599             s = stio->fp->_base;
1600 #else
1601             fatal("-T and -B not implemented on filehandles\n");
1602 #endif
1603         }
1604         else {
1605             if (dowarn)
1606                 warn("Test on unopened file <%s>",
1607                   arg[1].arg_ptr.arg_stab->stab_name);
1608             return &str_no;
1609         }
1610     }
1611     else {
1612         i = open(str_get(str),0);
1613         if (i < 0)
1614             return &str_no;
1615         len = read(i,tbuf,512);
1616         if (len <= 0)           /* null file is anything */
1617             return &str_yes;
1618         close(i);
1619         s = tbuf;
1620     }
1621
1622     /* now scan s to look for textiness */
1623
1624     for (i = 0; i < len; i++,s++) {
1625         if (!*s) {                      /* null never allowed in text */
1626             odd += len;
1627             break;
1628         }
1629         else if (*s & 128)
1630             odd++;
1631         else if (*s < 32 &&
1632           *s != '\n' && *s != '\r' && *s != '\b' &&
1633           *s != '\t' && *s != '\f' && *s != 27)
1634             odd++;
1635     }
1636
1637     if ((odd * 10 > len) == (arg->arg_type == O_FTTEXT)) /* allow 10% odd */
1638         return &str_no;
1639     else
1640         return &str_yes;
1641 }
1642
1643 int
1644 do_study(str)
1645 STR *str;
1646 {
1647     register char *s = str_get(str);
1648     register int pos = str->str_cur;
1649     register int ch;
1650     register int *sfirst;
1651     register int *snext;
1652     static int maxscream = -1;
1653     static STR *lastscream = Nullstr;
1654
1655     if (lastscream && lastscream->str_pok == 5)
1656         lastscream->str_pok &= ~4;
1657     lastscream = str;
1658     if (pos <= 0)
1659         return 0;
1660     if (pos > maxscream) {
1661         if (maxscream < 0) {
1662             maxscream = pos + 80;
1663             screamfirst = (int*)safemalloc((MEM_SIZE)(256 * sizeof(int)));
1664             screamnext = (int*)safemalloc((MEM_SIZE)(maxscream * sizeof(int)));
1665         }
1666         else {
1667             maxscream = pos + pos / 4;
1668             screamnext = (int*)saferealloc((char*)screamnext,
1669                 (MEM_SIZE)(maxscream * sizeof(int)));
1670         }
1671     }
1672
1673     sfirst = screamfirst;
1674     snext = screamnext;
1675
1676     if (!sfirst || !snext)
1677         fatal("do_study: out of memory");
1678
1679     for (ch = 256; ch; --ch)
1680         *sfirst++ = -1;
1681     sfirst -= 256;
1682
1683     while (--pos >= 0) {
1684         ch = s[pos];
1685         if (sfirst[ch] >= 0)
1686             snext[pos] = sfirst[ch] - pos;
1687         else
1688             snext[pos] = -pos;
1689         sfirst[ch] = pos;
1690     }
1691
1692     str->str_pok |= 4;
1693     return 1;
1694 }
1695
1696 init_eval()
1697 {
1698 #define A(e1,e2,e3) (e1+(e2<<1)+(e3<<2))
1699     opargs[O_ITEM] =            A(1,0,0);
1700     opargs[O_ITEM2] =           A(0,0,0);
1701     opargs[O_ITEM3] =           A(0,0,0);
1702     opargs[O_CONCAT] =          A(1,1,0);
1703     opargs[O_MATCH] =           A(1,0,0);
1704     opargs[O_NMATCH] =          A(1,0,0);
1705     opargs[O_SUBST] =           A(1,0,0);
1706     opargs[O_NSUBST] =          A(1,0,0);
1707     opargs[O_ASSIGN] =          A(1,1,0);
1708     opargs[O_MULTIPLY] =        A(1,1,0);
1709     opargs[O_DIVIDE] =          A(1,1,0);
1710     opargs[O_MODULO] =          A(1,1,0);
1711     opargs[O_ADD] =             A(1,1,0);
1712     opargs[O_SUBTRACT] =        A(1,1,0);
1713     opargs[O_LEFT_SHIFT] =      A(1,1,0);
1714     opargs[O_RIGHT_SHIFT] =     A(1,1,0);
1715     opargs[O_LT] =              A(1,1,0);
1716     opargs[O_GT] =              A(1,1,0);
1717     opargs[O_LE] =              A(1,1,0);
1718     opargs[O_GE] =              A(1,1,0);
1719     opargs[O_EQ] =              A(1,1,0);
1720     opargs[O_NE] =              A(1,1,0);
1721     opargs[O_BIT_AND] =         A(1,1,0);
1722     opargs[O_XOR] =             A(1,1,0);
1723     opargs[O_BIT_OR] =          A(1,1,0);
1724     opargs[O_AND] =             A(1,0,0);       /* don't eval arg 2 (yet) */
1725     opargs[O_OR] =              A(1,0,0);       /* don't eval arg 2 (yet) */
1726     opargs[O_COND_EXPR] =       A(1,0,0);       /* don't eval args 2 or 3 */
1727     opargs[O_COMMA] =           A(1,1,0);
1728     opargs[O_NEGATE] =          A(1,0,0);
1729     opargs[O_NOT] =             A(1,0,0);
1730     opargs[O_COMPLEMENT] =      A(1,0,0);
1731     opargs[O_WRITE] =           A(1,0,0);
1732     opargs[O_OPEN] =            A(1,1,0);
1733     opargs[O_TRANS] =           A(1,0,0);
1734     opargs[O_NTRANS] =          A(1,0,0);
1735     opargs[O_CLOSE] =           A(0,0,0);
1736     opargs[O_ARRAY] =           A(1,0,0);
1737     opargs[O_HASH] =            A(1,0,0);
1738     opargs[O_LARRAY] =          A(1,0,0);
1739     opargs[O_LHASH] =           A(1,0,0);
1740     opargs[O_PUSH] =            A(1,0,0);
1741     opargs[O_POP] =             A(0,0,0);
1742     opargs[O_SHIFT] =           A(0,0,0);
1743     opargs[O_SPLIT] =           A(1,0,0);
1744     opargs[O_LENGTH] =          A(1,0,0);
1745     opargs[O_SPRINTF] =         A(1,0,0);
1746     opargs[O_SUBSTR] =          A(1,1,1);
1747     opargs[O_JOIN] =            A(1,0,0);
1748     opargs[O_SLT] =             A(1,1,0);
1749     opargs[O_SGT] =             A(1,1,0);
1750     opargs[O_SLE] =             A(1,1,0);
1751     opargs[O_SGE] =             A(1,1,0);
1752     opargs[O_SEQ] =             A(1,1,0);
1753     opargs[O_SNE] =             A(1,1,0);
1754     opargs[O_SUBR] =            A(1,0,0);
1755     opargs[O_PRINT] =           A(1,1,0);
1756     opargs[O_CHDIR] =           A(1,0,0);
1757     opargs[O_DIE] =             A(1,0,0);
1758     opargs[O_EXIT] =            A(1,0,0);
1759     opargs[O_RESET] =           A(1,0,0);
1760     opargs[O_LIST] =            A(0,0,0);
1761     opargs[O_EOF] =             A(1,0,0);
1762     opargs[O_TELL] =            A(1,0,0);
1763     opargs[O_SEEK] =            A(1,1,1);
1764     opargs[O_LAST] =            A(1,0,0);
1765     opargs[O_NEXT] =            A(1,0,0);
1766     opargs[O_REDO] =            A(1,0,0);
1767     opargs[O_GOTO] =            A(1,0,0);
1768     opargs[O_INDEX] =           A(1,1,0);
1769     opargs[O_TIME] =            A(0,0,0);
1770     opargs[O_TMS] =             A(0,0,0);
1771     opargs[O_LOCALTIME] =       A(1,0,0);
1772     opargs[O_GMTIME] =          A(1,0,0);
1773     opargs[O_STAT] =            A(1,0,0);
1774     opargs[O_CRYPT] =           A(1,1,0);
1775     opargs[O_EXP] =             A(1,0,0);
1776     opargs[O_LOG] =             A(1,0,0);
1777     opargs[O_SQRT] =            A(1,0,0);
1778     opargs[O_INT] =             A(1,0,0);
1779     opargs[O_PRTF] =            A(1,1,0);
1780     opargs[O_ORD] =             A(1,0,0);
1781     opargs[O_SLEEP] =           A(1,0,0);
1782     opargs[O_FLIP] =            A(1,0,0);
1783     opargs[O_FLOP] =            A(0,1,0);
1784     opargs[O_KEYS] =            A(0,0,0);
1785     opargs[O_VALUES] =          A(0,0,0);
1786     opargs[O_EACH] =            A(0,0,0);
1787     opargs[O_CHOP] =            A(1,0,0);
1788     opargs[O_FORK] =            A(1,0,0);
1789     opargs[O_EXEC] =            A(1,0,0);
1790     opargs[O_SYSTEM] =          A(1,0,0);
1791     opargs[O_OCT] =             A(1,0,0);
1792     opargs[O_HEX] =             A(1,0,0);
1793     opargs[O_CHMOD] =           A(1,0,0);
1794     opargs[O_CHOWN] =           A(1,0,0);
1795     opargs[O_KILL] =            A(1,0,0);
1796     opargs[O_RENAME] =          A(1,1,0);
1797     opargs[O_UNLINK] =          A(1,0,0);
1798     opargs[O_UMASK] =           A(1,0,0);
1799     opargs[O_UNSHIFT] =         A(1,0,0);
1800     opargs[O_LINK] =            A(1,1,0);
1801     opargs[O_REPEAT] =          A(1,1,0);
1802     opargs[O_EVAL] =            A(1,0,0);
1803     opargs[O_FTEREAD] =         A(1,0,0);
1804     opargs[O_FTEWRITE] =        A(1,0,0);
1805     opargs[O_FTEEXEC] =         A(1,0,0);
1806     opargs[O_FTEOWNED] =        A(1,0,0);
1807     opargs[O_FTRREAD] =         A(1,0,0);
1808     opargs[O_FTRWRITE] =        A(1,0,0);
1809     opargs[O_FTREXEC] =         A(1,0,0);
1810     opargs[O_FTROWNED] =        A(1,0,0);
1811     opargs[O_FTIS] =            A(1,0,0);
1812     opargs[O_FTZERO] =          A(1,0,0);
1813     opargs[O_FTSIZE] =          A(1,0,0);
1814     opargs[O_FTFILE] =          A(1,0,0);
1815     opargs[O_FTDIR] =           A(1,0,0);
1816     opargs[O_FTLINK] =          A(1,0,0);
1817     opargs[O_SYMLINK] =         A(1,1,0);
1818     opargs[O_FTPIPE] =          A(1,0,0);
1819     opargs[O_FTSUID] =          A(1,0,0);
1820     opargs[O_FTSGID] =          A(1,0,0);
1821     opargs[O_FTSVTX] =          A(1,0,0);
1822     opargs[O_FTCHR] =           A(1,0,0);
1823     opargs[O_FTBLK] =           A(1,0,0);
1824     opargs[O_FTSOCK] =          A(1,0,0);
1825     opargs[O_FTTTY] =           A(1,0,0);
1826     opargs[O_DOFILE] =          A(1,0,0);
1827     opargs[O_FTTEXT] =          A(1,0,0);
1828     opargs[O_FTBINARY] =        A(1,0,0);
1829     opargs[O_UTIME] =           A(1,0,0);
1830     opargs[O_WAIT] =            A(0,0,0);
1831     opargs[O_SORT] =            A(1,0,0);
1832     opargs[O_STUDY] =           A(1,0,0);
1833     opargs[O_DELETE] =          A(1,0,0);
1834 }