dolist.c

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