dolist.c

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