str.c

   1 /* $RCSfile: str.c,v $$Revision: 4.0.1.5 $$Date: 92/06/08 15:40:43 $
   2  *
   3  *    Copyright (c) 1991, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  * $Log:        str.c,v $
   9  * Revision 4.0.1.5  92/06/08  15:40:43  lwall
  10  * patch20: removed implicit int declarations on functions
  11  * patch20: Perl now distinguishes overlapped copies from non-overlapped
  12  * patch20: paragraph mode now skips extra newlines automatically
  13  * patch20: fixed memory leak in doube-quote interpretation
  14  * patch20: made /\$$foo/ look for literal '$foo'
  15  * patch20: "$var{$foo'bar}" didn't scan subscript correctly
  16  * patch20: a splice on non-existent array elements could dump core
  17  * patch20: running taintperl explicitly now does checks even if $< == $>
  18  *
  19  * Revision 4.0.1.4  91/11/05  18:40:51  lwall
  20  * patch11: $foo .= <BAR> could overrun malloced memory
  21  * patch11: \$ didn't always make it through double-quoter to regexp routines
  22  * patch11: prepared for ctype implementations that don't define isascii()
  23  *
  24  * Revision 4.0.1.3  91/06/10  01:27:54  lwall
  25  * patch10: $) and $| incorrectly handled in run-time patterns
  26  *
  27  * Revision 4.0.1.2  91/06/07  11:58:13  lwall
  28  * patch4: new copyright notice
  29  * patch4: taint check on undefined string could cause core dump
  30  *
  31  * Revision 4.0.1.1  91/04/12  09:15:30  lwall
  32  * patch1: fixed undefined environ problem
  33  * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment
  34  * patch1: $foo .= <BAR> could cause core dump for certain lengths of $foo
  35  *
  36  * Revision 4.0  91/03/20  01:39:55  lwall
  37  * 4.0 baseline.
  38  *
  39  */
  40
  41 #include "EXTERN.h"
  42 #include "perl.h"
  43 #include "perly.h"
  44
  45 static void ucase();
  46 static void lcase();
  47
  48 #ifndef str_get
  49 char *
  50 str_get(str)
  51 STR *str;
  52 {
  53 #ifdef TAINT
  54     tainted |= str->str_tainted;
  55 #endif
  56     return str->str_pok ? str->str_ptr : str_2ptr(str);
  57 }
  58 #endif
  59
  60 /* dlb ... guess we have a "crippled cc".
  61  * dlb the following functions are usually macros.
  62  */
  63 #ifndef str_true
  64 int
  65 str_true(Str)
  66 STR *Str;
  67 {
  68         if (Str->str_pok) {
  69             if (*Str->str_ptr > '0' ||
  70               Str->str_cur > 1 ||
  71               (Str->str_cur && *Str->str_ptr != '0'))
  72                 return 1;
  73             return 0;
  74         }
  75         if (Str->str_nok)
  76                 return (Str->str_u.str_nval != 0.0);
  77         return 0;
  78 }
  79 #endif /* str_true */
  80
  81 #ifndef str_gnum
  82 double str_gnum(Str)
  83 STR *Str;
  84 {
  85 #ifdef TAINT
  86         tainted |= Str->str_tainted;
  87 #endif /* TAINT*/
  88         if (Str->str_nok)
  89                 return Str->str_u.str_nval;
  90         return str_2num(Str);
  91 }
  92 #endif /* str_gnum */
  93 /* dlb ... end of crutch */
  94
  95 char *
  96 str_grow(str,newlen)
  97 register STR *str;
  98 #ifndef DOSISH
  99 register int newlen;
 100 #else
 101 unsigned long newlen;
 102 #endif
 103 {
 104     register char *s = str->str_ptr;
 105
 106 #ifdef MSDOS
 107     if (newlen >= 0x10000) {
 108         fprintf(stderr, "Allocation too large: %lx\n", newlen);
 109         exit(1);
 110     }
 111 #endif /* MSDOS */
 112     if (str->str_state == SS_INCR) {            /* data before str_ptr? */
 113         str->str_len += str->str_u.str_useful;
 114         str->str_ptr -= str->str_u.str_useful;
 115         str->str_u.str_useful = 0L;
 116         Move(s, str->str_ptr, str->str_cur+1, char);
 117         s = str->str_ptr;
 118         str->str_state = SS_NORM;                       /* normal again */
 119         if (newlen > str->str_len)
 120             newlen += 10 * (newlen - str->str_cur); /* avoid copy each time */
 121     }
 122     if (newlen > str->str_len) {                /* need more room? */
 123         if (str->str_len)
 124             Renew(s,newlen,char);
 125         else
 126             New(703,s,newlen,char);
 127         str->str_ptr = s;
 128         str->str_len = newlen;
 129     }
 130     return s;
 131 }
 132
 133 void
 134 str_numset(str,num)
 135 register STR *str;
 136 double num;
 137 {
 138     if (str->str_pok) {
 139         str->str_pok = 0;       /* invalidate pointer */
 140         if (str->str_state == SS_INCR)
 141             Str_Grow(str,0);
 142     }
 143     str->str_u.str_nval = num;
 144     str->str_state = SS_NORM;
 145     str->str_nok = 1;                   /* validate number */
 146 #ifdef TAINT
 147     str->str_tainted = tainted;
 148 #endif
 149 }
 150
 151 char *
 152 str_2ptr(str)
 153 register STR *str;
 154 {
 155     register char *s;
 156     int olderrno;
 157
 158     if (!str)
 159         return "";
 160     if (str->str_nok) {
 161         STR_GROW(str, 30);
 162         s = str->str_ptr;
 163         olderrno = errno;       /* some Xenix systems wipe out errno here */
 164 #if defined(scs) && defined(ns32000)
 165         gcvt(str->str_u.str_nval,20,s);
 166 #else
 167 #ifdef apollo
 168         if (str->str_u.str_nval == 0.0)
 169             (void)strcpy(s,"0");
 170         else
 171 #endif /*apollo*/
 172         (void)sprintf(s,"%.20g",str->str_u.str_nval);
 173 #endif /*scs*/
 174         errno = olderrno;
 175         while (*s) s++;
 176 #ifdef hcx
 177         if (s[-1] == '.')
 178             s--;
 179 #endif
 180     }
 181     else {
 182         if (str == &str_undef)
 183             return No;
 184         if (dowarn)
 185             warn("Use of uninitialized variable");
 186         STR_GROW(str, 30);
 187         s = str->str_ptr;
 188     }
 189     *s = '\0';
 190     str->str_cur = s - str->str_ptr;
 191     str->str_pok = 1;
 192 #ifdef DEBUGGING
 193     if (debug & 32)
 194         fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr);
 195 #endif
 196     return str->str_ptr;
 197 }
 198
 199 double
 200 str_2num(str)
 201 register STR *str;
 202 {
 203     if (!str)
 204         return 0.0;
 205     if (str->str_state == SS_INCR)
 206         Str_Grow(str,0);       /* just force copy down */
 207     str->str_state = SS_NORM;
 208     if (str->str_len && str->str_pok)
 209         str->str_u.str_nval = atof(str->str_ptr);
 210     else  {
 211         if (str == &str_undef)
 212             return 0.0;
 213         if (dowarn)
 214             warn("Use of uninitialized variable");
 215         str->str_u.str_nval = 0.0;
 216     }
 217     str->str_nok = 1;
 218 #ifdef DEBUGGING
 219     if (debug & 32)
 220         fprintf(stderr,"0x%lx num(%g)\n",str,str->str_u.str_nval);
 221 #endif
 222     return str->str_u.str_nval;
 223 }
 224
 225 /* Note: str_sset() should not be called with a source string that needs
 226  * be reused, since it may destroy the source string if it is marked
 227  * as temporary.
 228  */
 229
 230 void
 231 str_sset(dstr,sstr)
 232 STR *dstr;
 233 register STR *sstr;
 234 {
 235 #ifdef TAINT
 236     if (sstr)
 237         tainted |= sstr->str_tainted;
 238 #endif
 239     if (sstr == dstr || dstr == &str_undef)
 240         return;
 241     if (!sstr)
 242         dstr->str_pok = dstr->str_nok = 0;
 243     else if (sstr->str_pok) {
 244
 245         /*
 246          * Check to see if we can just swipe the string.  If so, it's a
 247          * possible small lose on short strings, but a big win on long ones.
 248          * It might even be a win on short strings if dstr->str_ptr
 249          * has to be allocated and sstr->str_ptr has to be freed.
 250          */
 251
 252         if (sstr->str_pok & SP_TEMP) {          /* slated for free anyway? */
 253             if (dstr->str_ptr) {
 254                 if (dstr->str_state == SS_INCR)
 255                     dstr->str_ptr -= dstr->str_u.str_useful;
 256                 Safefree(dstr->str_ptr);
 257             }
 258             dstr->str_ptr = sstr->str_ptr;
 259             dstr->str_len = sstr->str_len;
 260             dstr->str_cur = sstr->str_cur;
 261             dstr->str_state = sstr->str_state;
 262             dstr->str_pok = sstr->str_pok & ~SP_TEMP;
 263 #ifdef TAINT
 264             dstr->str_tainted = sstr->str_tainted;
 265 #endif
 266             sstr->str_ptr = Nullch;
 267             sstr->str_len = 0;
 268             sstr->str_pok = 0;                  /* wipe out any weird flags */
 269             sstr->str_state = 0;                /* so sstr frees uneventfully */
 270         }
 271         else {                                  /* have to copy actual string */
 272             if (dstr->str_ptr) {
 273                 if (dstr->str_state == SS_INCR) {
 274                         Str_Grow(dstr,0);
 275                 }
 276             }
 277             str_nset(dstr,sstr->str_ptr,sstr->str_cur);
 278         }
 279         /*SUPPRESS 560*/
 280         if (dstr->str_nok = sstr->str_nok)
 281             dstr->str_u.str_nval = sstr->str_u.str_nval;
 282         else {
 283 #ifdef STRUCTCOPY
 284             dstr->str_u = sstr->str_u;
 285 #else
 286             dstr->str_u.str_nval = sstr->str_u.str_nval;
 287 #endif
 288             if (dstr->str_cur == sizeof(STBP)) {
 289                 char *tmps = dstr->str_ptr;
 290
 291                 if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
 292                     if (dstr->str_magic && dstr->str_magic->str_rare == 'X') {
 293                         str_free(dstr->str_magic);
 294                         dstr->str_magic = Nullstr;
 295                     }
 296                     if (!dstr->str_magic) {
 297                         dstr->str_magic = str_smake(sstr->str_magic);
 298                         dstr->str_magic->str_rare = 'X';
 299                     }
 300                 }
 301             }
 302         }
 303     }
 304     else if (sstr->str_nok)
 305         str_numset(dstr,sstr->str_u.str_nval);
 306     else {
 307         if (dstr->str_state == SS_INCR)
 308             Str_Grow(dstr,0);       /* just force copy down */
 309
 310 #ifdef STRUCTCOPY
 311         dstr->str_u = sstr->str_u;
 312 #else
 313         dstr->str_u.str_nval = sstr->str_u.str_nval;
 314 #endif
 315         dstr->str_pok = dstr->str_nok = 0;
 316     }
 317 }
 318
 319 void
 320 str_nset(str,ptr,len)
 321 register STR *str;
 322 register char *ptr;
 323 register STRLEN len;
 324 {
 325     if (str == &str_undef)
 326         return;
 327     STR_GROW(str, len + 1);
 328     if (ptr)
 329         Move(ptr,str->str_ptr,len,char);
 330     str->str_cur = len;
 331     *(str->str_ptr+str->str_cur) = '\0';
 332     str->str_nok = 0;           /* invalidate number */
 333     str->str_pok = 1;           /* validate pointer */
 334 #ifdef TAINT
 335     str->str_tainted = tainted;
 336 #endif
 337 }
 338
 339 void
 340 str_set(str,ptr)
 341 register STR *str;
 342 register char *ptr;
 343 {
 344     register STRLEN len;
 345
 346     if (str == &str_undef)
 347         return;
 348     if (!ptr)
 349         ptr = "";
 350     len = strlen(ptr);
 351     STR_GROW(str, len + 1);
 352     Move(ptr,str->str_ptr,len+1,char);
 353     str->str_cur = len;
 354     str->str_nok = 0;           /* invalidate number */
 355     str->str_pok = 1;           /* validate pointer */
 356 #ifdef TAINT
 357     str->str_tainted = tainted;
 358 #endif
 359 }
 360
 361 void
 362 str_chop(str,ptr)       /* like set but assuming ptr is in str */
 363 register STR *str;
 364 register char *ptr;
 365 {
 366     register STRLEN delta;
 367
 368     if (!ptr || !(str->str_pok))
 369         return;
 370     delta = ptr - str->str_ptr;
 371     str->str_len -= delta;
 372     str->str_cur -= delta;
 373     str->str_ptr += delta;
 374     if (str->str_state == SS_INCR)
 375         str->str_u.str_useful += delta;
 376     else {
 377         str->str_u.str_useful = delta;
 378         str->str_state = SS_INCR;
 379     }
 380     str->str_nok = 0;           /* invalidate number */
 381     str->str_pok = 1;           /* validate pointer (and unstudy str) */
 382 }
 383
 384 void
 385 str_ncat(str,ptr,len)
 386 register STR *str;
 387 register char *ptr;
 388 register STRLEN len;
 389 {
 390     if (str == &str_undef)
 391         return;
 392     if (!(str->str_pok))
 393         (void)str_2ptr(str);
 394     STR_GROW(str, str->str_cur + len + 1);
 395     Move(ptr,str->str_ptr+str->str_cur,len,char);
 396     str->str_cur += len;
 397     *(str->str_ptr+str->str_cur) = '\0';
 398     str->str_nok = 0;           /* invalidate number */
 399     str->str_pok = 1;           /* validate pointer */
 400 #ifdef TAINT
 401     str->str_tainted |= tainted;
 402 #endif
 403 }
 404
 405 void
 406 str_scat(dstr,sstr)
 407 STR *dstr;
 408 register STR *sstr;
 409 {
 410     if (!sstr)
 411         return;
 412 #ifdef TAINT
 413     tainted |= sstr->str_tainted;
 414 #endif
 415     if (!(sstr->str_pok))
 416         (void)str_2ptr(sstr);
 417     if (sstr)
 418         str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
 419 }
 420
 421 void
 422 str_cat(str,ptr)
 423 register STR *str;
 424 register char *ptr;
 425 {
 426     register STRLEN len;
 427
 428     if (str == &str_undef)
 429         return;
 430     if (!ptr)
 431         return;
 432     if (!(str->str_pok))
 433         (void)str_2ptr(str);
 434     len = strlen(ptr);
 435     STR_GROW(str, str->str_cur + len + 1);
 436     Move(ptr,str->str_ptr+str->str_cur,len+1,char);
 437     str->str_cur += len;
 438     str->str_nok = 0;           /* invalidate number */
 439     str->str_pok = 1;           /* validate pointer */
 440 #ifdef TAINT
 441     str->str_tainted |= tainted;
 442 #endif
 443 }
 444
 445 char *
 446 str_append_till(str,from,fromend,delim,keeplist)
 447 register STR *str;
 448 register char *from;
 449 register char *fromend;
 450 register int delim;
 451 char *keeplist;
 452 {
 453     register char *to;
 454     register STRLEN len;
 455
 456     if (str == &str_undef)
 457         return Nullch;
 458     if (!from)
 459         return Nullch;
 460     len = fromend - from;
 461     STR_GROW(str, str->str_cur + len + 1);
 462     str->str_nok = 0;           /* invalidate number */
 463     str->str_pok = 1;           /* validate pointer */
 464     to = str->str_ptr+str->str_cur;
 465     for (; from < fromend; from++,to++) {
 466         if (*from == '\\' && from+1 < fromend && delim != '\\') {
 467             if (!keeplist) {
 468                 if (from[1] == delim || from[1] == '\\')
 469                     from++;
 470                 else
 471                     *to++ = *from++;
 472             }
 473             else if (from[1] && index(keeplist,from[1]))
 474                 *to++ = *from++;
 475             else
 476                 from++;
 477         }
 478         else if (*from == delim)
 479             break;
 480         *to = *from;
 481     }
 482     *to = '\0';
 483     str->str_cur = to - str->str_ptr;
 484     return from;
 485 }
 486
 487 STR *
 488 #ifdef LEAKTEST
 489 str_new(x,len)
 490 int x;
 491 #else
 492 str_new(len)
 493 #endif
 494 STRLEN len;
 495 {
 496     register STR *str;
 497
 498     if (freestrroot) {
 499         str = freestrroot;
 500         freestrroot = str->str_magic;
 501         str->str_magic = Nullstr;
 502         str->str_state = SS_NORM;
 503     }
 504     else {
 505         Newz(700+x,str,1,STR);
 506     }
 507     if (len)
 508         STR_GROW(str, len + 1);
 509     return str;
 510 }
 511
 512 void
 513 str_magic(str, stab, how, name, namlen)
 514 register STR *str;
 515 STAB *stab;
 516 int how;
 517 char *name;
 518 STRLEN namlen;
 519 {
 520     if (str == &str_undef || str->str_magic)
 521         return;
 522     str->str_magic = Str_new(75,namlen);
 523     str = str->str_magic;
 524     str->str_u.str_stab = stab;
 525     str->str_rare = how;
 526     if (name)
 527         str_nset(str,name,namlen);
 528 }
 529
 530 void
 531 str_insert(bigstr,offset,len,little,littlelen)
 532 STR *bigstr;
 533 STRLEN offset;
 534 STRLEN len;
 535 char *little;
 536 STRLEN littlelen;
 537 {
 538     register char *big;
 539     register char *mid;
 540     register char *midend;
 541     register char *bigend;
 542     register int i;
 543
 544     if (bigstr == &str_undef)
 545         return;
 546     bigstr->str_nok = 0;
 547     bigstr->str_pok = SP_VALID; /* disable possible screamer */
 548
 549     i = littlelen - len;
 550     if (i > 0) {                        /* string might grow */
 551         STR_GROW(bigstr, bigstr->str_cur + i + 1);
 552         big = bigstr->str_ptr;
 553         mid = big + offset + len;
 554         midend = bigend = big + bigstr->str_cur;
 555         bigend += i;
 556         *bigend = '\0';
 557         while (midend > mid)            /* shove everything down */
 558             *--bigend = *--midend;
 559         Move(little,big+offset,littlelen,char);
 560         bigstr->str_cur += i;
 561         STABSET(bigstr);
 562         return;
 563     }
 564     else if (i == 0) {
 565         Move(little,bigstr->str_ptr+offset,len,char);
 566         STABSET(bigstr);
 567         return;
 568     }
 569
 570     big = bigstr->str_ptr;
 571     mid = big + offset;
 572     midend = mid + len;
 573     bigend = big + bigstr->str_cur;
 574
 575     if (midend > bigend)
 576         fatal("panic: str_insert");
 577
 578     if (mid - big > bigend - midend) {  /* faster to shorten from end */
 579         if (littlelen) {
 580             Move(little, mid, littlelen,char);
 581             mid += littlelen;
 582         }
 583         i = bigend - midend;
 584         if (i > 0) {
 585             Move(midend, mid, i,char);
 586             mid += i;
 587         }
 588         *mid = '\0';
 589         bigstr->str_cur = mid - big;
 590     }
 591     /*SUPPRESS 560*/
 592     else if (i = mid - big) {   /* faster from front */
 593         midend -= littlelen;
 594         mid = midend;
 595         str_chop(bigstr,midend-i);
 596         big += i;
 597         while (i--)
 598             *--midend = *--big;
 599         if (littlelen)
 600             Move(little, mid, littlelen,char);
 601     }
 602     else if (littlelen) {
 603         midend -= littlelen;
 604         str_chop(bigstr,midend);
 605         Move(little,midend,littlelen,char);
 606     }
 607     else {
 608         str_chop(bigstr,midend);
 609     }
 610     STABSET(bigstr);
 611 }
 612
 613 /* make str point to what nstr did */
 614
 615 void
 616 str_replace(str,nstr)
 617 register STR *str;
 618 register STR *nstr;
 619 {
 620     if (str == &str_undef)
 621         return;
 622     if (str->str_state == SS_INCR)
 623         Str_Grow(str,0);        /* just force copy down */
 624     if (nstr->str_state == SS_INCR)
 625         Str_Grow(nstr,0);
 626     if (str->str_ptr)
 627         Safefree(str->str_ptr);
 628     str->str_ptr = nstr->str_ptr;
 629     str->str_len = nstr->str_len;
 630     str->str_cur = nstr->str_cur;
 631     str->str_pok = nstr->str_pok;
 632     str->str_nok = nstr->str_nok;
 633 #ifdef STRUCTCOPY
 634     str->str_u = nstr->str_u;
 635 #else
 636     str->str_u.str_nval = nstr->str_u.str_nval;
 637 #endif
 638 #ifdef TAINT
 639     str->str_tainted = nstr->str_tainted;
 640 #endif
 641     if (nstr->str_magic)
 642         str_free(nstr->str_magic);
 643     Safefree(nstr);
 644 }
 645
 646 void
 647 str_free(str)
 648 register STR *str;
 649 {
 650     if (!str || str == &str_undef)
 651         return;
 652     if (str->str_state) {
 653         if (str->str_state == SS_FREE)  /* already freed */
 654             return;
 655         if (str->str_state == SS_INCR && !(str->str_pok & 2)) {
 656             str->str_ptr -= str->str_u.str_useful;
 657             str->str_len += str->str_u.str_useful;
 658         }
 659     }
 660     if (str->str_magic)
 661         str_free(str->str_magic);
 662     str->str_magic = freestrroot;
 663 #ifdef LEAKTEST
 664     if (str->str_len) {
 665         Safefree(str->str_ptr);
 666         str->str_ptr = Nullch;
 667     }
 668     if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
 669         arg_free(str->str_u.str_args);
 670     Safefree(str);
 671 #else /* LEAKTEST */
 672     if (str->str_len) {
 673         if (str->str_len > 127) {       /* next user not likely to want more */
 674             Safefree(str->str_ptr);     /* so give it back to malloc */
 675             str->str_ptr = Nullch;
 676             str->str_len = 0;
 677         }
 678         else
 679             str->str_ptr[0] = '\0';
 680     }
 681     if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
 682         arg_free(str->str_u.str_args);
 683     str->str_cur = 0;
 684     str->str_nok = 0;
 685     str->str_pok = 0;
 686     str->str_state = SS_FREE;
 687 #ifdef TAINT
 688     str->str_tainted = 0;
 689 #endif
 690     freestrroot = str;
 691 #endif /* LEAKTEST */
 692 }
 693
 694 STRLEN
 695 str_len(str)
 696 register STR *str;
 697 {
 698     if (!str)
 699         return 0;
 700     if (!(str->str_pok))
 701         (void)str_2ptr(str);
 702     if (str->str_ptr)
 703         return str->str_cur;
 704     else
 705         return 0;
 706 }
 707
 708 int
 709 str_eq(str1,str2)
 710 register STR *str1;
 711 register STR *str2;
 712 {
 713     if (!str1 || str1 == &str_undef)
 714         return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur);
 715     if (!str2 || str2 == &str_undef)
 716         return !str1->str_cur;
 717
 718     if (!str1->str_pok)
 719         (void)str_2ptr(str1);
 720     if (!str2->str_pok)
 721         (void)str_2ptr(str2);
 722
 723     if (str1->str_cur != str2->str_cur)
 724         return 0;
 725
 726     return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur);
 727 }
 728
 729 int
 730 str_cmp(str1,str2)
 731 register STR *str1;
 732 register STR *str2;
 733 {
 734     int retval;
 735
 736     if (!str1 || str1 == &str_undef)
 737         return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur)?0:-1;
 738     if (!str2 || str2 == &str_undef)
 739         return str1->str_cur != 0;
 740
 741     if (!str1->str_pok)
 742         (void)str_2ptr(str1);
 743     if (!str2->str_pok)
 744         (void)str_2ptr(str2);
 745
 746     if (str1->str_cur < str2->str_cur) {
 747         /*SUPPRESS 560*/
 748         if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
 749             return retval < 0 ? -1 : 1;
 750         else
 751             return -1;
 752     }
 753     /*SUPPRESS 560*/
 754     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
 755         return retval < 0 ? -1 : 1;
 756     else if (str1->str_cur == str2->str_cur)
 757         return 0;
 758     else
 759         return 1;
 760 }
 761
 762 char *
 763 str_gets(str,fp,append)
 764 register STR *str;
 765 register FILE *fp;
 766 int append;
 767 {
 768     register char *bp;          /* we're going to steal some values */
 769     register int cnt;           /*  from the stdio struct and put EVERYTHING */
 770     register STDCHAR *ptr;      /*   in the innermost loop into registers */
 771     register int newline = rschar;/* (assuming >= 6 registers) */
 772     int i;
 773     STRLEN bpx;
 774     int shortbuffered;
 775
 776     if (str == &str_undef)
 777         return Nullch;
 778     if (rspara) {               /* have to do this both before and after */
 779         do {                    /* to make sure file boundaries work right */
 780             i = getc(fp);
 781             if (i != '\n') {
 782                 ungetc(i,fp);
 783                 break;
 784             }
 785         } while (i != EOF);
 786     }
 787 #ifdef STDSTDIO         /* Here is some breathtakingly efficient cheating */
 788     cnt = fp->_cnt;                     /* get count into register */
 789     str->str_nok = 0;                   /* invalidate number */
 790     str->str_pok = 1;                   /* validate pointer */
 791     if (str->str_len - append <= cnt + 1) { /* make sure we have the room */
 792         if (cnt > 80 && str->str_len > append) {
 793             shortbuffered = cnt - str->str_len + append + 1;
 794             cnt -= shortbuffered;
 795         }
 796         else {
 797             shortbuffered = 0;
 798             STR_GROW(str, append+cnt+2);/* (remembering cnt can be -1) */
 799         }
 800     }
 801     else
 802         shortbuffered = 0;
 803     bp = str->str_ptr + append;         /* move these two too to registers */
 804     ptr = fp->_ptr;
 805     for (;;) {
 806       screamer:
 807         while (--cnt >= 0) {                    /* this */      /* eat */
 808             if ((*bp++ = *ptr++) == newline)    /* really */    /* dust */
 809                 goto thats_all_folks;           /* screams */   /* sed :-) */
 810         }
 811
 812         if (shortbuffered) {                    /* oh well, must extend */
 813             cnt = shortbuffered;
 814             shortbuffered = 0;
 815             bpx = bp - str->str_ptr;    /* prepare for possible relocation */
 816             str->str_cur = bpx;
 817             STR_GROW(str, str->str_len + append + cnt + 2);
 818             bp = str->str_ptr + bpx;    /* reconstitute our pointer */
 819             continue;
 820         }
 821
 822         fp->_cnt = cnt;                 /* deregisterize cnt and ptr */
 823         fp->_ptr = ptr;
 824         i = _filbuf(fp);                /* get more characters */
 825         cnt = fp->_cnt;
 826         ptr = fp->_ptr;                 /* reregisterize cnt and ptr */
 827
 828         bpx = bp - str->str_ptr;        /* prepare for possible relocation */
 829         str->str_cur = bpx;
 830         STR_GROW(str, bpx + cnt + 2);
 831         bp = str->str_ptr + bpx;        /* reconstitute our pointer */
 832
 833         if (i == newline) {             /* all done for now? */
 834             *bp++ = i;
 835             goto thats_all_folks;
 836         }
 837         else if (i == EOF)              /* all done for ever? */
 838             goto thats_really_all_folks;
 839         *bp++ = i;                      /* now go back to screaming loop */
 840     }
 841
 842 thats_all_folks:
 843     if (rslen > 1 && (bp - str->str_ptr < rslen || bcmp(bp - rslen, rs, rslen)))
 844         goto screamer;  /* go back to the fray */
 845 thats_really_all_folks:
 846     if (shortbuffered)
 847         cnt += shortbuffered;
 848     fp->_cnt = cnt;                     /* put these back or we're in trouble */
 849     fp->_ptr = ptr;
 850     *bp = '\0';
 851     str->str_cur = bp - str->str_ptr;   /* set length */
 852
 853 #else /* !STDSTDIO */   /* The big, slow, and stupid way */
 854
 855     {
 856         static char buf[8192];
 857         char * bpe = buf + sizeof(buf) - 3;
 858
 859 screamer:
 860         bp = buf;
 861         while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ;
 862
 863         *bp = '\0';
 864         if (append)
 865             str_cat(str, buf);
 866         else
 867             str_set(str, buf);
 868         if (i != EOF                    /* joy */
 869             &&
 870             (i != newline
 871              ||
 872              (rslen > 1
 873               &&
 874               (str->str_cur < rslen
 875                ||
 876                bcmp(str->str_ptr + str->str_cur - rslen, rs, rslen)
 877               )
 878              )
 879             )
 880            )
 881         {
 882             append = -1;
 883             goto screamer;
 884         }
 885     }
 886
 887 #endif /* STDSTDIO */
 888
 889     if (rspara) {
 890         while (i != EOF) {
 891             i = getc(fp);
 892             if (i != '\n') {
 893                 ungetc(i,fp);
 894                 break;
 895             }
 896         }
 897     }
 898     return str->str_cur - append ? str->str_ptr : Nullch;
 899 }
 900
 901 ARG *
 902 parselist(str)
 903 STR *str;
 904 {
 905     register CMD *cmd;
 906     register ARG *arg;
 907     CMD *oldcurcmd = curcmd;
 908     int oldperldb = perldb;
 909     int retval;
 910
 911     perldb = 0;
 912     str_sset(linestr,str);
 913     in_eval++;
 914     oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
 915     bufend = bufptr + linestr->str_cur;
 916     if (++loop_ptr >= loop_max) {
 917         loop_max += 128;
 918         Renew(loop_stack, loop_max, struct loop);
 919     }
 920     loop_stack[loop_ptr].loop_label = "_EVAL_";
 921     loop_stack[loop_ptr].loop_sp = 0;
 922 #ifdef DEBUGGING
 923     if (debug & 4) {
 924         deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
 925     }
 926 #endif
 927     if (setjmp(loop_stack[loop_ptr].loop_env)) {
 928         in_eval--;
 929         loop_ptr--;
 930         perldb = oldperldb;
 931         fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
 932     }
 933 #ifdef DEBUGGING
 934     if (debug & 4) {
 935         char *tmps = loop_stack[loop_ptr].loop_label;
 936         deb("(Popping label #%d %s)\n",loop_ptr,
 937             tmps ? tmps : "" );
 938     }
 939 #endif
 940     loop_ptr--;
 941     error_count = 0;
 942     curcmd = &compiling;
 943     curcmd->c_line = oldcurcmd->c_line;
 944     retval = yyparse();
 945     curcmd = oldcurcmd;
 946     perldb = oldperldb;
 947     in_eval--;
 948     if (retval || error_count)
 949         fatal("Invalid component in string or format");
 950     cmd = eval_root;
 951     arg = cmd->c_expr;
 952     if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
 953         fatal("panic: error in parselist %d %x %d", cmd->c_type,
 954           cmd->c_next, arg ? arg->arg_type : -1);
 955     cmd->c_expr = Nullarg;
 956     cmd_free(cmd);
 957     eval_root = Nullcmd;
 958     return arg;
 959 }
 960
 961 void
 962 intrpcompile(src)
 963 STR *src;
 964 {
 965     register char *s = str_get(src);
 966     register char *send = s + src->str_cur;
 967     register STR *str;
 968     register char *t;
 969     STR *toparse;
 970     STRLEN len;
 971     register int brackets;
 972     register char *d;
 973     STAB *stab;
 974     char *checkpoint;
 975     int sawcase = 0;
 976
 977     toparse = Str_new(76,0);
 978     str = Str_new(77,0);
 979
 980     str_nset(str,"",0);
 981     str_nset(toparse,"",0);
 982     t = s;
 983     while (s < send) {
 984         if (*s == '\\' && s[1] && index("$@[{\\]}lLuUE",s[1])) {
 985             str_ncat(str, t, s - t);
 986             ++s;
 987             if (isALPHA(*s)) {
 988                 str_ncat(str, "$c", 2);
 989                 sawcase = (*s != 'E');
 990             }
 991             else {
 992                 if (*nointrp) {         /* in a regular expression */
 993                     if (*s == '@')      /* always strip \@ */ /*SUPPRESS 530*/
 994                         ;
 995                     else                /* don't strip \\, \[, \{ etc. */
 996                         str_ncat(str,s-1,1);
 997                 }
 998                 str_ncat(str, "$b", 2);
 999             }
1000             str_ncat(str, s, 1);
1001             ++s;
1002             t = s;
1003         }
1004         else if (*s == '$' && s+1 < send && *nointrp && index(nointrp,s[1])) {
1005             str_ncat(str, t, s - t);
1006             str_ncat(str, "$b", 2);
1007             str_ncat(str, s, 2);
1008             s += 2;
1009             t = s;
1010         }
1011         else if ((*s == '@' || *s == '$') && s+1 < send) {
1012             str_ncat(str,t,s-t);
1013             t = s;
1014             if (*s == '$' && s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
1015                 s++;
1016             s = scanident(s,send,tokenbuf);
1017             if (*t == '@' &&
1018               (!(stab = stabent(tokenbuf,FALSE)) ||
1019                  (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) {
1020                 str_ncat(str,"@",1);
1021                 s = ++t;
1022                 continue;       /* grandfather @ from old scripts */
1023             }
1024             str_ncat(str,"$a",2);
1025             str_ncat(toparse,",",1);
1026             if (t[1] != '{' && (*s == '['  || *s == '{' /* }} */ ) &&
1027               (stab = stabent(tokenbuf,FALSE)) &&
1028               ((*s == '[') ? (stab_xarray(stab) != 0) : (stab_xhash(stab) != 0)) ) {
1029                 brackets = 0;
1030                 checkpoint = s;
1031                 do {
1032                     switch (*s) {
1033                     case '[':
1034                         brackets++;
1035                         break;
1036                     case '{':
1037                         brackets++;
1038                         break;
1039                     case ']':
1040                         brackets--;
1041                         break;
1042                     case '}':
1043                         brackets--;
1044                         break;
1045                     case '$':
1046                     case '%':
1047                     case '@':
1048                     case '&':
1049                     case '*':
1050                         s = scanident(s,send,tokenbuf);
1051                         break;
1052                     case '\'':
1053                     case '"':
1054                         /*SUPPRESS 68*/
1055                         s = cpytill(tokenbuf,s+1,send,*s,&len);
1056                         if (s >= send)
1057                             fatal("Unterminated string");
1058                         break;
1059                     }
1060                     s++;
1061                 } while (brackets > 0 && s < send);
1062                 if (s > send)
1063                     fatal("Unmatched brackets in string");
1064                 if (*nointrp) {         /* we're in a regular expression */
1065                     d = checkpoint;
1066                     if (*d == '{' && s[-1] == '}') {    /* maybe {n,m} */
1067                         ++d;
1068                         if (isDIGIT(*d)) {      /* matches /^{\d,?\d*}$/ */
1069                             if (*++d == ',')
1070                                 ++d;
1071                             while (isDIGIT(*d))
1072                                 d++;
1073                             if (d == s - 1)
1074                                 s = checkpoint;         /* Is {n,m}! Backoff! */
1075                         }
1076                     }
1077                     else if (*d == '[' && s[-1] == ']') { /* char class? */
1078                         int weight = 2;         /* let's weigh the evidence */
1079                         char seen[256];
1080                         unsigned char un_char = 0, last_un_char;
1081
1082                         Zero(seen,256,char);
1083                         *--s = '\0';
1084                         if (d[1] == '^')
1085                             weight += 150;
1086                         else if (d[1] == '$')
1087                             weight -= 3;
1088                         if (isDIGIT(d[1])) {
1089                             if (d[2]) {
1090                                 if (isDIGIT(d[2]) && !d[3])
1091                                     weight -= 10;
1092                             }
1093                             else
1094                                 weight -= 100;
1095                         }
1096                         for (d++; d < s; d++) {
1097                             last_un_char = un_char;
1098                             un_char = (unsigned char)*d;
1099                             switch (*d) {
1100                             case '&':
1101                             case '$':
1102                                 weight -= seen[un_char] * 10;
1103                                 if (isALNUM(d[1])) {
1104                                     d = scanident(d,s,tokenbuf);
1105                                     if (stabent(tokenbuf,FALSE))
1106                                         weight -= 100;
1107                                     else
1108                                         weight -= 10;
1109                                 }
1110                                 else if (*d == '$' && d[1] &&
1111                                   index("[#!%*<>()-=",d[1])) {
1112                                     if (!d[2] || /*{*/ index("])} =",d[2]))
1113                                         weight -= 10;
1114                                     else
1115                                         weight -= 1;
1116                                 }
1117                                 break;
1118                             case '\\':
1119                                 un_char = 254;
1120                                 if (d[1]) {
1121                                     if (index("wds",d[1]))
1122                                         weight += 100;
1123                                     else if (seen['\''] || seen['"'])
1124                                         weight += 1;
1125                                     else if (index("rnftb",d[1]))
1126                                         weight += 40;
1127                                     else if (isDIGIT(d[1])) {
1128                                         weight += 40;
1129                                         while (d[1] && isDIGIT(d[1]))
1130                                             d++;
1131                                     }
1132                                 }
1133                                 else
1134                                     weight += 100;
1135                                 break;
1136                             case '-':
1137                                 if (last_un_char < (unsigned char) d[1]
1138                                   || d[1] == '\\') {
1139                                     if (index("aA01! ",last_un_char))
1140                                         weight += 30;
1141                                     if (index("zZ79~",d[1]))
1142                                         weight += 30;
1143                                 }
1144                                 else
1145                                     weight -= 1;
1146                             default:
1147                                 if (isALPHA(*d) && d[1] && isALPHA(d[1])) {
1148                                     bufptr = d;
1149                                     if (yylex() != WORD)
1150                                         weight -= 150;
1151                                     d = bufptr;
1152                                 }
1153                                 if (un_char == last_un_char + 1)
1154                                     weight += 5;
1155                                 weight -= seen[un_char];
1156                                 break;
1157                             }
1158                             seen[un_char]++;
1159                         }
1160 #ifdef DEBUGGING
1161                         if (debug & 512)
1162                             fprintf(stderr,"[%s] weight %d\n",
1163                               checkpoint+1,weight);
1164 #endif
1165                         *s++ = ']';
1166                         if (weight >= 0)        /* probably a character class */
1167                             s = checkpoint;
1168                     }
1169                 }
1170             }
1171             if (*t == '@')
1172                 str_ncat(toparse, "join($\",", 8);
1173             if (t[1] == '{' && s[-1] == '}') {
1174                 str_ncat(toparse, t, 1);
1175                 str_ncat(toparse, t+2, s - t - 3);
1176             }
1177             else
1178                 str_ncat(toparse, t, s - t);
1179             if (*t == '@')
1180                 str_ncat(toparse, ")", 1);
1181             t = s;
1182         }
1183         else
1184             s++;
1185     }
1186     str_ncat(str,t,s-t);
1187     if (sawcase)
1188         str_ncat(str, "$cE", 3);
1189     if (toparse->str_ptr && *toparse->str_ptr == ',') {
1190         *toparse->str_ptr = '(';
1191         str_ncat(toparse,",$$);",5);
1192         str->str_u.str_args = parselist(toparse);
1193         str->str_u.str_args->arg_len--;         /* ignore $$ reference */
1194     }
1195     else
1196         str->str_u.str_args = Nullarg;
1197     str_free(toparse);
1198     str->str_pok |= SP_INTRP;
1199     str->str_nok = 0;
1200     str_replace(src,str);
1201 }
1202
1203 STR *
1204 interp(str,src,sp)
1205 register STR *str;
1206 STR *src;
1207 int sp;
1208 {
1209     register char *s;
1210     register char *t;
1211     register char *send;
1212     register STR **elem;
1213     int docase = 0;
1214     int l = 0;
1215     int u = 0;
1216     int L = 0;
1217     int U = 0;
1218
1219     if (str == &str_undef)
1220         return Nullstr;
1221     if (!(src->str_pok & SP_INTRP)) {
1222         int oldsave = savestack->ary_fill;
1223
1224         (void)savehptr(&curstash);
1225         curstash = curcmd->c_stash;     /* so stabent knows right package */
1226         intrpcompile(src);
1227         restorelist(oldsave);
1228     }
1229     s = src->str_ptr;           /* assumed valid since str_pok set */
1230     t = s;
1231     send = s + src->str_cur;
1232
1233     if (src->str_u.str_args) {
1234         (void)eval(src->str_u.str_args,G_ARRAY,sp);
1235         /* Assuming we have correct # of args */
1236         elem = stack->ary_array + sp;
1237     }
1238
1239     str_nset(str,"",0);
1240     while (s < send) {
1241         if (*s == '$' && s+1 < send) {
1242             if (s-t > 0)
1243                 str_ncat(str,t,s-t);
1244             switch(*++s) {
1245             default:
1246                 fatal("panic: unknown interp cookie\n");
1247                 break;
1248             case 'a':
1249                 str_scat(str,*++elem);
1250                 break;
1251             case 'b':
1252                 str_ncat(str,++s,1);
1253                 break;
1254             case 'c':
1255                 if (docase && str->str_cur >= docase) {
1256                     char *b = str->str_ptr + --docase;
1257
1258                     if (L)
1259                         lcase(b, str->str_ptr + str->str_cur);
1260                     else if (U)
1261                         ucase(b, str->str_ptr + str->str_cur);
1262
1263                     if (u)      /* note that l & u are independent of L & U */
1264                         ucase(b, b+1);
1265                     else if (l)
1266                         lcase(b, b+1);
1267                     l = u = 0;
1268                 }
1269                 docase = str->str_cur + 1;
1270                 switch (*++s) {
1271                 case 'u':
1272                     u = 1;
1273                     l = 0;
1274                     break;
1275                 case 'U':
1276                     U = 1;
1277                     L = 0;
1278                     break;
1279                 case 'l':
1280                     l = 1;
1281                     u = 0;
1282                     break;
1283                 case 'L':
1284                     L = 1;
1285                     U = 0;
1286                     break;
1287                 case 'E':
1288                     docase = L = U = l = u = 0;
1289                     break;
1290                 }
1291                 break;
1292             }
1293             t = ++s;
1294         }
1295         else
1296             s++;
1297     }
1298     if (s-t > 0)
1299         str_ncat(str,t,s-t);
1300     return str;
1301 }
1302
1303 static void
1304 ucase(s,send)
1305 register char *s;
1306 register char *send;
1307 {
1308     while (s < send) {
1309         if (isLOWER(*s))
1310             *s = toupper(*s);
1311         s++;
1312     }
1313 }
1314
1315 static void
1316 lcase(s,send)
1317 register char *s;
1318 register char *send;
1319 {
1320     while (s < send) {
1321         if (isUPPER(*s))
1322             *s = tolower(*s);
1323         s++;
1324     }
1325 }
1326
1327 void
1328 str_inc(str)
1329 register STR *str;
1330 {
1331     register char *d;
1332
1333     if (!str || str == &str_undef)
1334         return;
1335     if (str->str_nok) {
1336         str->str_u.str_nval += 1.0;
1337         str->str_pok = 0;
1338         return;
1339     }
1340     if (!str->str_pok || !*str->str_ptr) {
1341         str->str_u.str_nval = 1.0;
1342         str->str_nok = 1;
1343         str->str_pok = 0;
1344         return;
1345     }
1346     d = str->str_ptr;
1347     while (isALPHA(*d)) d++;
1348     while (isDIGIT(*d)) d++;
1349     if (*d) {
1350         str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
1351         return;
1352     }
1353     d--;
1354     while (d >= str->str_ptr) {
1355         if (isDIGIT(*d)) {
1356             if (++*d <= '9')
1357                 return;
1358             *(d--) = '0';
1359         }
1360         else {
1361             ++*d;
1362             if (isALPHA(*d))
1363                 return;
1364             *(d--) -= 'z' - 'a' + 1;
1365         }
1366     }
1367     /* oh,oh, the number grew */
1368     STR_GROW(str, str->str_cur + 2);
1369     str->str_cur++;
1370     for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
1371         *d = d[-1];
1372     if (isDIGIT(d[1]))
1373         *d = '1';
1374     else
1375         *d = d[1];
1376 }
1377
1378 void
1379 str_dec(str)
1380 register STR *str;
1381 {
1382     if (!str || str == &str_undef)
1383         return;
1384     if (str->str_nok) {
1385         str->str_u.str_nval -= 1.0;
1386         str->str_pok = 0;
1387         return;
1388     }
1389     if (!str->str_pok) {
1390         str->str_u.str_nval = -1.0;
1391         str->str_nok = 1;
1392         return;
1393     }
1394     str_numset(str,atof(str->str_ptr) - 1.0);
1395 }
1396
1397 /* Make a string that will exist for the duration of the expression
1398  * evaluation.  Actually, it may have to last longer than that, but
1399  * hopefully cmd_exec won't free it until it has been assigned to a
1400  * permanent location. */
1401
1402 static long tmps_size = -1;
1403
1404 STR *
1405 str_mortal(oldstr)
1406 STR *oldstr;
1407 {
1408     register STR *str = Str_new(78,0);
1409
1410     str_sset(str,oldstr);
1411     if (++tmps_max > tmps_size) {
1412         tmps_size = tmps_max;
1413         if (!(tmps_size & 127)) {
1414             if (tmps_size)
1415                 Renew(tmps_list, tmps_size + 128, STR*);
1416             else
1417                 New(702,tmps_list, 128, STR*);
1418         }
1419     }
1420     tmps_list[tmps_max] = str;
1421     if (str->str_pok)
1422         str->str_pok |= SP_TEMP;
1423     return str;
1424 }
1425
1426 /* same thing without the copying */
1427
1428 STR *
1429 str_2mortal(str)
1430 register STR *str;
1431 {
1432     if (!str || str == &str_undef)
1433         return str;
1434     if (++tmps_max > tmps_size) {
1435         tmps_size = tmps_max;
1436         if (!(tmps_size & 127)) {
1437             if (tmps_size)
1438                 Renew(tmps_list, tmps_size + 128, STR*);
1439             else
1440                 New(704,tmps_list, 128, STR*);
1441         }
1442     }
1443     tmps_list[tmps_max] = str;
1444     if (str->str_pok)
1445         str->str_pok |= SP_TEMP;
1446     return str;
1447 }
1448
1449 STR *
1450 str_make(s,len)
1451 char *s;
1452 STRLEN len;
1453 {
1454     register STR *str = Str_new(79,0);
1455
1456     if (!len)
1457         len = strlen(s);
1458     str_nset(str,s,len);
1459     return str;
1460 }
1461
1462 STR *
1463 str_nmake(n)
1464 double n;
1465 {
1466     register STR *str = Str_new(80,0);
1467
1468     str_numset(str,n);
1469     return str;
1470 }
1471
1472 /* make an exact duplicate of old */
1473
1474 STR *
1475 str_smake(old)
1476 register STR *old;
1477 {
1478     register STR *new = Str_new(81,0);
1479
1480     if (!old)
1481         return Nullstr;
1482     if (old->str_state == SS_FREE) {
1483         warn("semi-panic: attempt to dup freed string");
1484         return Nullstr;
1485     }
1486     if (old->str_state == SS_INCR && !(old->str_pok & 2))
1487         Str_Grow(old,0);
1488     if (new->str_ptr)
1489         Safefree(new->str_ptr);
1490     StructCopy(old,new,STR);
1491     if (old->str_ptr) {
1492         new->str_ptr = nsavestr(old->str_ptr,old->str_len);
1493         new->str_pok &= ~SP_TEMP;
1494     }
1495     return new;
1496 }
1497
1498 void
1499 str_reset(s,stash)
1500 register char *s;
1501 HASH *stash;
1502 {
1503     register HENT *entry;
1504     register STAB *stab;
1505     register STR *str;
1506     register int i;
1507     register SPAT *spat;
1508     register int max;
1509
1510     if (!*s) {          /* reset ?? searches */
1511         for (spat = stash->tbl_spatroot;
1512           spat != Nullspat;
1513           spat = spat->spat_next) {
1514             spat->spat_flags &= ~SPAT_USED;
1515         }
1516         return;
1517     }
1518
1519     /* reset variables */
1520
1521     if (!stash->tbl_array)
1522         return;
1523     while (*s) {
1524         i = *s;
1525         if (s[1] == '-') {
1526             s += 2;
1527         }
1528         max = *s++;
1529         for ( ; i <= max; i++) {
1530             for (entry = stash->tbl_array[i];
1531               entry;
1532               entry = entry->hent_next) {
1533                 stab = (STAB*)entry->hent_val;
1534                 str = stab_val(stab);
1535                 str->str_cur = 0;
1536                 str->str_nok = 0;
1537 #ifdef TAINT
1538                 str->str_tainted = tainted;
1539 #endif
1540                 if (str->str_ptr != Nullch)
1541                     str->str_ptr[0] = '\0';
1542                 if (stab_xarray(stab)) {
1543                     aclear(stab_xarray(stab));
1544                 }
1545                 if (stab_xhash(stab)) {
1546                     hclear(stab_xhash(stab), FALSE);
1547                     if (stab == envstab)
1548                         environ[0] = Nullch;
1549                 }
1550             }
1551         }
1552     }
1553 }
1554
1555 #ifdef TAINT
1556 void
1557 taintproper(s)
1558 char *s;
1559 {
1560 #ifdef DEBUGGING
1561     if (debug & 2048)
1562         fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
1563 #endif
1564     if (tainted && (!euid || euid != uid || egid != gid || taintanyway)) {
1565         if (!unsafe)
1566             fatal("%s", s);
1567         else if (dowarn)
1568             warn("%s", s);
1569     }
1570 }
1571
1572 void
1573 taintenv()
1574 {
1575     register STR *envstr;
1576
1577     envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
1578     if (envstr == &str_undef || envstr->str_tainted) {
1579         tainted = 1;
1580         if (envstr->str_tainted == 2)
1581             taintproper("Insecure directory in PATH");
1582         else
1583             taintproper("Insecure PATH");
1584     }
1585     envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
1586     if (envstr != &str_undef && envstr->str_tainted) {
1587         tainted = 1;
1588         taintproper("Insecure IFS");
1589     }
1590 }
1591 #endif /* TAINT */