dolist.c

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