dolist.c

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