dolist.c

   1 /* $Header: dolist.c,v 3.0.1.4 89/12/21 19:58:46 lwall Locked $
   2  *
   3  *    Copyright (c) 1989, Larry Wall
   4  *
   5  *    You may distribute under the terms of the GNU General Public License
   6  *    as specified in the README file that comes with the perl 3.0 kit.
   7  *
   8  * $Log:        dolist.c,v $
   9  * Revision 3.0.1.4  89/12/21  19:58:46  lwall
  10  * patch7: grep(1,@array) didn't work
  11  * patch7: /$pat/; //; wrongly freed runtime pattern twice
  12  *
  13  * Revision 3.0.1.3  89/11/17  15:14:45  lwall
  14  * patch5: grep() occasionally loses arguments or dumps core
  15  *
  16  * Revision 3.0.1.2  89/11/11  04:28:17  lwall
  17  * patch2: non-existent slice values are now undefined rather than null
  18  *
  19  * Revision 3.0.1.1  89/10/26  23:11:51  lwall
  20  * patch1: split in a subroutine wrongly freed referenced arguments
  21  * patch1: reverse didn't work
  22  *
  23  * Revision 3.0  89/10/18  15:11:02  lwall
  24  * 3.0 baseline
  25  *
  26  */
  27
  28 #include "EXTERN.h"
  29 #include "perl.h"
  30
  31
  32 int
  33 do_match(str,arg,gimme,arglast)
  34 STR *str;
  35 register ARG *arg;
  36 int gimme;
  37 int *arglast;
  38 {
  39     register STR **st = stack->ary_array;
  40     register SPAT *spat = arg[2].arg_ptr.arg_spat;
  41     register char *t;
  42     register int sp = arglast[0] + 1;
  43     STR *srchstr = st[sp];
  44     register char *s = str_get(st[sp]);
  45     char *strend = s + st[sp]->str_cur;
  46     STR *tmpstr;
  47
  48     if (!spat) {
  49         if (gimme == G_ARRAY)
  50             return --sp;
  51         str_set(str,Yes);
  52         STABSET(str);
  53         st[sp] = str;
  54         return sp;
  55     }
  56     if (!s)
  57         fatal("panic: do_match");
  58     if (spat->spat_flags & SPAT_USED) {
  59 #ifdef DEBUGGING
  60         if (debug & 8)
  61             deb("2.SPAT USED\n");
  62 #endif
  63         if (gimme == G_ARRAY)
  64             return --sp;
  65         str_set(str,No);
  66         STABSET(str);
  67         st[sp] = str;
  68         return sp;
  69     }
  70     --sp;
  71     if (spat->spat_runtime) {
  72         nointrp = "|)";
  73         sp = eval(spat->spat_runtime,G_SCALAR,sp);
  74         st = stack->ary_array;
  75         t = str_get(tmpstr = st[sp--]);
  76         nointrp = "";
  77 #ifdef DEBUGGING
  78         if (debug & 8)
  79             deb("2.SPAT /%s/\n",t);
  80 #endif
  81         if (spat->spat_regexp)
  82             regfree(spat->spat_regexp);
  83         spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
  84             spat->spat_flags & SPAT_FOLD,1);
  85         if (!*spat->spat_regexp->precomp && lastspat)
  86             spat = lastspat;
  87         if (spat->spat_flags & SPAT_KEEP) {
  88             if (spat->spat_runtime)
  89                 arg_free(spat->spat_runtime);   /* it won't change, so */
  90             spat->spat_runtime = Nullarg;       /* no point compiling again */
  91         }
  92         if (!spat->spat_regexp->nparens)
  93             gimme = G_SCALAR;                   /* accidental array context? */
  94         if (regexec(spat->spat_regexp, s, strend, s, 0,
  95           srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
  96           gimme == G_ARRAY)) {
  97             if (spat->spat_regexp->subbase)
  98                 curspat = spat;
  99             lastspat = spat;
 100             goto gotcha;
 101         }
 102         else {
 103             if (gimme == G_ARRAY)
 104                 return sp;
 105             str_sset(str,&str_no);
 106             STABSET(str);
 107             st[++sp] = str;
 108             return sp;
 109         }
 110     }
 111     else {
 112 #ifdef DEBUGGING
 113         if (debug & 8) {
 114             char ch;
 115
 116             if (spat->spat_flags & SPAT_ONCE)
 117                 ch = '?';
 118             else
 119                 ch = '/';
 120             deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
 121         }
 122 #endif
 123         if (!*spat->spat_regexp->precomp && lastspat)
 124             spat = lastspat;
 125         t = s;
 126         if (hint) {
 127             if (hint < s || hint > strend)
 128                 fatal("panic: hint in do_match");
 129             s = hint;
 130             hint = Nullch;
 131             if (spat->spat_regexp->regback >= 0) {
 132                 s -= spat->spat_regexp->regback;
 133                 if (s < t)
 134                     s = t;
 135             }
 136             else
 137                 s = t;
 138         }
 139         else if (spat->spat_short) {
 140             if (spat->spat_flags & SPAT_SCANFIRST) {
 141                 if (srchstr->str_pok & SP_STUDIED) {
 142                     if (screamfirst[spat->spat_short->str_rare] < 0)
 143                         goto nope;
 144                     else if (!(s = screaminstr(srchstr,spat->spat_short)))
 145                         goto nope;
 146                     else if (spat->spat_flags & SPAT_ALL)
 147                         goto yup;
 148                 }
 149 #ifndef lint
 150                 else if (!(s = fbminstr((unsigned char*)s,
 151                   (unsigned char*)strend, spat->spat_short)))
 152                     goto nope;
 153 #endif
 154                 else if (spat->spat_flags & SPAT_ALL)
 155                     goto yup;
 156                 if (s && spat->spat_regexp->regback >= 0) {
 157                     ++spat->spat_short->str_u.str_useful;
 158                     s -= spat->spat_regexp->regback;
 159                     if (s < t)
 160                         s = t;
 161                 }
 162                 else
 163                     s = t;
 164             }
 165             else if (!multiline && (*spat->spat_short->str_ptr != *s ||
 166               bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
 167                 goto nope;
 168             if (--spat->spat_short->str_u.str_useful < 0) {
 169                 str_free(spat->spat_short);
 170                 spat->spat_short = Nullstr;     /* opt is being useless */
 171             }
 172         }
 173         if (!spat->spat_regexp->nparens)
 174             gimme = G_SCALAR;                   /* accidental array context? */
 175         if (regexec(spat->spat_regexp, s, strend, t, 0,
 176           srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
 177           gimme == G_ARRAY)) {
 178             if (spat->spat_regexp->subbase)
 179                 curspat = spat;
 180             lastspat = spat;
 181             if (spat->spat_flags & SPAT_ONCE)
 182                 spat->spat_flags |= SPAT_USED;
 183             goto gotcha;
 184         }
 185         else {
 186             if (gimme == G_ARRAY)
 187                 return sp;
 188             str_sset(str,&str_no);
 189             STABSET(str);
 190             st[++sp] = str;
 191             return sp;
 192         }
 193     }
 194     /*NOTREACHED*/
 195
 196   gotcha:
 197     if (gimme == G_ARRAY) {
 198         int iters, i, len;
 199
 200         iters = spat->spat_regexp->nparens;
 201         if (sp + iters >= stack->ary_max) {
 202             astore(stack,sp + iters, Nullstr);
 203             st = stack->ary_array;              /* possibly realloced */
 204         }
 205
 206         for (i = 1; i <= iters; i++) {
 207             st[++sp] = str_static(&str_no);
 208             if (s = spat->spat_regexp->startp[i]) {
 209                 len = spat->spat_regexp->endp[i] - s;
 210                 if (len > 0)
 211                     str_nset(st[sp],s,len);
 212             }
 213         }
 214         return sp;
 215     }
 216     else {
 217         str_sset(str,&str_yes);
 218         STABSET(str);
 219         st[++sp] = str;
 220         return sp;
 221     }
 222
 223 yup:
 224     ++spat->spat_short->str_u.str_useful;
 225     lastspat = spat;
 226     if (spat->spat_flags & SPAT_ONCE)
 227         spat->spat_flags |= SPAT_USED;
 228     if (sawampersand) {
 229         char *tmps;
 230
 231         tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
 232         tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
 233         spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
 234         curspat = spat;
 235     }
 236     str_sset(str,&str_yes);
 237     STABSET(str);
 238     st[++sp] = str;
 239     return sp;
 240
 241 nope:
 242     ++spat->spat_short->str_u.str_useful;
 243     if (gimme == G_ARRAY)
 244         return sp;
 245     str_sset(str,&str_no);
 246     STABSET(str);
 247     st[++sp] = str;
 248     return sp;
 249 }
 250
 251 int
 252 do_split(str,spat,limit,gimme,arglast)
 253 STR *str;
 254 register SPAT *spat;
 255 register int limit;
 256 int gimme;
 257 int *arglast;
 258 {
 259     register ARRAY *ary = stack;
 260     STR **st = ary->ary_array;
 261     register int sp = arglast[0] + 1;
 262     register char *s = str_get(st[sp]);
 263     char *strend = s + st[sp--]->str_cur;
 264     register STR *dstr;
 265     register char *m;
 266     int iters = 0;
 267     int i;
 268     char *orig;
 269     int origlimit = limit;
 270     int realarray = 0;
 271
 272     if (!spat || !s)
 273         fatal("panic: do_split");
 274     else if (spat->spat_runtime) {
 275         nointrp = "|)";
 276         sp = eval(spat->spat_runtime,G_SCALAR,sp);
 277         st = stack->ary_array;
 278         m = str_get(dstr = st[sp--]);
 279         nointrp = "";
 280         if (!dstr->str_cur || (*m == ' ' && dstr->str_cur == 1)) {
 281             str_set(dstr,"\\s+");
 282             m = dstr->str_ptr;
 283             spat->spat_flags |= SPAT_SKIPWHITE;
 284         }
 285         if (spat->spat_regexp)
 286             regfree(spat->spat_regexp);
 287         spat->spat_regexp = regcomp(m,m+dstr->str_cur,
 288             spat->spat_flags & SPAT_FOLD,1);
 289         if (spat->spat_flags & SPAT_KEEP ||
 290             (spat->spat_runtime->arg_type == O_ITEM &&
 291               (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
 292             arg_free(spat->spat_runtime);       /* it won't change, so */
 293             spat->spat_runtime = Nullarg;       /* no point compiling again */
 294         }
 295     }
 296 #ifdef DEBUGGING
 297     if (debug & 8) {
 298         deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
 299     }
 300 #endif
 301     ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
 302     if (ary && ((ary->ary_flags & ARF_REAL) || gimme != G_ARRAY)) {
 303         realarray = 1;
 304         if (!(ary->ary_flags & ARF_REAL)) {
 305             ary->ary_flags |= ARF_REAL;
 306             for (i = ary->ary_fill; i >= 0; i--)
 307                 ary->ary_array[i] = Nullstr;    /* don't free mere refs */
 308         }
 309         ary->ary_fill = -1;
 310         sp = -1;        /* temporarily switch stacks */
 311     }
 312     else
 313         ary = stack;
 314     orig = s;
 315     if (spat->spat_flags & SPAT_SKIPWHITE) {
 316         while (isspace(*s))
 317             s++;
 318     }
 319     if (!limit)
 320         limit = 10001;
 321     if (spat->spat_short) {
 322         i = spat->spat_short->str_cur;
 323         if (i == 1) {
 324             i = *spat->spat_short->str_ptr;
 325             while (--limit) {
 326                 for (m = s; m < strend && *m != i; m++) ;
 327                 if (m >= strend)
 328                     break;
 329                 if (realarray)
 330                     dstr = Str_new(30,m-s);
 331                 else
 332                     dstr = str_static(&str_undef);
 333                 str_nset(dstr,s,m-s);
 334                 (void)astore(ary, ++sp, dstr);
 335                 s = m + 1;
 336             }
 337         }
 338         else {
 339 #ifndef lint
 340             while (s < strend && --limit &&
 341               (m=fbminstr((unsigned char*)s, (unsigned char*)strend,
 342                     spat->spat_short)) )
 343 #endif
 344             {
 345                 if (realarray)
 346                     dstr = Str_new(31,m-s);
 347                 else
 348                     dstr = str_static(&str_undef);
 349                 str_nset(dstr,s,m-s);
 350                 (void)astore(ary, ++sp, dstr);
 351                 s = m + i;
 352             }
 353         }
 354     }
 355     else {
 356         while (s < strend && --limit &&
 357             regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
 358             if (spat->spat_regexp->subbase
 359               && spat->spat_regexp->subbase != orig) {
 360                 m = s;
 361                 s = orig;
 362                 orig = spat->spat_regexp->subbase;
 363                 s = orig + (m - s);
 364                 strend = s + (strend - m);
 365             }
 366             m = spat->spat_regexp->startp[0];
 367             if (realarray)
 368                 dstr = Str_new(32,m-s);
 369             else
 370                 dstr = str_static(&str_undef);
 371             str_nset(dstr,s,m-s);
 372             (void)astore(ary, ++sp, dstr);
 373             if (spat->spat_regexp->nparens) {
 374                 for (i = 1; i <= spat->spat_regexp->nparens; i++) {
 375                     s = spat->spat_regexp->startp[i];
 376                     m = spat->spat_regexp->endp[i];
 377                     if (realarray)
 378                         dstr = Str_new(33,m-s);
 379                     else
 380                         dstr = str_static(&str_undef);
 381                     str_nset(dstr,s,m-s);
 382                     (void)astore(ary, ++sp, dstr);
 383                 }
 384             }
 385             s = spat->spat_regexp->endp[0];
 386         }
 387     }
 388     if (realarray)
 389         iters = sp + 1;
 390     else
 391         iters = sp - arglast[0];
 392     if (iters > 9999)
 393         fatal("Split loop");
 394     if (s < strend || origlimit) {      /* keep field after final delim? */
 395         if (realarray)
 396             dstr = Str_new(34,strend-s);
 397         else
 398             dstr = str_static(&str_undef);
 399         str_nset(dstr,s,strend-s);
 400         (void)astore(ary, ++sp, dstr);
 401         iters++;
 402     }
 403     else {
 404 #ifndef I286
 405         while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
 406             iters--,sp--;
 407 #else
 408         char *zaps;
 409         int   zapb;
 410
 411         if (iters > 0) {
 412                 zaps = str_get(afetch(ary,sp,FALSE));
 413                 zapb = (int) *zaps;
 414         }
 415
 416         while (iters > 0 && (!zapb)) {
 417             iters--,sp--;
 418             if (iters > 0) {
 419                 zaps = str_get(afetch(ary,iters-1,FALSE));
 420                 zapb = (int) *zaps;
 421             }
 422         }
 423 #endif
 424     }
 425     if (realarray) {
 426         ary->ary_fill = sp;
 427         if (gimme == G_ARRAY) {
 428             sp++;
 429             astore(stack, arglast[0] + 1 + sp, Nullstr);
 430             Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*);
 431             return arglast[0] + sp;
 432         }
 433     }
 434     else {
 435         if (gimme == G_ARRAY)
 436             return sp;
 437     }
 438     sp = arglast[0] + 1;
 439     str_numset(str,(double)iters);
 440     STABSET(str);
 441     st[sp] = str;
 442     return sp;
 443 }
 444
 445 int
 446 do_unpack(str,gimme,arglast)
 447 STR *str;
 448 int gimme;
 449 int *arglast;
 450 {
 451     STR **st = stack->ary_array;
 452     register int sp = arglast[0] + 1;
 453     register char *pat = str_get(st[sp++]);
 454     register char *s = str_get(st[sp]);
 455     char *strend = s + st[sp--]->str_cur;
 456     register char *patend = pat + st[sp]->str_cur;
 457     int datumtype;
 458     register int len;
 459
 460     /* These must not be in registers: */
 461     char achar;
 462     short ashort;
 463     int aint;
 464     long along;
 465     unsigned char auchar;
 466     unsigned short aushort;
 467     unsigned int auint;
 468     unsigned long aulong;
 469     char *aptr;
 470
 471     if (gimme != G_ARRAY) {
 472         str_sset(str,&str_undef);
 473         STABSET(str);
 474         st[sp] = str;
 475         return sp;
 476     }
 477     sp--;
 478     while (pat < patend) {
 479         datumtype = *pat++;
 480         if (isdigit(*pat)) {
 481             len = atoi(pat);
 482             while (isdigit(*pat))
 483                 pat++;
 484         }
 485         else
 486             len = 1;
 487         switch(datumtype) {
 488         default:
 489             break;
 490         case 'x':
 491             s += len;
 492             break;
 493         case 'A':
 494         case 'a':
 495             if (s + len > strend)
 496                 len = strend - s;
 497             str = Str_new(35,len);
 498             str_nset(str,s,len);
 499             s += len;
 500             if (datumtype == 'A') {
 501                 aptr = s;       /* borrow register */
 502                 s = str->str_ptr + len - 1;
 503                 while (s >= str->str_ptr && (!*s || isspace(*s)))
 504                     s--;
 505                 *++s = '\0';
 506                 str->str_cur = s - str->str_ptr;
 507                 s = aptr;       /* unborrow register */
 508             }
 509             (void)astore(stack, ++sp, str_2static(str));
 510             break;
 511         case 'c':
 512             while (len-- > 0) {
 513                 if (s + sizeof(char) > strend)
 514                     achar = 0;
 515                 else {
 516                     bcopy(s,(char*)&achar,sizeof(char));
 517                     s += sizeof(char);
 518                 }
 519                 str = Str_new(36,0);
 520                 aint = achar;
 521                 if (aint >= 128)        /* fake up signed chars */
 522                     aint -= 256;
 523                 str_numset(str,(double)aint);
 524                 (void)astore(stack, ++sp, str_2static(str));
 525             }
 526             break;
 527         case 'C':
 528             while (len-- > 0) {
 529                 if (s + sizeof(unsigned char) > strend)
 530                     auchar = 0;
 531                 else {
 532                     bcopy(s,(char*)&auchar,sizeof(unsigned char));
 533                     s += sizeof(unsigned char);
 534                 }
 535                 str = Str_new(37,0);
 536                 auint = auchar;         /* some can't cast uchar to double */
 537                 str_numset(str,(double)auint);
 538                 (void)astore(stack, ++sp, str_2static(str));
 539             }
 540             break;
 541         case 's':
 542             while (len-- > 0) {
 543                 if (s + sizeof(short) > strend)
 544                     ashort = 0;
 545                 else {
 546                     bcopy(s,(char*)&ashort,sizeof(short));
 547                     s += sizeof(short);
 548                 }
 549                 str = Str_new(38,0);
 550                 str_numset(str,(double)ashort);
 551                 (void)astore(stack, ++sp, str_2static(str));
 552             }
 553             break;
 554         case 'n':
 555         case 'S':
 556             while (len-- > 0) {
 557                 if (s + sizeof(unsigned short) > strend)
 558                     aushort = 0;
 559                 else {
 560                     bcopy(s,(char*)&aushort,sizeof(unsigned short));
 561                     s += sizeof(unsigned short);
 562                 }
 563                 str = Str_new(39,0);
 564 #ifdef NTOHS
 565                 if (datumtype == 'n')
 566                     aushort = ntohs(aushort);
 567 #endif
 568                 str_numset(str,(double)aushort);
 569                 (void)astore(stack, ++sp, str_2static(str));
 570             }
 571             break;
 572         case 'i':
 573             while (len-- > 0) {
 574                 if (s + sizeof(int) > strend)
 575                     aint = 0;
 576                 else {
 577                     bcopy(s,(char*)&aint,sizeof(int));
 578                     s += sizeof(int);
 579                 }
 580                 str = Str_new(40,0);
 581                 str_numset(str,(double)aint);
 582                 (void)astore(stack, ++sp, str_2static(str));
 583             }
 584             break;
 585         case 'I':
 586             while (len-- > 0) {
 587                 if (s + sizeof(unsigned int) > strend)
 588                     auint = 0;
 589                 else {
 590                     bcopy(s,(char*)&auint,sizeof(unsigned int));
 591                     s += sizeof(unsigned int);
 592                 }
 593                 str = Str_new(41,0);
 594                 str_numset(str,(double)auint);
 595                 (void)astore(stack, ++sp, str_2static(str));
 596             }
 597             break;
 598         case 'l':
 599             while (len-- > 0) {
 600                 if (s + sizeof(long) > strend)
 601                     along = 0;
 602                 else {
 603                     bcopy(s,(char*)&along,sizeof(long));
 604                     s += sizeof(long);
 605                 }
 606                 str = Str_new(42,0);
 607                 str_numset(str,(double)along);
 608                 (void)astore(stack, ++sp, str_2static(str));
 609             }
 610             break;
 611         case 'N':
 612         case 'L':
 613             while (len-- > 0) {
 614                 if (s + sizeof(unsigned long) > strend)
 615                     aulong = 0;
 616                 else {
 617                     bcopy(s,(char*)&aulong,sizeof(unsigned long));
 618                     s += sizeof(unsigned long);
 619                 }
 620                 str = Str_new(43,0);
 621 #ifdef NTOHL
 622                 if (datumtype == 'N')
 623                     aulong = ntohl(aulong);
 624 #endif
 625                 str_numset(str,(double)aulong);
 626                 (void)astore(stack, ++sp, str_2static(str));
 627             }
 628             break;
 629         case 'p':
 630             while (len-- > 0) {
 631                 if (s + sizeof(char*) > strend)
 632                     aptr = 0;
 633                 else {
 634                     bcopy(s,(char*)&aptr,sizeof(char*));
 635                     s += sizeof(char*);
 636                 }
 637                 str = Str_new(44,0);
 638                 if (aptr)
 639                     str_set(str,aptr);
 640                 (void)astore(stack, ++sp, str_2static(str));
 641             }
 642             break;
 643         }
 644     }
 645     return sp;
 646 }
 647
 648 int
 649 do_slice(stab,numarray,lval,gimme,arglast)
 650 register STAB *stab;
 651 int numarray;
 652 int lval;
 653 int gimme;
 654 int *arglast;
 655 {
 656     register STR **st = stack->ary_array;
 657     register int sp = arglast[1];
 658     register int max = arglast[2];
 659     register char *tmps;
 660     register int len;
 661     register int magic = 0;
 662
 663     if (lval && !numarray) {
 664         if (stab == envstab)
 665             magic = 'E';
 666         else if (stab == sigstab)
 667             magic = 'S';
 668 #ifdef SOME_DBM
 669         else if (stab_hash(stab)->tbl_dbm)
 670             magic = 'D';
 671 #endif /* SOME_DBM */
 672     }
 673
 674     if (gimme == G_ARRAY) {
 675         if (numarray) {
 676             while (sp < max) {
 677                 if (st[++sp]) {
 678                     st[sp-1] = afetch(stab_array(stab),(int)str_gnum(st[sp]),
 679                         lval);
 680                 }
 681                 else
 682                     st[sp-1] = &str_undef;
 683             }
 684         }
 685         else {
 686             while (sp < max) {
 687                 if (st[++sp]) {
 688                     tmps = str_get(st[sp]);
 689                     len = st[sp]->str_cur;
 690                     st[sp-1] = hfetch(stab_hash(stab),tmps,len, lval);
 691                     if (magic)
 692                         str_magic(st[sp-1],stab,magic,tmps,len);
 693                 }
 694                 else
 695                     st[sp-1] = &str_undef;
 696             }
 697         }
 698         sp--;
 699     }
 700     else {
 701         if (numarray) {
 702             if (st[max])
 703                 st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval);
 704             else
 705                 st[sp] = &str_undef;
 706         }
 707         else {
 708             if (st[max]) {
 709                 tmps = str_get(st[max]);
 710                 len = st[max]->str_cur;
 711                 st[sp] = hfetch(stab_hash(stab),tmps,len, lval);
 712                 if (magic)
 713                     str_magic(st[sp],stab,magic,tmps,len);
 714             }
 715             else
 716                 st[sp] = &str_undef;
 717         }
 718     }
 719     return sp;
 720 }
 721
 722 int
 723 do_grep(arg,str,gimme,arglast)
 724 register ARG *arg;
 725 STR *str;
 726 int gimme;
 727 int *arglast;
 728 {
 729     STR **st = stack->ary_array;
 730     register int dst = arglast[1];
 731     register int src = dst + 1;
 732     register int sp = arglast[2];
 733     register int i = sp - arglast[1];
 734     int oldsave = savestack->ary_fill;
 735
 736     savesptr(&stab_val(defstab));
 737     if ((arg[1].arg_type & A_MASK) != A_EXPR) {
 738         arg[1].arg_type &= A_MASK;
 739         dehoist(arg,1);
 740         arg[1].arg_type |= A_DONT;
 741     }
 742     arg = arg[1].arg_ptr.arg_arg;
 743     while (i-- > 0) {
 744         stab_val(defstab) = st[src];
 745         (void)eval(arg,G_SCALAR,sp);
 746         st = stack->ary_array;
 747         if (str_true(st[sp+1]))
 748             st[dst++] = st[src];
 749         src++;
 750     }
 751     restorelist(oldsave);
 752     if (gimme != G_ARRAY) {
 753         str_sset(str,&str_undef);
 754         STABSET(str);
 755         st[arglast[0]+1] = str;
 756         return arglast[0]+1;
 757     }
 758     return arglast[0] + (dst - arglast[1]);
 759 }
 760
 761 int
 762 do_reverse(str,gimme,arglast)
 763 STR *str;
 764 int gimme;
 765 int *arglast;
 766 {
 767     STR **st = stack->ary_array;
 768     register STR **up = &st[arglast[1]];
 769     register STR **down = &st[arglast[2]];
 770     register int i = arglast[2] - arglast[1];
 771
 772     if (gimme != G_ARRAY) {
 773         str_sset(str,&str_undef);
 774         STABSET(str);
 775         st[arglast[0]+1] = str;
 776         return arglast[0]+1;
 777     }
 778     while (i-- > 0) {
 779         *up++ = *down;
 780         if (i-- > 0)
 781             *down-- = *up;
 782     }
 783     i = arglast[2] - arglast[1];
 784     Copy(down+1,up,i/2,STR*);
 785     return arglast[2] - 1;
 786 }
 787
 788 static CMD *sortcmd;
 789 static STAB *firststab = Nullstab;
 790 static STAB *secondstab = Nullstab;
 791
 792 int
 793 do_sort(str,stab,gimme,arglast)
 794 STR *str;
 795 STAB *stab;
 796 int gimme;
 797 int *arglast;
 798 {
 799     STR **st = stack->ary_array;
 800     int sp = arglast[1];
 801     register STR **up;
 802     register int max = arglast[2] - sp;
 803     register int i;
 804     int sortcmp();
 805     int sortsub();
 806     STR *oldfirst;
 807     STR *oldsecond;
 808     ARRAY *oldstack;
 809     static ARRAY *sortstack = Null(ARRAY*);
 810
 811     if (gimme != G_ARRAY) {
 812         str_sset(str,&str_undef);
 813         STABSET(str);
 814         st[sp] = str;
 815         return sp;
 816     }
 817     up = &st[sp];
 818     for (i = 0; i < max; i++) {
 819         if ((*up = up[1]) && !(*up)->str_pok)
 820             (void)str_2ptr(*up);
 821         up++;
 822     }
 823     sp--;
 824     if (max > 1) {
 825         if (stab_sub(stab) && (sortcmd = stab_sub(stab)->cmd)) {
 826             int oldtmps_base = tmps_base;
 827
 828             if (!sortstack) {
 829                 sortstack = anew(Nullstab);
 830                 sortstack->ary_flags = 0;
 831             }
 832             oldstack = stack;
 833             stack = sortstack;
 834             tmps_base = tmps_max;
 835             if (!firststab) {
 836                 firststab = stabent("a",TRUE);
 837                 secondstab = stabent("b",TRUE);
 838             }
 839             oldfirst = stab_val(firststab);
 840             oldsecond = stab_val(secondstab);
 841 #ifndef lint
 842             qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub);
 843 #else
 844             qsort(Nullch,max,sizeof(STR*),sortsub);
 845 #endif
 846             stab_val(firststab) = oldfirst;
 847             stab_val(secondstab) = oldsecond;
 848             tmps_base = oldtmps_base;
 849             stack = oldstack;
 850         }
 851 #ifndef lint
 852         else
 853             qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
 854 #endif
 855     }
 856     up = &st[arglast[1]];
 857     while (max > 0 && !*up)
 858         max--,up--;
 859     return sp+max;
 860 }
 861
 862 int
 863 sortsub(str1,str2)
 864 STR **str1;
 865 STR **str2;
 866 {
 867     if (!*str1)
 868         return -1;
 869     if (!*str2)
 870         return 1;
 871     stab_val(firststab) = *str1;
 872     stab_val(secondstab) = *str2;
 873     cmd_exec(sortcmd,G_SCALAR,-1);
 874     return (int)str_gnum(*stack->ary_array);
 875 }
 876
 877 sortcmp(strp1,strp2)
 878 STR **strp1;
 879 STR **strp2;
 880 {
 881     register STR *str1 = *strp1;
 882     register STR *str2 = *strp2;
 883     int retval;
 884
 885     if (!str1)
 886         return -1;
 887     if (!str2)
 888         return 1;
 889
 890     if (str1->str_cur < str2->str_cur) {
 891         if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
 892             return retval;
 893         else
 894             return -1;
 895     }
 896     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
 897         return retval;
 898     else if (str1->str_cur == str2->str_cur)
 899         return 0;
 900     else
 901         return 1;
 902 }
 903
 904 int
 905 do_range(gimme,arglast)
 906 int gimme;
 907 int *arglast;
 908 {
 909     STR **st = stack->ary_array;
 910     register int sp = arglast[0];
 911     register int i = (int)str_gnum(st[sp+1]);
 912     register ARRAY *ary = stack;
 913     register STR *str;
 914     int max = (int)str_gnum(st[sp+2]);
 915
 916     if (gimme != G_ARRAY)
 917         fatal("panic: do_range");
 918
 919     while (i <= max) {
 920         (void)astore(ary, ++sp, str = str_static(&str_no));
 921         str_numset(str,(double)i++);
 922     }
 923     return sp;
 924 }
 925
 926 int
 927 do_tms(str,gimme,arglast)
 928 STR *str;
 929 int gimme;
 930 int *arglast;
 931 {
 932     STR **st = stack->ary_array;
 933     register int sp = arglast[0];
 934
 935     if (gimme != G_ARRAY) {
 936         str_sset(str,&str_undef);
 937         STABSET(str);
 938         st[++sp] = str;
 939         return sp;
 940     }
 941     (void)times(&timesbuf);
 942
 943 #ifndef HZ
 944 #define HZ 60
 945 #endif
 946
 947 #ifndef lint
 948     (void)astore(stack,++sp,
 949       str_2static(str_nmake(((double)timesbuf.tms_utime)/HZ)));
 950     (void)astore(stack,++sp,
 951       str_2static(str_nmake(((double)timesbuf.tms_stime)/HZ)));
 952     (void)astore(stack,++sp,
 953       str_2static(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
 954     (void)astore(stack,++sp,
 955       str_2static(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
 956 #else
 957     (void)astore(stack,++sp,
 958       str_2static(str_nmake(0.0)));
 959 #endif
 960     return sp;
 961 }
 962
 963 int
 964 do_time(str,tmbuf,gimme,arglast)
 965 STR *str;
 966 struct tm *tmbuf;
 967 int gimme;
 968 int *arglast;
 969 {
 970     register ARRAY *ary = stack;
 971     STR **st = ary->ary_array;
 972     register int sp = arglast[0];
 973
 974     if (!tmbuf || gimme != G_ARRAY) {
 975         str_sset(str,&str_undef);
 976         STABSET(str);
 977         st[++sp] = str;
 978         return sp;
 979     }
 980     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_sec)));
 981     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_min)));
 982     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_hour)));
 983     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mday)));
 984     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mon)));
 985     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_year)));
 986     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_wday)));
 987     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_yday)));
 988     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_isdst)));
 989     return sp;
 990 }
 991
 992 int
 993 do_kv(str,hash,kv,gimme,arglast)
 994 STR *str;
 995 HASH *hash;
 996 int kv;
 997 int gimme;
 998 int *arglast;
 999 {
1000     register ARRAY *ary = stack;
1001     STR **st = ary->ary_array;
1002     register int sp = arglast[0];
1003     int i;
1004     register HENT *entry;
1005     char *tmps;
1006     STR *tmpstr;
1007     int dokeys = (kv == O_KEYS || kv == O_HASH);
1008     int dovalues = (kv == O_VALUES || kv == O_HASH);
1009
1010     if (gimme != G_ARRAY) {
1011         str_sset(str,&str_undef);
1012         STABSET(str);
1013         st[++sp] = str;
1014         return sp;
1015     }
1016     (void)hiterinit(hash);
1017     while (entry = hiternext(hash)) {
1018         if (dokeys) {
1019             tmps = hiterkey(entry,&i);
1020             (void)astore(ary,++sp,str_2static(str_make(tmps,i)));
1021         }
1022         if (dovalues) {
1023             tmpstr = Str_new(45,0);
1024 #ifdef DEBUGGING
1025             if (debug & 8192) {
1026                 sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
1027                     hash->tbl_max+1,entry->hent_hash & hash->tbl_max);
1028                 str_set(tmpstr,buf);
1029             }
1030             else
1031 #endif
1032             str_sset(tmpstr,hiterval(hash,entry));
1033             (void)astore(ary,++sp,str_2static(tmpstr));
1034         }
1035     }
1036     return sp;
1037 }
1038
1039 int
1040 do_each(str,hash,gimme,arglast)
1041 STR *str;
1042 HASH *hash;
1043 int gimme;
1044 int *arglast;
1045 {
1046     STR **st = stack->ary_array;
1047     register int sp = arglast[0];
1048     static STR *mystrk = Nullstr;
1049     HENT *entry = hiternext(hash);
1050     int i;
1051     char *tmps;
1052
1053     if (mystrk) {
1054         str_free(mystrk);
1055         mystrk = Nullstr;
1056     }
1057
1058     if (entry) {
1059         if (gimme == G_ARRAY) {
1060             tmps = hiterkey(entry, &i);
1061             st[++sp] = mystrk = str_make(tmps,i);
1062         }
1063         st[++sp] = str;
1064         str_sset(str,hiterval(hash,entry));
1065         STABSET(str);
1066         return sp;
1067     }
1068     else
1069         return sp;
1070 }