dolist.c

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