source: trunk/third/perl/str.c @ 9009

/* $RCSfile: str.c,v $$Revision: 1.1.1.1 $$Date: 1996-10-02 06:39:57 $
 *
 *    Copyright (c) 1991, Larry Wall
 *
 *    You may distribute under the terms of either the GNU General Public
 *    License or the Artistic License, as specified in the README file.
 *
 * $Log: not supported by cvs2svn $
 * Revision 4.0.1.7  1993/02/05  19:43:47  lwall
 * patch36: the non-std stdio input code wasn't null-proof
 *
 * Revision 4.0.1.6  92/06/11  21:14:21  lwall
 * patch34: quotes containing subscripts containing variables didn't parse right
 * 
 * Revision 4.0.1.5  92/06/08  15:40:43  lwall
 * patch20: removed implicit int declarations on functions
 * patch20: Perl now distinguishes overlapped copies from non-overlapped
 * patch20: paragraph mode now skips extra newlines automatically
 * patch20: fixed memory leak in doube-quote interpretation
 * patch20: made /\$$foo/ look for literal '$foo'
 * patch20: "$var{$foo'bar}" didn't scan subscript correctly
 * patch20: a splice on non-existent array elements could dump core
 * patch20: running taintperl explicitly now does checks even if $< == $>
 * 
 * Revision 4.0.1.4  91/11/05  18:40:51  lwall
 * patch11: $foo .= <BAR> could overrun malloced memory
 * patch11: \$ didn't always make it through double-quoter to regexp routines
 * patch11: prepared for ctype implementations that don't define isascii()
 * 
 * Revision 4.0.1.3  91/06/10  01:27:54  lwall
 * patch10: $) and $| incorrectly handled in run-time patterns
 * 
 * Revision 4.0.1.2  91/06/07  11:58:13  lwall
 * patch4: new copyright notice
 * patch4: taint check on undefined string could cause core dump
 * 
 * Revision 4.0.1.1  91/04/12  09:15:30  lwall
 * patch1: fixed undefined environ problem
 * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment
 * patch1: $foo .= <BAR> could cause core dump for certain lengths of $foo
 * 
 * Revision 4.0  91/03/20  01:39:55  lwall
 * 4.0 baseline.
 * 
 */

#include "EXTERN.h"
#include "perl.h"
#include "perly.h"

static void ucase();
static void lcase();

#ifndef str_get
char *
str_get(str)
STR *str;
{
#ifdef TAINT
    tainted |= str->str_tainted;
#endif
    return str->str_pok ? str->str_ptr : str_2ptr(str);
}
#endif

/* dlb ... guess we have a "crippled cc".
 * dlb the following functions are usually macros.
 */
#ifndef str_true
int
str_true(Str)
STR *Str;
{
        if (Str->str_pok) {
            if (*Str->str_ptr > '0' ||
              Str->str_cur > 1 ||
              (Str->str_cur && *Str->str_ptr != '0'))
                return 1;
            return 0;
        }
        if (Str->str_nok)
                return (Str->str_u.str_nval != 0.0);
        return 0;
}
#endif /* str_true */

#ifndef str_gnum
double str_gnum(Str)
STR *Str;
{
#ifdef TAINT
        tainted |= Str->str_tainted;
#endif /* TAINT*/
        if (Str->str_nok)
                return Str->str_u.str_nval;
        return str_2num(Str);
}
#endif /* str_gnum */
/* dlb ... end of crutch */

char *
str_grow(str,newlen)
register STR *str;
#ifndef DOSISH
register int newlen;
#else
unsigned long newlen;
#endif
{
    register char *s = str->str_ptr;

#ifdef MSDOS
    if (newlen >= 0x10000) {
        fprintf(stderr, "Allocation too large: %lx\n", newlen);
        exit(1);
    }
#endif /* MSDOS */
    if (str->str_state == SS_INCR) {            /* data before str_ptr? */
        str->str_len += str->str_u.str_useful;
        str->str_ptr -= str->str_u.str_useful;
        str->str_u.str_useful = 0L;
        Move(s, str->str_ptr, str->str_cur+1, char);
        s = str->str_ptr;
        str->str_state = SS_NORM;                       /* normal again */
        if (newlen > str->str_len)
            newlen += 10 * (newlen - str->str_cur); /* avoid copy each time */
    }
    if (newlen > str->str_len) {                /* need more room? */
        if (str->str_len)
            Renew(s,newlen,char);
        else
            New(703,s,newlen,char);
        str->str_ptr = s;
        str->str_len = newlen;
    }
    return s;
}

void
str_numset(str,num)
register STR *str;
double num;
{
    if (str->str_pok) {
        str->str_pok = 0;       /* invalidate pointer */
        if (str->str_state == SS_INCR)
            Str_Grow(str,0);
    }
    str->str_u.str_nval = num;
    str->str_state = SS_NORM;
    str->str_nok = 1;                   /* validate number */
#ifdef TAINT
    str->str_tainted = tainted;
#endif
}

