dolist.c

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