dolist.c

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