char *
str_2ptr(str)
register STR *str;
{
    register char *s;
    int olderrno;

    if (!str)
        return "";
    if (str->str_nok) {
        STR_GROW(str, 30);
        s = str->str_ptr;
        olderrno = errno;       /* some Xenix systems wipe out errno here */
#if defined(scs) && defined(ns32000)
        gcvt(str->str_u.str_nval,20,s);
#else
#ifdef apollo
        if (str->str_u.str_nval == 0.0)
            (void)strcpy(s,"0");
        else
#endif /*apollo*/
        (void)sprintf(s,"%.20g",str->str_u.str_nval);
#endif /*scs*/
        errno = olderrno;
        while (*s) s++;
#ifdef hcx
        if (s[-1] == '.')
            s--;
#endif
    }
    else {
        if (str == &str_undef)
            return No;
        if (dowarn)
            warn("Use of uninitialized variable");
        STR_GROW(str, 30);
        s = str->str_ptr;
    }
    *s = '\0';
    str->str_cur = s - str->str_ptr;
    str->str_pok = 1;
#ifdef DEBUGGING
    if (debug & 32)
        fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr);
#endif
    return str->str_ptr;
}

double
str_2num(str)
register STR *str;
{
    if (!str)
        return 0.0;
    if (str->str_state == SS_INCR)
        Str_Grow(str,0);       /* just force copy down */
    str->str_state = SS_NORM;
    if (str->str_len && str->str_pok)
        str->str_u.str_nval = atof(str->str_ptr);
    else  {
        if (str == &str_undef)
            return 0.0;
        if (dowarn)
            warn("Use of uninitialized variable");
        str->str_u.str_nval = 0.0;
    }
    str->str_nok = 1;
#ifdef DEBUGGING
    if (debug & 32)
        fprintf(stderr,"0x%lx num(%g)\n",str,str->str_u.str_nval);
#endif
    return str->str_u.str_nval;
}

/* Note: str_sset() should not be called with a source string that needs
 * be reused, since it may destroy the source string if it is marked
 * as temporary.
 */

void
str_sset(dstr,sstr)
STR *dstr;
register STR *sstr;
{
#ifdef TAINT
    if (sstr)
        tainted |= sstr->str_tainted;
#endif
    if (sstr == dstr || dstr == &str_undef)
        return;
    if (!sstr)
        dstr->str_pok = dstr->str_nok = 0;
    else if (sstr->str_pok) {

        /*
         * Check to see if we can just swipe the string.  If so, it's a
         * possible small lose on short strings, but a big win on long ones.
         * It might even be a win on short strings if dstr->str_ptr
         * has to be allocated and sstr->str_ptr has to be freed.
         */

        if (sstr->str_pok & SP_TEMP) {          /* slated for free anyway? */
            if (dstr->str_ptr) {
                if (dstr->str_state == SS_INCR)
                    dstr->str_ptr -= dstr->str_u.str_useful;
                Safefree(dstr->str_ptr);
            }
            dstr->str_ptr = sstr->str_ptr;
            dstr->str_len = sstr->str_len;
            dstr->str_cur = sstr->str_cur;
            dstr->str_state = sstr->str_state;
            dstr->str_pok = sstr->str_pok & ~SP_TEMP;
#ifdef TAINT
            dstr->str_tainted = sstr->str_tainted;
#endif
            sstr->str_ptr = Nullch;
            sstr->str_len = 0;
            sstr->str_pok = 0;                  /* wipe out any weird flags */
            sstr->str_state = 0;                /* so sstr frees uneventfully */
        }
        else {                                  /* have to copy actual string */
            if (dstr->str_ptr) {
                if (dstr->str_state == SS_INCR) {
                        Str_Grow(dstr,0);
                }
            }
            str_nset(dstr,sstr->str_ptr,sstr->str_cur);
        }
        /*SUPPRESS 560*/
        if (dstr->str_nok = sstr->str_nok)
            dstr->str_u.str_nval = sstr->str_u.str_nval;
        else {
#ifdef STRUCTCOPY
            dstr->str_u = sstr->str_u;
#else
            dstr->str_u.str_nval = sstr->str_u.str_nval;
#endif
            if (dstr->str_cur == sizeof(STBP)) {
                char *tmps = dstr->str_ptr;

                if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
                    if (dstr->str_magic && dstr->str_magic->str_rare == 'X') {
                        str_free(dstr->str_magic);
                        dstr->str_magic = Nullstr;
                    }
                    if (!dstr->str_magic) {
                        dstr->str_magic = str_smake(sstr->str_magic);
                        dstr->str_magic->str_rare = 'X';
                    }
                }
            }
        }
    }
    else if (sstr->str_nok)
        str_numset(dstr,sstr->str_u.str_nval);
    else {
        if (dstr->str_state == SS_INCR)
            Str_Grow(dstr,0);       /* just force copy down */

#ifdef STRUCTCOPY
        dstr->str_u = sstr->str_u;
#else
        dstr->str_u.str_nval = sstr->str_u.str_nval;
#endif
        dstr->str_pok = dstr->str_nok = 0;
    }
}

void
str_nset(str,ptr,len)
register STR *str;
register char *ptr;
register STRLEN len;
{
    if (str == &str_undef)
        return;
    STR_GROW(str, len + 1);
    if (ptr)
        Move(ptr,str->str_ptr,len,char);
    str->str_cur = len;
    *(str->str_ptr+str->str_cur) = '\0';
    str->str_nok = 0;           /* invalidate number */
    str->str_pok = 1;           /* validate pointer */
#ifdef TAINT
    str->str_tainted = tainted;
#endif
}

