str.c

   1 #undef STDSTDIO
   2 /* $Header: str.c,v 4.0 91/03/20 01:39:55 lwall Locked $
   3  *
   4  *    Copyright (c) 1989, Larry Wall
   5  *
   6  *    You may distribute under the terms of the GNU General Public License
   7  *    as specified in the README file that comes with the perl 3.0 kit.
   8  *
   9  * $Log:        str.c,v $
  10  * Revision 4.0  91/03/20  01:39:55  lwall
  11  * 4.0 baseline.
  12  *
  13  */
  14
  15 #include "EXTERN.h"
  16 #include "perl.h"
  17 #include "perly.h"
  18
  19 #ifndef __STDC__
  20 extern char **environ;
  21 #endif /* ! __STDC__ */
  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         return;
 523     }
 524     else if (i == 0) {
 525         (void)bcopy(little,bigstr->str_ptr+offset,len);
 526         return;
 527     }
 528
 529     big = bigstr->str_ptr;
 530     mid = big + offset;
 531     midend = mid + len;
 532     bigend = big + bigstr->str_cur;
 533
 534     if (midend > bigend)
 535         fatal("panic: str_insert");
 536
 537     if (mid - big > bigend - midend) {  /* faster to shorten from end */
 538         if (littlelen) {
 539             (void)bcopy(little, mid, littlelen);
 540             mid += littlelen;
 541         }
 542         i = bigend - midend;
 543         if (i > 0) {
 544             (void)bcopy(midend, mid, i);
 545             mid += i;
 546         }
 547         *mid = '\0';
 548         bigstr->str_cur = mid - big;
 549     }
 550     else if (i = mid - big) {   /* faster from front */
 551         midend -= littlelen;
 552         mid = midend;
 553         str_chop(bigstr,midend-i);
 554         big += i;
 555         while (i--)
 556             *--midend = *--big;
 557         if (littlelen)
 558             (void)bcopy(little, mid, littlelen);
 559     }
 560     else if (littlelen) {
 561         midend -= littlelen;
 562         str_chop(bigstr,midend);
 563         (void)bcopy(little,midend,littlelen);
 564     }
 565     else {
 566         str_chop(bigstr,midend);
 567     }
 568     STABSET(bigstr);
 569 }
 570
 571 /* make str point to what nstr did */
 572
 573 void
 574 str_replace(str,nstr)
 575 register STR *str;
 576 register STR *nstr;
 577 {
 578     if (str == &str_undef)
 579         return;
 580     if (str->str_state == SS_INCR)
 581         Str_Grow(str,0);        /* just force copy down */
 582     if (nstr->str_state == SS_INCR)
 583         Str_Grow(nstr,0);
 584     if (str->str_ptr)
 585         Safefree(str->str_ptr);
 586     str->str_ptr = nstr->str_ptr;
 587     str->str_len = nstr->str_len;
 588     str->str_cur = nstr->str_cur;
 589     str->str_pok = nstr->str_pok;
 590     str->str_nok = nstr->str_nok;
 591 #ifdef STRUCTCOPY
 592     str->str_u = nstr->str_u;
 593 #else
 594     str->str_u.str_nval = nstr->str_u.str_nval;
 595 #endif
 596 #ifdef TAINT
 597     str->str_tainted = nstr->str_tainted;
 598 #endif
 599     if (nstr->str_magic)
 600         str_free(nstr->str_magic);
 601     Safefree(nstr);
 602 }
 603
 604 void
 605 str_free(str)
 606 register STR *str;
 607 {
 608     if (!str || str == &str_undef)
 609         return;
 610     if (str->str_state) {
 611         if (str->str_state == SS_FREE)  /* already freed */
 612             return;
 613         if (str->str_state == SS_INCR && !(str->str_pok & 2)) {
 614             str->str_ptr -= str->str_u.str_useful;
 615             str->str_len += str->str_u.str_useful;
 616         }
 617     }
 618     if (str->str_magic)
 619         str_free(str->str_magic);
 620     str->str_magic = freestrroot;
 621 #ifdef LEAKTEST
 622     if (str->str_len) {
 623         Safefree(str->str_ptr);
 624         str->str_ptr = Nullch;
 625     }
 626     if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
 627         arg_free(str->str_u.str_args);
 628     Safefree(str);
 629 #else /* LEAKTEST */
 630     if (str->str_len) {
 631         if (str->str_len > 127) {       /* next user not likely to want more */
 632             Safefree(str->str_ptr);     /* so give it back to malloc */
 633             str->str_ptr = Nullch;
 634             str->str_len = 0;
 635         }
 636         else
 637             str->str_ptr[0] = '\0';
 638     }
 639     if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
 640         arg_free(str->str_u.str_args);
 641     str->str_cur = 0;
 642     str->str_nok = 0;
 643     str->str_pok = 0;
 644     str->str_state = SS_FREE;
 645 #ifdef TAINT
 646     str->str_tainted = 0;
 647 #endif
 648     freestrroot = str;
 649 #endif /* LEAKTEST */
 650 }
 651
 652 STRLEN
 653 str_len(str)
 654 register STR *str;
 655 {
 656     if (!str)
 657         return 0;
 658     if (!(str->str_pok))
 659         (void)str_2ptr(str);
 660     if (str->str_ptr)
 661         return str->str_cur;
 662     else
 663         return 0;
 664 }
 665
 666 str_eq(str1,str2)
 667 register STR *str1;
 668 register STR *str2;
 669 {
 670     if (!str1 || str1 == &str_undef)
 671         return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur);
 672     if (!str2 || str2 == &str_undef)
 673         return !str1->str_cur;
 674
 675     if (!str1->str_pok)
 676         (void)str_2ptr(str1);
 677     if (!str2->str_pok)
 678         (void)str_2ptr(str2);
 679
 680     if (str1->str_cur != str2->str_cur)
 681         return 0;
 682
 683     return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur);
 684 }
 685
 686 str_cmp(str1,str2)
 687 register STR *str1;
 688 register STR *str2;
 689 {
 690     int retval;
 691
 692     if (!str1 || str1 == &str_undef)
 693         return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur)?0:-1;
 694     if (!str2 || str2 == &str_undef)
 695         return str1->str_cur != 0;
 696
 697     if (!str1->str_pok)
 698         (void)str_2ptr(str1);
 699     if (!str2->str_pok)
 700         (void)str_2ptr(str2);
 701
 702     if (str1->str_cur < str2->str_cur) {
 703         if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
 704             return retval < 0 ? -1 : 1;
 705         else
 706             return -1;
 707     }
 708     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
 709         return retval < 0 ? -1 : 1;
 710     else if (str1->str_cur == str2->str_cur)
 711         return 0;
 712     else
 713         return 1;
 714 }
 715
 716 char *
 717 str_gets(str,fp,append)
 718 register STR *str;
 719 register FILE *fp;
 720 int append;
 721 {
 722     register char *bp;          /* we're going to steal some values */
 723     register int cnt;           /*  from the stdio struct and put EVERYTHING */
 724     register STDCHAR *ptr;      /*   in the innermost loop into registers */
 725     register int newline = rschar;/* (assuming >= 6 registers) */
 726     int i;
 727     STRLEN bpx;
 728     int shortbuffered;
 729
 730     if (str == &str_undef)
 731         return Nullch;
 732 #ifdef STDSTDIO         /* Here is some breathtakingly efficient cheating */
 733     cnt = fp->_cnt;                     /* get count into register */
 734     str->str_nok = 0;                   /* invalidate number */
 735     str->str_pok = 1;                   /* validate pointer */
 736     if (str->str_len <= cnt + 1) {      /* make sure we have the room */
 737         if (cnt > 80 && str->str_len > 0) {
 738             shortbuffered = cnt - str->str_len + 1;
 739             cnt = str->str_len - 1;
 740         }
 741         else {
 742             shortbuffered = 0;
 743             STR_GROW(str, append+cnt+2);/* (remembering cnt can be -1) */
 744         }
 745     }
 746     else
 747         shortbuffered = 0;
 748     bp = str->str_ptr + append;         /* move these two too to registers */
 749     ptr = fp->_ptr;
 750     for (;;) {
 751       screamer:
 752         while (--cnt >= 0) {                    /* this */      /* eat */
 753             if ((*bp++ = *ptr++) == newline)    /* really */    /* dust */
 754                 goto thats_all_folks;           /* screams */   /* sed :-) */
 755         }
 756
 757         if (shortbuffered) {                    /* oh well, must extend */
 758             cnt = shortbuffered;
 759             shortbuffered = 0;
 760             bpx = bp - str->str_ptr;    /* prepare for possible relocation */
 761             str->str_cur = bpx;
 762             STR_GROW(str, str->str_len + append + cnt + 2);
 763             bp = str->str_ptr + bpx;    /* reconstitute our pointer */
 764             continue;
 765         }
 766
 767         fp->_cnt = cnt;                 /* deregisterize cnt and ptr */
 768         fp->_ptr = ptr;
 769         i = _filbuf(fp);                /* get more characters */
 770         cnt = fp->_cnt;
 771         ptr = fp->_ptr;                 /* reregisterize cnt and ptr */
 772
 773         bpx = bp - str->str_ptr;        /* prepare for possible relocation */
 774         str->str_cur = bpx;
 775         STR_GROW(str, bpx + cnt + 2);
 776         bp = str->str_ptr + bpx;        /* reconstitute our pointer */
 777
 778         if (i == newline) {             /* all done for now? */
 779             *bp++ = i;
 780             goto thats_all_folks;
 781         }
 782         else if (i == EOF)              /* all done for ever? */
 783             goto thats_really_all_folks;
 784         *bp++ = i;                      /* now go back to screaming loop */
 785     }
 786
 787 thats_all_folks:
 788     if (rslen > 1 && (bp - str->str_ptr < rslen || bcmp(bp - rslen, rs, rslen)))
 789         goto screamer;  /* go back to the fray */
 790 thats_really_all_folks:
 791     if (shortbuffered)
 792         cnt += shortbuffered;
 793     fp->_cnt = cnt;                     /* put these back or we're in trouble */
 794     fp->_ptr = ptr;
 795     *bp = '\0';
 796     str->str_cur = bp - str->str_ptr;   /* set length */
 797
 798 #else /* !STDSTDIO */   /* The big, slow, and stupid way */
 799
 800     {
 801         static char buf[8192];
 802         char * bpe = buf + sizeof(buf) - 3;
 803
 804 screamer:
 805         bp = buf;
 806         while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ;
 807
 808         *bp = '\0';
 809         if (append)
 810             str_cat(str, buf);
 811         else
 812             str_set(str, buf);
 813         if (i != EOF                    /* joy */
 814             &&
 815             (i != newline
 816              ||
 817              (rslen > 1
 818               &&
 819               (str->str_cur < rslen
 820                ||
 821                bcmp(str->str_ptr + str->str_cur - rslen, rs, rslen)
 822               )
 823              )
 824             )
 825            )
 826         {
 827             append = -1;
 828             goto screamer;
 829         }
 830     }
 831
 832 #endif /* STDSTDIO */
 833
 834     return str->str_cur - append ? str->str_ptr : Nullch;
 835 }
 836
 837 ARG *
 838 parselist(str)
 839 STR *str;
 840 {
 841     register CMD *cmd;
 842     register ARG *arg;
 843     CMD *oldcurcmd = curcmd;
 844     int oldperldb = perldb;
 845     int retval;
 846
 847     perldb = 0;
 848     str_sset(linestr,str);
 849     in_eval++;
 850     oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
 851     bufend = bufptr + linestr->str_cur;
 852     if (++loop_ptr >= loop_max) {
 853         loop_max += 128;
 854         Renew(loop_stack, loop_max, struct loop);
 855     }
 856     loop_stack[loop_ptr].loop_label = "_EVAL_";
 857     loop_stack[loop_ptr].loop_sp = 0;
 858 #ifdef DEBUGGING
 859     if (debug & 4) {
 860         deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
 861     }
 862 #endif
 863     if (setjmp(loop_stack[loop_ptr].loop_env)) {
 864         in_eval--;
 865         loop_ptr--;
 866         perldb = oldperldb;
 867         fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
 868     }
 869 #ifdef DEBUGGING
 870     if (debug & 4) {
 871         char *tmps = loop_stack[loop_ptr].loop_label;
 872         deb("(Popping label #%d %s)\n",loop_ptr,
 873             tmps ? tmps : "" );
 874     }
 875 #endif
 876     loop_ptr--;
 877     error_count = 0;
 878     curcmd = &compiling;
 879     curcmd->c_line = oldcurcmd->c_line;
 880     retval = yyparse();
 881     curcmd = oldcurcmd;
 882     perldb = oldperldb;
 883     in_eval--;
 884     if (retval || error_count)
 885         fatal("Invalid component in string or format");
 886     cmd = eval_root;
 887     arg = cmd->c_expr;
 888     if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
 889         fatal("panic: error in parselist %d %x %d", cmd->c_type,
 890           cmd->c_next, arg ? arg->arg_type : -1);
 891     Safefree(cmd);
 892     eval_root = Nullcmd;
 893     return arg;
 894 }
 895
 896 void
 897 intrpcompile(src)
 898 STR *src;
 899 {
 900     register char *s = str_get(src);
 901     register char *send = s + src->str_cur;
 902     register STR *str;
 903     register char *t;
 904     STR *toparse;
 905     STRLEN len;
 906     register int brackets;
 907     register char *d;
 908     STAB *stab;
 909     char *checkpoint;
 910     int sawcase = 0;
 911
 912     toparse = Str_new(76,0);
 913     str = Str_new(77,0);
 914
 915     str_nset(str,"",0);
 916     str_nset(toparse,"",0);
 917     t = s;
 918     while (s < send) {
 919         if (*s == '\\' && s[1] && index("$@[{\\]}lLuUE",s[1])) {
 920             str_ncat(str, t, s - t);
 921             ++s;
 922             if (isalpha(*s)) {
 923                 str_ncat(str, "$c", 2);
 924                 sawcase = (*s != 'E');
 925             }
 926             else {
 927                 if (*nointrp && s+1 < send)
 928                     if (*s != '@' && (*s != '$' || index(nointrp,s[1])))
 929                         str_ncat(str,s-1,1);
 930                 str_ncat(str, "$b", 2);
 931             }
 932             str_ncat(str, s, 1);
 933             ++s;
 934             t = s;
 935         }
 936         else if ((*s == '@' || (*s == '$' && !index(nointrp,s[1]))) &&
 937           s+1 < send) {
 938             str_ncat(str,t,s-t);
 939             t = s;
 940             if (*s == '$' && s[1] == '#' && (isalpha(s[2]) || s[2] == '_'))
 941                 s++;
 942             s = scanident(s,send,tokenbuf);
 943             if (*t == '@' &&
 944               (!(stab = stabent(tokenbuf,FALSE)) ||
 945                  (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) {
 946                 str_ncat(str,"@",1);
 947                 s = ++t;
 948                 continue;       /* grandfather @ from old scripts */
 949             }
 950             str_ncat(str,"$a",2);
 951             str_ncat(toparse,",",1);
 952             if (t[1] != '{' && (*s == '['  || *s == '{' /* }} */ ) &&
 953               (stab = stabent(tokenbuf,FALSE)) &&
 954               ((*s == '[') ? (stab_xarray(stab) != 0) : (stab_xhash(stab) != 0)) ) {
 955                 brackets = 0;
 956                 checkpoint = s;
 957                 do {
 958                     switch (*s) {
 959                     case '[':
 960                         if (s[-1] != '$')
 961                             brackets++;
 962                         break;
 963                     case '{':
 964                         brackets++;
 965                         break;
 966                     case ']':
 967                         if (s[-1] != '$')
 968                             brackets--;
 969                         break;
 970                     case '}':
 971                         brackets--;
 972                         break;
 973                     case '\'':
 974                     case '"':
 975                         if (s[-1] != '$') {
 976                             s = cpytill(tokenbuf,s+1,send,*s,&len);
 977                             if (s >= send)
 978                                 fatal("Unterminated string");
 979                         }
 980                         break;
 981                     }
 982                     s++;
 983                 } while (brackets > 0 && s < send);
 984                 if (s > send)
 985                     fatal("Unmatched brackets in string");
 986                 if (*nointrp) {         /* we're in a regular expression */
 987                     d = checkpoint;
 988                     if (*d == '{' && s[-1] == '}') {    /* maybe {n,m} */
 989                         ++d;
 990                         if (isdigit(*d)) {      /* matches /^{\d,?\d*}$/ */
 991                             if (*++d == ',')
 992                                 ++d;
 993                             while (isdigit(*d))
 994                                 d++;
 995                             if (d == s - 1)
 996                                 s = checkpoint;         /* Is {n,m}! Backoff! */
 997                         }
 998                     }
 999                     else if (*d == '[' && s[-1] == ']') { /* char class? */
1000                         int weight = 2;         /* let's weigh the evidence */
1001                         char seen[256];
1002                         unsigned char un_char = 0, last_un_char;
1003
1004                         Zero(seen,256,char);
1005                         *--s = '\0';
1006                         if (d[1] == '^')
1007                             weight += 150;
1008                         else if (d[1] == '$')
1009                             weight -= 3;
1010                         if (isdigit(d[1])) {
1011                             if (d[2]) {
1012                                 if (isdigit(d[2]) && !d[3])
1013                                     weight -= 10;
1014                             }
1015                             else
1016                                 weight -= 100;
1017                         }
1018                         for (d++; d < s; d++) {
1019                             last_un_char = un_char;
1020                             un_char = (unsigned char)*d;
1021                             switch (*d) {
1022                             case '&':
1023                             case '$':
1024                                 weight -= seen[un_char] * 10;
1025                                 if (isalpha(d[1]) || isdigit(d[1]) ||
1026                                   d[1] == '_') {
1027                                     d = scanident(d,s,tokenbuf);
1028                                     if (stabent(tokenbuf,FALSE))
1029                                         weight -= 100;
1030                                     else
1031                                         weight -= 10;
1032                                 }
1033                                 else if (*d == '$' && d[1] &&
1034                                   index("[#!%*<>()-=",d[1])) {
1035                                     if (!d[2] || /*{*/ index("])} =",d[2]))
1036                                         weight -= 10;
1037                                     else
1038                                         weight -= 1;
1039                                 }
1040                                 break;
1041                             case '\\':
1042                                 un_char = 254;
1043                                 if (d[1]) {
1044                                     if (index("wds",d[1]))
1045                                         weight += 100;
1046                                     else if (seen['\''] || seen['"'])
1047                                         weight += 1;
1048                                     else if (index("rnftb",d[1]))
1049                                         weight += 40;
1050                                     else if (isdigit(d[1])) {
1051                                         weight += 40;
1052                                         while (d[1] && isdigit(d[1]))
1053                                             d++;
1054                                     }
1055                                 }
1056                                 else
1057                                     weight += 100;
1058                                 break;
1059                             case '-':
1060                                 if (last_un_char < (unsigned char) d[1]
1061                                   || d[1] == '\\') {
1062                                     if (index("aA01! ",last_un_char))
1063                                         weight += 30;
1064                                     if (index("zZ79~",d[1]))
1065                                         weight += 30;
1066                                 }
1067                                 else
1068                                     weight -= 1;
1069                             default:
1070                                 if (isalpha(*d) && d[1] && isalpha(d[1])) {
1071                                     bufptr = d;
1072                                     if (yylex() != WORD)
1073                                         weight -= 150;
1074                                     d = bufptr;
1075                                 }
1076                                 if (un_char == last_un_char + 1)
1077                                     weight += 5;
1078                                 weight -= seen[un_char];
1079                                 break;
1080                             }
1081                             seen[un_char]++;
1082                         }
1083 #ifdef DEBUGGING
1084                         if (debug & 512)
1085                             fprintf(stderr,"[%s] weight %d\n",
1086                               checkpoint+1,weight);
1087 #endif
1088                         *s++ = ']';
1089                         if (weight >= 0)        /* probably a character class */
1090                             s = checkpoint;
1091                     }
1092                 }
1093             }
1094             if (*t == '@')
1095                 str_ncat(toparse, "join($\",", 8);
1096             if (t[1] == '{' && s[-1] == '}') {
1097                 str_ncat(toparse, t, 1);
1098                 str_ncat(toparse, t+2, s - t - 3);
1099             }
1100             else
1101                 str_ncat(toparse, t, s - t);
1102             if (*t == '@')
1103                 str_ncat(toparse, ")", 1);
1104             t = s;
1105         }
1106         else
1107             s++;
1108     }
1109     str_ncat(str,t,s-t);
1110     if (sawcase)
1111         str_ncat(str, "$cE", 3);
1112     if (toparse->str_ptr && *toparse->str_ptr == ',') {
1113         *toparse->str_ptr = '(';
1114         str_ncat(toparse,",$$);",5);
1115         str->str_u.str_args = parselist(toparse);
1116         str->str_u.str_args->arg_len--;         /* ignore $$ reference */
1117     }
1118     else
1119         str->str_u.str_args = Nullarg;
1120     str_free(toparse);
1121     str->str_pok |= SP_INTRP;
1122     str->str_nok = 0;
1123     str_replace(src,str);
1124 }
1125
1126 STR *
1127 interp(str,src,sp)
1128 register STR *str;
1129 STR *src;
1130 int sp;
1131 {
1132     register char *s;
1133     register char *t;
1134     register char *send;
1135     register STR **elem;
1136     int docase = 0;
1137     int l = 0;
1138     int u = 0;
1139     int L = 0;
1140     int U = 0;
1141
1142     if (str == &str_undef)
1143         return Nullstr;
1144     if (!(src->str_pok & SP_INTRP)) {
1145         int oldsave = savestack->ary_fill;
1146
1147         (void)savehptr(&curstash);
1148         curstash = curcmd->c_stash;     /* so stabent knows right package */
1149         intrpcompile(src);
1150         restorelist(oldsave);
1151     }
1152     s = src->str_ptr;           /* assumed valid since str_pok set */
1153     t = s;
1154     send = s + src->str_cur;
1155
1156     if (src->str_u.str_args) {
1157         (void)eval(src->str_u.str_args,G_ARRAY,sp);
1158         /* Assuming we have correct # of args */
1159         elem = stack->ary_array + sp;
1160     }
1161
1162     str_nset(str,"",0);
1163     while (s < send) {
1164         if (*s == '$' && s+1 < send) {
1165             if (s-t > 0)
1166                 str_ncat(str,t,s-t);
1167             switch(*++s) {
1168             case 'a':
1169                 str_scat(str,*++elem);
1170                 break;
1171             case 'b':
1172                 str_ncat(str,++s,1);
1173                 break;
1174             case 'c':
1175                 if (docase && str->str_cur >= docase) {
1176                     char *b = str->str_ptr + --docase;
1177
1178                     if (L)
1179                         lcase(b, str->str_ptr + str->str_cur);
1180                     else if (U)
1181                         ucase(b, str->str_ptr + str->str_cur);
1182
1183                     if (u)      /* note that l & u are independent of L & U */
1184                         ucase(b, b+1);
1185                     else if (l)
1186                         lcase(b, b+1);
1187                     l = u = 0;
1188                 }
1189                 docase = str->str_cur + 1;
1190                 switch (*++s) {
1191                 case 'u':
1192                     u = 1;
1193                     l = 0;
1194                     break;
1195                 case 'U':
1196                     U = 1;
1197                     L = 0;
1198                     break;
1199                 case 'l':
1200                     l = 1;
1201                     u = 0;
1202                     break;
1203                 case 'L':
1204                     L = 1;
1205                     U = 0;
1206                     break;
1207                 case 'E':
1208                     docase = L = U = l = u = 0;
1209                     break;
1210                 }
1211                 break;
1212             }
1213             t = ++s;
1214         }
1215         else
1216             s++;
1217     }
1218     if (s-t > 0)
1219         str_ncat(str,t,s-t);
1220     return str;
1221 }
1222
1223 ucase(s,send)
1224 register char *s;
1225 register char *send;
1226 {
1227     while (s < send) {
1228         if (isascii(*s) && islower(*s))
1229             *s = toupper(*s);
1230         s++;
1231     }
1232 }
1233
1234 lcase(s,send)
1235 register char *s;
1236 register char *send;
1237 {
1238     while (s < send) {
1239         if (isascii(*s) && isupper(*s))
1240             *s = tolower(*s);
1241         s++;
1242     }
1243 }
1244
1245 void
1246 str_inc(str)
1247 register STR *str;
1248 {
1249     register char *d;
1250
1251     if (!str || str == &str_undef)
1252         return;
1253     if (str->str_nok) {
1254         str->str_u.str_nval += 1.0;
1255         str->str_pok = 0;
1256         return;
1257     }
1258     if (!str->str_pok || !*str->str_ptr) {
1259         str->str_u.str_nval = 1.0;
1260         str->str_nok = 1;
1261         str->str_pok = 0;
1262         return;
1263     }
1264     d = str->str_ptr;
1265     while (isalpha(*d)) d++;
1266     while (isdigit(*d)) d++;
1267     if (*d) {
1268         str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
1269         return;
1270     }
1271     d--;
1272     while (d >= str->str_ptr) {
1273         if (isdigit(*d)) {
1274             if (++*d <= '9')
1275                 return;
1276             *(d--) = '0';
1277         }
1278         else {
1279             ++*d;
1280             if (isalpha(*d))
1281                 return;
1282             *(d--) -= 'z' - 'a' + 1;
1283         }
1284     }
1285     /* oh,oh, the number grew */
1286     STR_GROW(str, str->str_cur + 2);
1287     str->str_cur++;
1288     for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
1289         *d = d[-1];
1290     if (isdigit(d[1]))
1291         *d = '1';
1292     else
1293         *d = d[1];
1294 }
1295
1296 void
1297 str_dec(str)
1298 register STR *str;
1299 {
1300     if (!str || str == &str_undef)
1301         return;
1302     if (str->str_nok) {
1303         str->str_u.str_nval -= 1.0;
1304         str->str_pok = 0;
1305         return;
1306     }
1307     if (!str->str_pok) {
1308         str->str_u.str_nval = -1.0;
1309         str->str_nok = 1;
1310         return;
1311     }
1312     str_numset(str,atof(str->str_ptr) - 1.0);
1313 }
1314
1315 /* Make a string that will exist for the duration of the expression
1316  * evaluation.  Actually, it may have to last longer than that, but
1317  * hopefully cmd_exec won't free it until it has been assigned to a
1318  * permanent location. */
1319
1320 static long tmps_size = -1;
1321
1322 STR *
1323 str_mortal(oldstr)
1324 STR *oldstr;
1325 {
1326     register STR *str = Str_new(78,0);
1327
1328     str_sset(str,oldstr);
1329     if (++tmps_max > tmps_size) {
1330         tmps_size = tmps_max;
1331         if (!(tmps_size & 127)) {
1332             if (tmps_size)
1333                 Renew(tmps_list, tmps_size + 128, STR*);
1334             else
1335                 New(702,tmps_list, 128, STR*);
1336         }
1337     }
1338     tmps_list[tmps_max] = str;
1339     if (str->str_pok)
1340         str->str_pok |= SP_TEMP;
1341     return str;
1342 }
1343
1344 /* same thing without the copying */
1345
1346 STR *
1347 str_2mortal(str)
1348 register STR *str;
1349 {
1350     if (str == &str_undef)
1351         return str;
1352     if (++tmps_max > tmps_size) {
1353         tmps_size = tmps_max;
1354         if (!(tmps_size & 127)) {
1355             if (tmps_size)
1356                 Renew(tmps_list, tmps_size + 128, STR*);
1357             else
1358                 New(704,tmps_list, 128, STR*);
1359         }
1360     }
1361     tmps_list[tmps_max] = str;
1362     if (str->str_pok)
1363         str->str_pok |= SP_TEMP;
1364     return str;
1365 }
1366
1367 STR *
1368 str_make(s,len)
1369 char *s;
1370 STRLEN len;
1371 {
1372     register STR *str = Str_new(79,0);
1373
1374     if (!len)
1375         len = strlen(s);
1376     str_nset(str,s,len);
1377     return str;
1378 }
1379
1380 STR *
1381 str_nmake(n)
1382 double n;
1383 {
1384     register STR *str = Str_new(80,0);
1385
1386     str_numset(str,n);
1387     return str;
1388 }
1389
1390 /* make an exact duplicate of old */
1391
1392 STR *
1393 str_smake(old)
1394 register STR *old;
1395 {
1396     register STR *new = Str_new(81,0);
1397
1398     if (!old)
1399         return Nullstr;
1400     if (old->str_state == SS_FREE) {
1401         warn("semi-panic: attempt to dup freed string");
1402         return Nullstr;
1403     }
1404     if (old->str_state == SS_INCR && !(old->str_pok & 2))
1405         Str_Grow(old,0);
1406     if (new->str_ptr)
1407         Safefree(new->str_ptr);
1408     Copy(old,new,1,STR);
1409     if (old->str_ptr) {
1410         new->str_ptr = nsavestr(old->str_ptr,old->str_len);
1411         new->str_pok &= ~SP_TEMP;
1412     }
1413     return new;
1414 }
1415
1416 str_reset(s,stash)
1417 register char *s;
1418 HASH *stash;
1419 {
1420     register HENT *entry;
1421     register STAB *stab;
1422     register STR *str;
1423     register int i;
1424     register SPAT *spat;
1425     register int max;
1426
1427     if (!*s) {          /* reset ?? searches */
1428         for (spat = stash->tbl_spatroot;
1429           spat != Nullspat;
1430           spat = spat->spat_next) {
1431             spat->spat_flags &= ~SPAT_USED;
1432         }
1433         return;
1434     }
1435
1436     /* reset variables */
1437
1438     if (!stash->tbl_array)
1439         return;
1440     while (*s) {
1441         i = *s;
1442         if (s[1] == '-') {
1443             s += 2;
1444         }
1445         max = *s++;
1446         for ( ; i <= max; i++) {
1447             for (entry = stash->tbl_array[i];
1448               entry;
1449               entry = entry->hent_next) {
1450                 stab = (STAB*)entry->hent_val;
1451                 str = stab_val(stab);
1452                 str->str_cur = 0;
1453                 str->str_nok = 0;
1454 #ifdef TAINT
1455                 str->str_tainted = tainted;
1456 #endif
1457                 if (str->str_ptr != Nullch)
1458                     str->str_ptr[0] = '\0';
1459                 if (stab_xarray(stab)) {
1460                     aclear(stab_xarray(stab));
1461                 }
1462                 if (stab_xhash(stab)) {
1463                     hclear(stab_xhash(stab), FALSE);
1464                     if (stab == envstab)
1465                         environ[0] = Nullch;
1466                 }
1467             }
1468         }
1469     }
1470 }
1471
1472 #ifdef TAINT
1473 taintproper(s)
1474 char *s;
1475 {
1476 #ifdef DEBUGGING
1477     if (debug & 2048)
1478         fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
1479 #endif
1480     if (tainted && (!euid || euid != uid || egid != gid)) {
1481         if (!unsafe)
1482             fatal("%s", s);
1483         else if (dowarn)
1484             warn("%s", s);
1485     }
1486 }
1487
1488 taintenv()
1489 {
1490     register STR *envstr;
1491
1492     envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
1493     if (envstr == &str_undef || envstr->str_tainted) {
1494         tainted = 1;
1495         if (envstr->str_tainted == 2)
1496             taintproper("Insecure directory in PATH");
1497         else
1498             taintproper("Insecure PATH");
1499     }
1500     envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
1501     if (envstr != &str_undef && envstr->str_tainted) {
1502         tainted = 1;
1503         taintproper("Insecure IFS");
1504     }
1505 }
1506 #endif /* TAINT */