dolist.c

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