void
str_set(str,ptr)
register STR *str;
register char *ptr;
{
    register STRLEN len;

    if (str == &str_undef)
        return;
    if (!ptr)
        ptr = "";
    len = strlen(ptr);
    STR_GROW(str, len + 1);
    Move(ptr,str->str_ptr,len+1,char);
    str->str_cur = len;
    str->str_nok = 0;           /* invalidate number */
    str->str_pok = 1;           /* validate pointer */
#ifdef TAINT
    str->str_tainted = tainted;
#endif
}

void
str_chop(str,ptr)       /* like set but assuming ptr is in str */
register STR *str;
register char *ptr;
{
    register STRLEN delta;

    if (!ptr || !(str->str_pok))
        return;
    delta = ptr - str->str_ptr;
    str->str_len -= delta;
    str->str_cur -= delta;
    str->str_ptr += delta;
    if (str->str_state == SS_INCR)
        str->str_u.str_useful += delta;
    else {
        str->str_u.str_useful = delta;
        str->str_state = SS_INCR;
    }
    str->str_nok = 0;           /* invalidate number */
    str->str_pok = 1;           /* validate pointer (and unstudy str) */
}

void
str_ncat(str,ptr,len)
register STR *str;
register char *ptr;
register STRLEN len;
{
    if (str == &str_undef)
        return;
    if (!(str->str_pok))
        (void)str_2ptr(str);
    STR_GROW(str, str->str_cur + len + 1);
    Move(ptr,str->str_ptr+str->str_cur,len,char);
    str->str_cur += len;
    *(str->str_ptr+str->str_cur) = '\0';
    str->str_nok = 0;           /* invalidate number */
    str->str_pok = 1;           /* validate pointer */
#ifdef TAINT
    str->str_tainted |= tainted;
#endif
}

void
str_scat(dstr,sstr)
STR *dstr;
register STR *sstr;
{
    if (!sstr)
        return;
#ifdef TAINT
    tainted |= sstr->str_tainted;
#endif
    if (!(sstr->str_pok))
        (void)str_2ptr(sstr);
    if (sstr)
        str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
}

void
str_cat(str,ptr)
register STR *str;
register char *ptr;
{
    register STRLEN len;

    if (str == &str_undef)
        return;
    if (!ptr)
        return;
    if (!(str->str_pok))
        (void)str_2ptr(str);
    len = strlen(ptr);
    STR_GROW(str, str->str_cur + len + 1);
    Move(ptr,str->str_ptr+str->str_cur,len+1,char);
    str->str_cur += len;
    str->str_nok = 0;           /* invalidate number */
    str->str_pok = 1;           /* validate pointer */
#ifdef TAINT
    str->str_tainted |= tainted;
#endif
}

char *
str_append_till(str,from,fromend,delim,keeplist)
register STR *str;
register char *from;
register char *fromend;
register int delim;
char *keeplist;
{
    register char *to;
    register STRLEN len;

    if (str == &str_undef)
        return Nullch;
    if (!from)
        return Nullch;
    len = fromend - from;
    STR_GROW(str, str->str_cur + len + 1);
    str->str_nok = 0;           /* invalidate number */
    str->str_pok = 1;           /* validate pointer */
    to = str->str_ptr+str->str_cur;
    for (; from < fromend; from++,to++) {
        if (*from == '\\' && from+1 < fromend && delim != '\\') {
            if (!keeplist) {
                if (from[1] == delim || from[1] == '\\')
                    from++;
                else
                    *to++ = *from++;
            }
            else if (from[1] && index(keeplist,from[1]))
                *to++ = *from++;
            else
                from++;
        }
        else if (*from == delim)
            break;
        *to = *from;
    }
    *to = '\0';
    str->str_cur = to - str->str_ptr;
    return from;
}

STR *
#ifdef LEAKTEST
str_new(x,len)
int x;
#else
str_new(len)
#endif
STRLEN len;
{
    register STR *str;
    
    if (freestrroot) {
        str = freestrroot;
        freestrroot = str->str_magic;
        str->str_magic = Nullstr;
        str->str_state = SS_NORM;
    }
    else {
        Newz(700+x,str,1,STR);
    }
    if (len)
        STR_GROW(str, len + 1);
    return str;
}

void
str_magic(str, stab, how, name, namlen)
register STR *str;
STAB *stab;
int how;
char *name;
STRLEN namlen;
{
    if (str == &str_undef || str->str_magic)
        return;
    str->str_magic = Str_new(75,namlen);
    str = str->str_magic;
    str->str_u.str_stab = stab;
    str->str_rare = how;
    if (name)
        str_nset(str,name,namlen);
}

