dolist.c

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