dolist.c

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