void
str_insert(bigstr,offset,len,little,littlelen)
STR *bigstr;
STRLEN offset;
STRLEN len;
char *little;
STRLEN littlelen;
{
    register char *big;
    register char *mid;
    register char *midend;
    register char *bigend;
    register int i;

    if (bigstr == &str_undef)
        return;
    bigstr->str_nok = 0;
    bigstr->str_pok = SP_VALID; /* disable possible screamer */

    i = littlelen - len;
    if (i > 0) {                        /* string might grow */
        STR_GROW(bigstr, bigstr->str_cur + i + 1);
        big = bigstr->str_ptr;
        mid = big + offset + len;
        midend = bigend = big + bigstr->str_cur;
        bigend += i;
        *bigend = '\0';
        while (midend > mid)            /* shove everything down */
            *--bigend = *--midend;
        Move(little,big+offset,littlelen,char);
        bigstr->str_cur += i;
        STABSET(bigstr);
        return;
    }
    else if (i == 0) {
        Move(little,bigstr->str_ptr+offset,len,char);
        STABSET(bigstr);
        return;
    }

    big = bigstr->str_ptr;
    mid = big + offset;
    midend = mid + len;
    bigend = big + bigstr->str_cur;

    if (midend > bigend)
        fatal("panic: str_insert");

    if (mid - big > bigend - midend) {  /* faster to shorten from end */
        if (littlelen) {
            Move(little, mid, littlelen,char);
            mid += littlelen;
        }
        i = bigend - midend;
        if (i > 0) {
            Move(midend, mid, i,char);
            mid += i;
        }
        *mid = '\0';
        bigstr->str_cur = mid - big;
    }
    /*SUPPRESS 560*/
    else if (i = mid - big) {   /* faster from front */
        midend -= littlelen;
        mid = midend;
        str_chop(bigstr,midend-i);
        big += i;
        while (i--)
            *--midend = *--big;
        if (littlelen)
            Move(little, mid, littlelen,char);
    }
    else if (littlelen) {
        midend -= littlelen;
        str_chop(bigstr,midend);
        Move(little,midend,littlelen,char);
    }
    else {
        str_chop(bigstr,midend);
    }
    STABSET(bigstr);
}

/* make str point to what nstr did */

void
str_replace(str,nstr)
register STR *str;
register STR *nstr;
{
    if (str == &str_undef)
        return;
    if (str->str_state == SS_INCR)
        Str_Grow(str,0);        /* just force copy down */
    if (nstr->str_state == SS_INCR)
        Str_Grow(nstr,0);
    if (str->str_ptr)
        Safefree(str->str_ptr);
    str->str_ptr = nstr->str_ptr;
    str->str_len = nstr->str_len;
    str->str_cur = nstr->str_cur;
    str->str_pok = nstr->str_pok;
    str->str_nok = nstr->str_nok;
#ifdef STRUCTCOPY
    str->str_u = nstr->str_u;
#else
    str->str_u.str_nval = nstr->str_u.str_nval;
#endif
#ifdef TAINT
    str->str_tainted = nstr->str_tainted;
#endif
    if (nstr->str_magic)
        str_free(nstr->str_magic);
    Safefree(nstr);
}

void
str_free(str)
register STR *str;
{
    if (!str || str == &str_undef)
        return;
    if (str->str_state) {
        if (str->str_state == SS_FREE)  /* already freed */
            return;
        if (str->str_state == SS_INCR && !(str->str_pok & 2)) {
            str->str_ptr -= str->str_u.str_useful;
            str->str_len += str->str_u.str_useful;
        }
    }
    if (str->str_magic)
        str_free(str->str_magic);
    str->str_magic = freestrroot;
#ifdef LEAKTEST
    if (str->str_len) {
        Safefree(str->str_ptr);
        str->str_ptr = Nullch;
    }
    if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
        arg_free(str->str_u.str_args);
    Safefree(str);
#else /* LEAKTEST */
    if (str->str_len) {
        if (str->str_len > 127) {       /* next user not likely to want more */
            Safefree(str->str_ptr);     /* so give it back to malloc */
            str->str_ptr = Nullch;
            str->str_len = 0;
        }
        else
            str->str_ptr[0] = '\0';
    }
    if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
        arg_free(str->str_u.str_args);
    str->str_cur = 0;
    str->str_nok = 0;
    str->str_pok = 0;
    str->str_state = SS_FREE;
#ifdef TAINT
    str->str_tainted = 0;
#endif
    freestrroot = str;
#endif /* LEAKTEST */
}

STRLEN
str_len(str)
register STR *str;
{
    if (!str)
        return 0;
    if (!(str->str_pok))
        (void)str_2ptr(str);
    if (str->str_ptr)
        return str->str_cur;
    else
        return 0;
}

int
str_eq(str1,str2)
register STR *str1;
register STR *str2;
{
    if (!str1 || str1 == &str_undef)
        return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur);
    if (!str2 || str2 == &str_undef)
        return !str1->str_cur;

    if (!str1->str_pok)
        (void)str_2ptr(str1);
    if (!str2->str_pok)
        (void)str_2ptr(str2);

    if (str1->str_cur != str2->str_cur)
        return 0;

    return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur);
}

int
str_cmp(str1,str2)
register STR *str1;
register STR *str2;
{
    int retval;

    if (!str1 || str1 == &str_undef)
        return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur)?0:-1;
    if (!str2 || str2 == &str_undef)
        return str1->str_cur != 0;

    if (!str1->str_pok)
        (void)str_2ptr(str1);
    if (!str2->str_pok)
        (void)str_2ptr(str2);

    if (str1->str_cur < str2->str_cur) {
        /*SUPPRESS 560*/
        if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
            return retval < 0 ? -1 : 1;
        else
            return -1;
    }
    /*SUPPRESS 560*/
    else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
        return retval < 0 ? -1 : 1;
    else if (str1->str_cur == str2->str_cur)
        return 0;
    else
        return 1;
}

