str.c

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