str.c

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