char *
str_gets(str,fp,append)
register STR *str;
register FILE *fp;
int append;
{
    register char *bp;          /* we're going to steal some values */
    register int cnt;           /*  from the stdio struct and put EVERYTHING */
    register STDCHAR *ptr;      /*   in the innermost loop into registers */
    register int newline = rschar;/* (assuming >= 6 registers) */
    int i;
    STRLEN bpx;
    int shortbuffered;

    if (str == &str_undef)
        return Nullch;
    if (rspara) {               /* have to do this both before and after */
        do {                    /* to make sure file boundaries work right */
            i = getc(fp);
            if (i != '\n') {
                ungetc(i,fp);
                break;
            }
        } while (i != EOF);
    }
#ifdef STDSTDIO         /* Here is some breathtakingly efficient cheating */
    cnt = fp->_cnt;                     /* get count into register */
    str->str_nok = 0;                   /* invalidate number */
    str->str_pok = 1;                   /* validate pointer */
    if (str->str_len - append <= cnt + 1) { /* make sure we have the room */
        if (cnt > 80 && str->str_len > append) {
            shortbuffered = cnt - str->str_len + append + 1;
            cnt -= shortbuffered;
        }
        else {
            shortbuffered = 0;
            STR_GROW(str, append+cnt+2);/* (remembering cnt can be -1) */
        }
    }
    else
        shortbuffered = 0;
    bp = str->str_ptr + append;         /* move these two too to registers */
    ptr = fp->_ptr;
    for (;;) {
      screamer:
        while (--cnt >= 0) {                    /* this */      /* eat */
            if ((*bp++ = *ptr++) == newline)    /* really */    /* dust */
                goto thats_all_folks;           /* screams */   /* sed :-) */ 
        }
        
        if (shortbuffered) {                    /* oh well, must extend */
            cnt = shortbuffered;
            shortbuffered = 0;
            bpx = bp - str->str_ptr;    /* prepare for possible relocation */
            str->str_cur = bpx;
            STR_GROW(str, str->str_len + append + cnt + 2);
            bp = str->str_ptr + bpx;    /* reconstitute our pointer */
            continue;
        }

        fp->_cnt = cnt;                 /* deregisterize cnt and ptr */
        fp->_ptr = ptr;
        i = _filbuf(fp);                /* get more characters */
        cnt = fp->_cnt;
        ptr = fp->_ptr;                 /* reregisterize cnt and ptr */

        bpx = bp - str->str_ptr;        /* prepare for possible relocation */
        str->str_cur = bpx;
        STR_GROW(str, bpx + cnt + 2);
        bp = str->str_ptr + bpx;        /* reconstitute our pointer */

        if (i == newline) {             /* all done for now? */
            *bp++ = i;
            goto thats_all_folks;
        }
        else if (i == EOF)              /* all done for ever? */
            goto thats_really_all_folks;
        *bp++ = i;                      /* now go back to screaming loop */
    }

thats_all_folks:
    if (rslen > 1 && (bp - str->str_ptr < rslen || bcmp(bp - rslen, rs, rslen)))
        goto screamer;  /* go back to the fray */
thats_really_all_folks:
    if (shortbuffered)
        cnt += shortbuffered;
    fp->_cnt = cnt;                     /* put these back or we're in trouble */
    fp->_ptr = ptr;
    *bp = '\0';
    str->str_cur = bp - str->str_ptr;   /* set length */

#else /* !STDSTDIO */   /* The big, slow, and stupid way */

    {
        static char buf[8192];
        char * bpe = buf + sizeof(buf) - 3;

screamer:
        bp = buf;
        while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ;

        if (append)
            str_ncat(str, buf, bp - buf);
        else
            str_nset(str, buf, bp - buf);
        if (i != EOF                    /* joy */
            &&
            (i != newline
             ||
             (rslen > 1
              &&
              (str->str_cur < rslen
               ||
               bcmp(str->str_ptr + str->str_cur - rslen, rs, rslen)
              )
             )
            )
           )
        {
            append = -1;
            goto screamer;
        }
    }

#endif /* STDSTDIO */

    if (rspara) {
        while (i != EOF) {
            i = getc(fp);
            if (i != '\n') {
                ungetc(i,fp);
                break;
            }
        }
    }
    return str->str_cur - append ? str->str_ptr : Nullch;
}

ARG *
parselist(str)
STR *str;
{
    register CMD *cmd;
    register ARG *arg;
    CMD *oldcurcmd = curcmd;
    int oldperldb = perldb;
    int retval;

    perldb = 0;
    str_sset(linestr,str);
    in_eval++;
    oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
    bufend = bufptr + linestr->str_cur;
    if (++loop_ptr >= loop_max) {
        loop_max += 128;
        Renew(loop_stack, loop_max, struct loop);
    }
    loop_stack[loop_ptr].loop_label = "_EVAL_";
    loop_stack[loop_ptr].loop_sp = 0;
#ifdef DEBUGGING
    if (debug & 4) {
        deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
    }
#endif
    if (setjmp(loop_stack[loop_ptr].loop_env)) {
        in_eval--;
        loop_ptr--;
        perldb = oldperldb;
        fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
    }
#ifdef DEBUGGING
    if (debug & 4) {
        char *tmps = loop_stack[loop_ptr].loop_label;
        deb("(Popping label #%d %s)\n",loop_ptr,
            tmps ? tmps : "" );
    }
#endif
    loop_ptr--;
    error_count = 0;
    curcmd = &compiling;
    curcmd->c_line = oldcurcmd->c_line;
    retval = yyparse();
    curcmd = oldcurcmd;
    perldb = oldperldb;
    in_eval--;
    if (retval || error_count)
        fatal("Invalid component in string or format");
    cmd = eval_root;
    arg = cmd->c_expr;
    if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
        fatal("panic: error in parselist %d %x %d", cmd->c_type,
          cmd->c_next, arg ? arg->arg_type : -1);
    cmd->c_expr = Nullarg;
    cmd_free(cmd);
    eval_root = Nullcmd;
    return arg;
}

