dolist.c

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