void
intrpcompile(src)
STR *src;
{
    register char *s = str_get(src);
    register char *send = s + src->str_cur;
    register STR *str;
    register char *t;
    STR *toparse;
    STRLEN len;
    register int brackets;
    register char *d;
    STAB *stab;
    char *checkpoint;
    int sawcase = 0;

    toparse = Str_new(76,0);
    str = Str_new(77,0);

    str_nset(str,"",0);
    str_nset(toparse,"",0);
    t = s;
    while (s < send) {
        if (*s == '\\' && s[1] && index("$@[{\\]}lLuUE",s[1])) {
            str_ncat(str, t, s - t);
            ++s;
            if (isALPHA(*s)) {
                str_ncat(str, "$c", 2);
                sawcase = (*s != 'E');
            }
            else {
                if (*nointrp) {         /* in a regular expression */
                    if (*s == '@')      /* always strip \@ */ /*SUPPRESS 530*/
                        ;
                    else                /* don't strip \\, \[, \{ etc. */
                        str_ncat(str,s-1,1);
                }
                str_ncat(str, "$b", 2);
            }
            str_ncat(str, s, 1);
            ++s;
            t = s;
        }
        else if (*s == '$' && s+1 < send && *nointrp && index(nointrp,s[1])) {
            str_ncat(str, t, s - t);
            str_ncat(str, "$b", 2);
            str_ncat(str, s, 2);
            s += 2;
            t = s;
        }
        else if ((*s == '@' || *s == '$') && s+1 < send) {
            str_ncat(str,t,s-t);
            t = s;
            if (*s == '$' && s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
                s++;
            s = scanident(s,send,tokenbuf);
            if (*t == '@' &&
              (!(stab = stabent(tokenbuf,FALSE)) || 
                 (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) {
                str_ncat(str,"@",1);
                s = ++t;
                continue;       /* grandfather @ from old scripts */
            }
            str_ncat(str,"$a",2);
            str_ncat(toparse,",",1);
            if (t[1] != '{' && (*s == '['  || *s == '{' /* }} */ ) &&
              (stab = stabent(tokenbuf,FALSE)) &&
              ((*s == '[') ? (stab_xarray(stab) != 0) : (stab_xhash(stab) != 0)) ) {
                brackets = 0;
                checkpoint = s;
                do {
                    switch (*s) {
                    case '[':
                        brackets++;
                        break;
                    case '{':
                        brackets++;
                        break;
                    case ']':
                        brackets--;
                        break;
                    case '}':
                        brackets--;
                        break;
                    case '$':
                    case '%':
                    case '@':
                    case '&':
                    case '*':
                        s = scanident(s,send,tokenbuf);
                        continue;
                    case '\'':
                    case '"':
                        /*SUPPRESS 68*/
                        s = cpytill(tokenbuf,s+1,send,*s,&len);
                        if (s >= send)
                            fatal("Unterminated string");
                        break;
                    }
                    s++;
                } while (brackets > 0 && s < send);
                if (s > send)
                    fatal("Unmatched brackets in string");
                if (*nointrp) {         /* we're in a regular expression */
                    d = checkpoint;
                    if (*d == '{' && s[-1] == '}') {    /* maybe {n,m} */
                        ++d;
                        if (isDIGIT(*d)) {      /* matches /^{\d,?\d*}$/ */
                            if (*++d == ',')
                                ++d;
                            while (isDIGIT(*d))
                                d++;
                            if (d == s - 1)
                                s = checkpoint;         /* Is {n,m}! Backoff! */
                        }
                    }
                    else if (*d == '[' && s[-1] == ']') { /* char class? */
                        int weight = 2;         /* let's weigh the evidence */
                        char seen[256];
                        unsigned char un_char = 0, last_un_char;

                        Zero(seen,256,char);
                        *--s = '\0';
                        if (d[1] == '^')
                            weight += 150;
                        else if (d[1] == '$')
                            weight -= 3;
                        if (isDIGIT(d[1])) {
                            if (d[2]) {
                                if (isDIGIT(d[2]) && !d[3])
                                    weight -= 10;
                            }
                            else
                                weight -= 100;
                        }
                        for (d++; d < s; d++) {
                            last_un_char = un_char;
                            un_char = (unsigned char)*d;
                            switch (*d) {
                            case '&':
                            case '$':
                                weight -= seen[un_char] * 10;
                                if (isALNUM(d[1])) {
                                    d = scanident(d,s,tokenbuf);
                                    if (stabent(tokenbuf,FALSE))
                                        weight -= 100;
                                    else
                                        weight -= 10;
                                }
                                else if (*d == '$' && d[1] &&
                                  index("[#!%*<>()-=",d[1])) {
                                    if (!d[2] || /*{*/ index("])} =",d[2]))
                                        weight -= 10;
                                    else
                                        weight -= 1;
                                }
                                break;
                            case '\\':
                                un_char = 254;
                                if (d[1]) {
                                    if (index("wds",d[1]))
                                        weight += 100;
                                    else if (seen['\''] || seen['"'])
                                        weight += 1;
                                    else if (index("rnftb",d[1]))
                                        weight += 40;
                                    else if (isDIGIT(d[1])) {
                                        weight += 40;
                                        while (d[1] && isDIGIT(d[1]))
                                            d++;
                                    }
                                }
                                else
                                    weight += 100;
                                break;
                            case '-':
                                if (last_un_char < (unsigned char) d[1]
                                  || d[1] == '\\') {
                                    if (index("aA01! ",last_un_char))
                                        weight += 30;
                                    if (index("zZ79~",d[1]))
                                        weight += 30;
                                }
                                else
                                    weight -= 1;
                            default:
                                if (isALPHA(*d) && d[1] && isALPHA(d[1])) {
                                    bufptr = d;
                                    if (yylex() != WORD)
                                        weight -= 150;
                                    d = bufptr;
                                }
                                if (un_char == last_un_char + 1)
                                    weight += 5;
                                weight -= seen[un_char];
                                break;
                            }
                            seen[un_char]++;
                        }
#ifdef DEBUGGING
                        if (debug & 512)
                            fprintf(stderr,"[%s] weight %d\n",
                              checkpoint+1,weight);
#endif
                        *s++ = ']';
                        if (weight >= 0)        /* probably a character class */
                            s = checkpoint;
                    }
                }
            }
            if (*t == '@')
                str_ncat(toparse, "join($\",", 8);
            if (t[1] == '{' && s[-1] == '}') {
                str_ncat(toparse, t, 1);
                str_ncat(toparse, t+2, s - t - 3);
            }
            else
                str_ncat(toparse, t, s - t);
            if (*t == '@')
                str_ncat(toparse, ")", 1);
            t = s;
        }
        else
            s++;
    }
    str_ncat(str,t,s-t);
    if (sawcase)
        str_ncat(str, "$cE", 3);
    if (toparse->str_ptr && *toparse->str_ptr == ',') {
        *toparse->str_ptr = '(';
        str_ncat(toparse,",$$);",5);
        str->str_u.str_args = parselist(toparse);
        str->str_u.str_args->arg_len--;         /* ignore $$ reference */
    }
    else
        str->str_u.str_args = Nullarg;
    str_free(toparse);
    str->str_pok |= SP_INTRP;
    str->str_nok = 0;
    str_replace(src,str);
}

STR *
interp(str,src,sp)
register STR *str;
STR *src;
int sp;
{
    register char *s;
    register char *t;
    register char *send;
    register STR **elem;
    int docase = 0;
    int l = 0;
    int u = 0;
    int L = 0;
    int U = 0;

    if (str == &str_undef)
        return Nullstr;
    if (!(src->str_pok & SP_INTRP)) {
        int oldsave = savestack->ary_fill;

        (void)savehptr(&curstash);
        curstash = curcmd->c_stash;     /* so stabent knows right package */
        intrpcompile(src);
        restorelist(oldsave);
    }
    s = src->str_ptr;           /* assumed valid since str_pok set */
    t = s;
    send = s + src->str_cur;

    if (src->str_u.str_args) {
        (void)eval(src->str_u.str_args,G_ARRAY,sp);
        /* Assuming we have correct # of args */
        elem = stack->ary_array + sp;
    }

    str_nset(str,"",0);
    while (s < send) {
        if (*s == '$' && s+1 < send) {
            if (s-t > 0)
                str_ncat(str,t,s-t);
            switch(*++s) {
            default:
                fatal("panic: unknown interp cookie\n");
                break;
            case 'a':
                str_scat(str,*++elem);
                break;
            case 'b':
                str_ncat(str,++s,1);
                break;
            case 'c':
                if (docase && str->str_cur >= docase) {
                    char *b = str->str_ptr + --docase;

                    if (L)
                        lcase(b, str->str_ptr + str->str_cur);
                    else if (U)
                        ucase(b, str->str_ptr + str->str_cur);

                    if (u)      /* note that l & u are independent of L & U */
                        ucase(b, b+1);
                    else if (l)
                        lcase(b, b+1);
                    l = u = 0;
                }
                docase = str->str_cur + 1;
                switch (*++s) {
                case 'u':
                    u = 1;
                    l = 0;
                    break;
                case 'U':
                    U = 1;
                    L = 0;
                    break;
                case 'l':
                    l = 1;
                    u = 0;
                    break;
                case 'L':
                    L = 1;
                    U = 0;
                    break;
                case 'E':
                    docase = L = U = l = u = 0;
                    break;
                }
                break;
            }
            t = ++s;
        }
        else
            s++;
    }
    if (s-t > 0)
        str_ncat(str,t,s-t);
    return str;
}

static void
ucase(s,send)
register char *s;
register char *send;
{
    while (s < send) {
        if (isLOWER(*s))
            *s = toupper(*s);
        s++;
    }
}

static void
lcase(s,send)
register char *s;
register char *send;
{
    while (s < send) {
        if (isUPPER(*s))
            *s = tolower(*s);
        s++;
    }
}

void
str_inc(str)
register STR *str;
{
    register char *d;

    if (!str || str == &str_undef)
        return;
    if (str->str_nok) {
        str->str_u.str_nval += 1.0;
        str->str_pok = 0;
        return;
    }
    if (!str->str_pok || !*str->str_ptr) {
        str->str_u.str_nval = 1.0;
        str->str_nok = 1;
        str->str_pok = 0;
        return;
    }
    d = str->str_ptr;
    while (isALPHA(*d)) d++;
    while (isDIGIT(*d)) d++;
    if (*d) {
        str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
        return;
    }
    d--;
    while (d >= str->str_ptr) {
        if (isDIGIT(*d)) {
            if (++*d <= '9')
                return;
            *(d--) = '0';
        }
        else {
            ++*d;
            if (isALPHA(*d))
                return;
            *(d--) -= 'z' - 'a' + 1;
        }
    }
    /* oh,oh, the number grew */
    STR_GROW(str, str->str_cur + 2);
    str->str_cur++;
    for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
        *d = d[-1];
    if (isDIGIT(d[1]))
        *d = '1';
    else
        *d = d[1];
}

void
str_dec(str)
register STR *str;
{
    if (!str || str == &str_undef)
        return;
    if (str->str_nok) {
        str->str_u.str_nval -= 1.0;
        str->str_pok = 0;
        return;
    }
    if (!str->str_pok) {
        str->str_u.str_nval = -1.0;
        str->str_nok = 1;
        return;
    }
    str_numset(str,atof(str->str_ptr) - 1.0);
}

/* Make a string that will exist for the duration of the expression
 * evaluation.  Actually, it may have to last longer than that, but
 * hopefully cmd_exec won't free it until it has been assigned to a
 * permanent location. */

static long tmps_size = -1;

STR *
str_mortal(oldstr)
STR *oldstr;
{
    register STR *str = Str_new(78,0);

    str_sset(str,oldstr);
    if (++tmps_max > tmps_size) {
        tmps_size = tmps_max;
        if (!(tmps_size & 127)) {
            if (tmps_size)
                Renew(tmps_list, tmps_size + 128, STR*);
            else
                New(702,tmps_list, 128, STR*);
        }
    }
    tmps_list[tmps_max] = str;
    if (str->str_pok)
        str->str_pok |= SP_TEMP;
    return str;
}

/* same thing without the copying */

STR *
str_2mortal(str)
register STR *str;
{
    if (!str || str == &str_undef)
        return str;
    if (++tmps_max > tmps_size) {
        tmps_size = tmps_max;
        if (!(tmps_size & 127)) {
            if (tmps_size)
                Renew(tmps_list, tmps_size + 128, STR*);
            else
                New(704,tmps_list, 128, STR*);
        }
    }
    tmps_list[tmps_max] = str;
    if (str->str_pok)
        str->str_pok |= SP_TEMP;
    return str;
}

STR *
str_make(s,len)
char *s;
STRLEN len;
{
    register STR *str = Str_new(79,0);

    if (!len)
        len = strlen(s);
    str_nset(str,s,len);
    return str;
}

STR *
str_nmake(n)
double n;
{
    register STR *str = Str_new(80,0);

    str_numset(str,n);
    return str;
}

/* make an exact duplicate of old */

STR *
str_smake(old)
register STR *old;
{
    register STR *new = Str_new(81,0);

    if (!old)
        return Nullstr;
    if (old->str_state == SS_FREE) {
        warn("semi-panic: attempt to dup freed string");
        return Nullstr;
    }
    if (old->str_state == SS_INCR && !(old->str_pok & 2))
        Str_Grow(old,0);
    if (new->str_ptr)
        Safefree(new->str_ptr);
    StructCopy(old,new,STR);
    if (old->str_ptr) {
        new->str_ptr = nsavestr(old->str_ptr,old->str_len);
        new->str_pok &= ~SP_TEMP;
    }
    return new;
}

void
str_reset(s,stash)
register char *s;
HASH *stash;
{
    register HENT *entry;
    register STAB *stab;
    register STR *str;
    register int i;
    register SPAT *spat;
    register int max;

    if (!*s) {          /* reset ?? searches */
        for (spat = stash->tbl_spatroot;
          spat != Nullspat;
          spat = spat->spat_next) {
            spat->spat_flags &= ~SPAT_USED;
        }
        return;
    }

    /* reset variables */

    if (!stash->tbl_array)
        return;
    while (*s) {
        i = *s;
        if (s[1] == '-') {
            s += 2;
        }
        max = *s++;
        for ( ; i <= max; i++) {
            for (entry = stash->tbl_array[i];
              entry;
              entry = entry->hent_next) {
                stab = (STAB*)entry->hent_val;
                str = stab_val(stab);
                str->str_cur = 0;
                str->str_nok = 0;
#ifdef TAINT
                str->str_tainted = tainted;
#endif
                if (str->str_ptr != Nullch)
                    str->str_ptr[0] = '\0';
                if (stab_xarray(stab)) {
                    aclear(stab_xarray(stab));
                }
                if (stab_xhash(stab)) {
                    hclear(stab_xhash(stab), FALSE);
                    if (stab == envstab)
                        environ[0] = Nullch;
                }
            }
        }
    }
}

#ifdef TAINT
void
taintproper(s)
char *s;
{
#ifdef DEBUGGING
    if (debug & 2048)
        fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
#endif
    if (tainted && (!euid || euid != uid || egid != gid || taintanyway)) {
        if (!unsafe)
            fatal("%s", s);
        else if (dowarn)
            warn("%s", s);
    }
}

void
taintenv()
{
    register STR *envstr;

    envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
    if (envstr == &str_undef || envstr->str_tainted) {
        tainted = 1;
        if (envstr->str_tainted == 2)
            taintproper("Insecure directory in PATH");
        else
            taintproper("Insecure PATH");
    }
    envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
    if (envstr != &str_undef && envstr->str_tainted) {
        tainted = 1;
        taintproper("Insecure IFS");
    }
}
#endif /* TAINT */