Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/unix/volume20/perl3.0/part13

Internet Message Format | 1989-11-03 | 49.5 KB

Path: bbn.com!rsalz
From: [e-mail] (Rich Salz)
Newsgroups: comp.sources.unix
Subject: v20i096:  Perl, a language with features of C/sed/awk/shell/etc, Part13/24
Message-ID: <[e-mail]>
Date: 31 Oct 89 20:13:20 GMT
Lines: 2173
Approved: [e-mail]

Submitted-by: Larry Wall <[e-mail]>
Posting-number: Volume 20, Issue 96
Archive-name: perl3.0/part13

#! /bin/sh

# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 24 through sh.  When all 24 kits have been run, read README.

echo "This is perl 3.0 kit 13 (of 24).  If kit 13 is complete, the line"
echo '"'"End of kit 13 (of 24)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir t 2>/dev/null
echo Extracting str.c
sed >str.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: str.c,v 3.0 89/10/18 15:23:38 lwall Locked $
X *
X *    Copyright (c) 1989, Larry Wall
X *
X *    You may distribute under the terms of the GNU General Public License
X *    as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log:    str.c,v $
X * Revision 3.0  89/10/18  15:23:38  lwall
X * 3.0 baseline
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X#include "perly.h"
X
Xextern char **environ;
X
X#ifndef str_get
Xchar *
Xstr_get(str)
XSTR *str;
X{
X#ifdef TAINT
X    tainted |= str->str_tainted;
X#endif
X    return str->str_pok ? str->str_ptr : str_2ptr(str);
X}
X#endif
X
X/* dlb ... guess we have a "crippled cc".
X * dlb the following functions are usually macros.
X */
X#ifndef str_true
Xstr_true(Str)
XSTR *Str;
X{
X    if (Str->str_pok) {
X        if (*Str->str_ptr > '0' ||
X          Str->str_cur > 1 ||
X          (Str->str_cur && *Str->str_ptr != '0'))
X        return 1;
X        return 0;
X    }
X    if (Str->str_nok)
X        return (Str->str_u.str_nval != 0.0);
X    return 0;
X}
X#endif /* str_true */
X
X#ifndef str_gnum
Xdouble str_gnum(Str)
XSTR *Str;
X{
X#ifdef TAINT
X    tainted |= Str->str_tainted;
X#endif /* TAINT*/
X    if (Str->str_nok)
X        return Str->str_u.str_nval;
X    return str_2num(Str);
X}
X#endif /* str_gnum */
X/* dlb ... end of crutch */
X
Xchar *
Xstr_grow(str,newlen)
Xregister STR *str;
Xregister int newlen;
X{
X    register char *s = str->str_ptr;
X
X    if (str->str_state == SS_INCR) {        /* data before str_ptr? */
X    str->str_len += str->str_u.str_useful;
X    str->str_ptr -= str->str_u.str_useful;
X    str->str_u.str_useful = 0L;
X    bcopy(s, str->str_ptr, str->str_cur+1);
X    s = str->str_ptr;
X    str->str_state = SS_NORM;            /* normal again */
X    if (newlen > str->str_len)
X        newlen += 10 * (newlen - str->str_cur); /* avoid copy each time */
X    }
X    if (newlen > str->str_len) {        /* need more room? */
X        if (str->str_len)
X        Renew(s,newlen,char);
X        else
X        New(703,s,newlen,char);
X    str->str_ptr = s;
X        str->str_len = newlen;
X    }
X    return s;
X}
X
Xstr_numset(str,num)
Xregister STR *str;
Xdouble num;
X{
X    str->str_u.str_nval = num;
X    str->str_state = SS_NORM;
X    str->str_pok = 0;    /* invalidate pointer */
X    str->str_nok = 1;            /* validate number */
X#ifdef TAINT
X    str->str_tainted = tainted;
X#endif
X}
X
Xextern int errno;
X
Xchar *
Xstr_2ptr(str)
Xregister STR *str;
X{
X    register char *s;
X    int olderrno;
X
X    if (!str)
X    return "";
X    if (str->str_nok) {
X    STR_GROW(str, 24);
X    s = str->str_ptr;
X    olderrno = errno;    /* some Xenix systems wipe out errno here */
X#if defined(scs) && defined(ns32000)
X    gcvt(str->str_u.str_nval,20,s);
X#else
X#ifdef apollo
X    if (str->str_u.str_nval == 0.0)
X        (void)strcpy(s,"0");
X    else
X#endif /*apollo*/
X    (void)sprintf(s,"%.20g",str->str_u.str_nval);
X#endif /*scs*/
X    errno = olderrno;
X    while (*s) s++;
X    }
X    else {
X    if (str == &str_undef)
X        return No;
X    if (dowarn)
X        warn("Use of uninitialized variable");
X    STR_GROW(str, 24);
X    s = str->str_ptr;
X    }
X    *s = '\0';
X    str->str_cur = s - str->str_ptr;
X    str->str_pok = 1;
X#ifdef DEBUGGING
X    if (debug & 32)
X    fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr);
X#endif
X    return str->str_ptr;
X}
X
Xdouble
Xstr_2num(str)
Xregister STR *str;
X{
X    if (!str)
X    return 0.0;
X    str->str_state = SS_NORM;
X    if (str->str_len && str->str_pok)
X    str->str_u.str_nval = atof(str->str_ptr);
X    else  {
X    if (str == &str_undef)
X        return 0.0;
X    if (dowarn)
X        warn("Use of uninitialized variable");
X    str->str_u.str_nval = 0.0;
X    }
X    str->str_nok = 1;
X#ifdef DEBUGGING
X    if (debug & 32)
X    fprintf(stderr,"0x%lx num(%g)\n",str,str->str_u.str_nval);
X#endif
X    return str->str_u.str_nval;
X}
X
Xstr_sset(dstr,sstr)
XSTR *dstr;
Xregister STR *sstr;
X{
X#ifdef TAINT
X    tainted |= sstr->str_tainted;
X#endif
X    if (!sstr)
X    dstr->str_pok = dstr->str_nok = 0;
X    else if (sstr->str_pok) {
X    str_nset(dstr,sstr->str_ptr,sstr->str_cur);
X    if (sstr->str_nok) {
X        dstr->str_u.str_nval = sstr->str_u.str_nval;
X        dstr->str_nok = 1;
X        dstr->str_state = SS_NORM;
X    }
X    else if (sstr->str_cur == sizeof(STBP)) {
X        char *tmps = sstr->str_ptr;
X
X        if (*tmps == 'S' && bcmp(tmps,"Stab",4) == 0) {
X        dstr->str_magic = str_smake(sstr->str_magic);
X        dstr->str_magic->str_rare = 'X';
X        }
X    }
X    }
X    else if (sstr->str_nok)
X    str_numset(dstr,sstr->str_u.str_nval);
X    else
X    dstr->str_pok = dstr->str_nok = 0;
X}
X
Xstr_nset(str,ptr,len)
Xregister STR *str;
Xregister char *ptr;
Xregister int len;
X{
X    STR_GROW(str, len + 1);
X    (void)bcopy(ptr,str->str_ptr,len);
X    str->str_cur = len;
X    *(str->str_ptr+str->str_cur) = '\0';
X    str->str_nok = 0;        /* invalidate number */
X    str->str_pok = 1;        /* validate pointer */
X#ifdef TAINT
X    str->str_tainted = tainted;
X#endif
X}
X
Xstr_set(str,ptr)
Xregister STR *str;
Xregister char *ptr;
X{
X    register int len;
X
X    if (!ptr)
X    ptr = "";
X    len = strlen(ptr);
X    STR_GROW(str, len + 1);
X    (void)bcopy(ptr,str->str_ptr,len+1);
X    str->str_cur = len;
X    str->str_nok = 0;        /* invalidate number */
X    str->str_pok = 1;        /* validate pointer */
X#ifdef TAINT
X    str->str_tainted = tainted;
X#endif
X}
X
Xstr_chop(str,ptr)    /* like set but assuming ptr is in str */
Xregister STR *str;
Xregister char *ptr;
X{
X    register int delta;
X
X    if (!(str->str_pok))
X    fatal("str_chop: internal inconsistency");
X    delta = ptr - str->str_ptr;
X    str->str_len -= delta;
X    str->str_cur -= delta;
X    str->str_ptr += delta;
X    if (str->str_state == SS_INCR)
X    str->str_u.str_useful += delta;
X    else {
X    str->str_u.str_useful = delta;
X    str->str_state = SS_INCR;
X    }
X    str->str_nok = 0;        /* invalidate number */
X    str->str_pok = 1;        /* validate pointer (and unstudy str) */
X}
X
Xstr_ncat(str,ptr,len)
Xregister STR *str;
Xregister char *ptr;
Xregister int len;
X{
X    if (!(str->str_pok))
X    (void)str_2ptr(str);
X    STR_GROW(str, str->str_cur + len + 1);
X    (void)bcopy(ptr,str->str_ptr+str->str_cur,len);
X    str->str_cur += len;
X    *(str->str_ptr+str->str_cur) = '\0';
X    str->str_nok = 0;        /* invalidate number */
X    str->str_pok = 1;        /* validate pointer */
X#ifdef TAINT
X    str->str_tainted |= tainted;
X#endif
X}
X
Xstr_scat(dstr,sstr)
XSTR *dstr;
Xregister STR *sstr;
X{
X#ifdef TAINT
X    tainted |= sstr->str_tainted;
X#endif
X    if (!sstr)
X    return;
X    if (!(sstr->str_pok))
X    (void)str_2ptr(sstr);
X    if (sstr)
X    str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
X}
X
Xstr_cat(str,ptr)
Xregister STR *str;
Xregister char *ptr;
X{
X    register int len;
X
X    if (!ptr)
X    return;
X    if (!(str->str_pok))
X    (void)str_2ptr(str);
X    len = strlen(ptr);
X    STR_GROW(str, str->str_cur + len + 1);
X    (void)bcopy(ptr,str->str_ptr+str->str_cur,len+1);
X    str->str_cur += len;
X    str->str_nok = 0;        /* invalidate number */
X    str->str_pok = 1;        /* validate pointer */
X#ifdef TAINT
X    str->str_tainted |= tainted;
X#endif
X}
X
Xchar *
Xstr_append_till(str,from,fromend,delim,keeplist)
Xregister STR *str;
Xregister char *from;
Xregister char *fromend;
Xregister int delim;
Xchar *keeplist;
X{
X    register char *to;
X    register int len;
X
X    if (!from)
X    return Nullch;
X    len = fromend - from;
X    STR_GROW(str, str->str_cur + len + 1);
X    str->str_nok = 0;        /* invalidate number */
X    str->str_pok = 1;        /* validate pointer */
X    to = str->str_ptr+str->str_cur;
X    for (; from < fromend; from++,to++) {
X    if (*from == '\\' && from+1 < fromend && delim != '\\') {
X        if (!keeplist) {
X        if (from[1] == delim || from[1] == '\\')
X            from++;
X        else
X            *to++ = *from++;
X        }
X        else if (from[1] && index(keeplist,from[1]))
X        *to++ = *from++;
X        else
X        from++;
X    }
X    else if (*from == delim)
X        break;
X    *to = *from;
X    }
X    *to = '\0';
X    str->str_cur = to - str->str_ptr;
X    return from;
X}
X
XSTR *
X#ifdef LEAKTEST
Xstr_new(x,len)
Xint x;
X#else
Xstr_new(len)
X#endif
Xint len;
X{
X    register STR *str;
X
X    if (freestrroot) {
X    str = freestrroot;
X    freestrroot = str->str_magic;
X    str->str_magic = Nullstr;
X    str->str_state = SS_NORM;
X    }
X    else {
X    Newz(700+x,str,1,STR);
X    }
X    if (len)
X    STR_GROW(str, len + 1);
X    return str;
X}
X
Xvoid
Xstr_magic(str, stab, how, name, namlen)
Xregister STR *str;
XSTAB *stab;
Xint how;
Xchar *name;
Xint namlen;
X{
X    if (str->str_magic)
X    return;
X    str->str_magic = Str_new(75,namlen);
X    str = str->str_magic;
X    str->str_u.str_stab = stab;
X    str->str_rare = how;
X    if (name)
X    str_nset(str,name,namlen);
X}
X
Xvoid
Xstr_insert(bigstr,offset,len,little,littlelen)
XSTR *bigstr;
Xint offset;
Xint len;
Xchar *little;
Xint littlelen;
X{
X    register char *big;
X    register char *mid;
X    register char *midend;
X    register char *bigend;
X    register int i;
X
X    i = littlelen - len;
X    if (i > 0) {            /* string might grow */
X    STR_GROW(bigstr, bigstr->str_cur + i + 1);
X    big = bigstr->str_ptr;
X    mid = big + offset + len;
X    midend = bigend = big + bigstr->str_cur;
X    bigend += i;
X    *bigend = '\0';
X    while (midend > mid)        /* shove everything down */
X        *--bigend = *--midend;
X    (void)bcopy(little,big+offset,littlelen);
X    bigstr->str_cur += i;
X    return;
X    }
X    else if (i == 0) {
X    (void)bcopy(little,bigstr->str_ptr+offset,len);
X    return;
X    }
X
X    big = bigstr->str_ptr;
X    mid = big + offset;
X    midend = mid + len;
X    bigend = big + bigstr->str_cur;
X
X    if (midend > bigend)
X    fatal("panic: str_insert");
X
X    bigstr->str_pok = SP_VALID;    /* disable possible screamer */
X
X    if (mid - big > bigend - midend) {    /* faster to shorten from end */
X    if (littlelen) {
X        (void)bcopy(little, mid, littlelen);
X        mid += littlelen;
X    }
X    i = bigend - midend;
X    if (i > 0) {
X        (void)bcopy(midend, mid, i);
X        mid += i;
X    }
X    *mid = '\0';
X    bigstr->str_cur = mid - big;
X    }
X    else if (i = mid - big) {    /* faster from front */
X    midend -= littlelen;
X    mid = midend;
X    str_chop(bigstr,midend-i);
X    big += i;
X    while (i--)
X        *--midend = *--big;
X    if (littlelen)
X        (void)bcopy(little, mid, littlelen);
X    }
X    else if (littlelen) {
X    midend -= littlelen;
X    str_chop(bigstr,midend);
X    (void)bcopy(little,midend,littlelen);
X    }
X    else {
X    str_chop(bigstr,midend);
X    }
X    STABSET(bigstr);
X}
X
X/* make str point to what nstr did */
X
Xvoid
Xstr_replace(str,nstr)
Xregister STR *str;
Xregister STR *nstr;
X{
X    if (str->str_state == SS_INCR)
X    str_grow(str,0);    /* just force copy down */
X    if (nstr->str_state == SS_INCR)
X    str_grow(nstr,0);
X    if (str->str_ptr)
X    Safefree(str->str_ptr);
X    str->str_ptr = nstr->str_ptr;
X    str->str_len = nstr->str_len;
X    str->str_cur = nstr->str_cur;
X    str->str_pok = nstr->str_pok;
X    str->str_nok = nstr->str_nok;
X#ifdef STRUCTCOPY
X    str->str_u = nstr->str_u;
X#else
X    str->str_u.str_nval = nstr->str_u.str_nval;
X#endif
X#ifdef TAINT
X    str->str_tainted = nstr->str_tainted;
X#endif
X    Safefree(nstr);
X}
X
Xvoid
Xstr_free(str)
Xregister STR *str;
X{
X    if (!str)
X    return;
X    if (str->str_state) {
X    if (str->str_state == SS_FREE)    /* already freed */
X        return;
X    if (str->str_state == SS_INCR && !(str->str_pok & 2)) {
X        str->str_ptr -= str->str_u.str_useful;
X        str->str_len += str->str_u.str_useful;
X    }
X    }
X    if (str->str_magic)
X    str_free(str->str_magic);
X#ifdef LEAKTEST
X    if (str->str_len)
X    Safefree(str->str_ptr);
X    if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
X    arg_free(str->str_u.str_args);
X    Safefree(str);
X#else /* LEAKTEST */
X    if (str->str_len) {
X    if (str->str_len > 127) {    /* next user not likely to want more */
X        Safefree(str->str_ptr);    /* so give it back to malloc */
X        str->str_ptr = Nullch;
X        str->str_len = 0;
X    }
X    else
X        str->str_ptr[0] = '\0';
X    }
X    if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
X    arg_free(str->str_u.str_args);
X    str->str_cur = 0;
X    str->str_nok = 0;
X    str->str_pok = 0;
X    str->str_state = SS_FREE;
X#ifdef TAINT
X    str->str_tainted = 0;
X#endif
X    str->str_magic = freestrroot;
X    freestrroot = str;
X#endif /* LEAKTEST */
X}
X
Xstr_len(str)
Xregister STR *str;
X{
X    if (!str)
X    return 0;
X    if (!(str->str_pok))
X    (void)str_2ptr(str);
X    if (str->str_ptr)
X    return str->str_cur;
X    else
X    return 0;
X}
X
Xstr_eq(str1,str2)
Xregister STR *str1;
Xregister STR *str2;
X{
X    if (!str1)
X    return str2 == Nullstr;
X    if (!str2)
X    return 0;
X
X    if (!str1->str_pok)
X    (void)str_2ptr(str1);
X    if (!str2->str_pok)
X    (void)str_2ptr(str2);
X
X    if (str1->str_cur != str2->str_cur)
X    return 0;
X
X    return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur);
X}
X
Xstr_cmp(str1,str2)
Xregister STR *str1;
Xregister STR *str2;
X{
X    int retval;
X
X    if (!str1)
X    return str2 == Nullstr;
X    if (!str2)
X    return 0;
X
X    if (!str1->str_pok)
X    (void)str_2ptr(str1);
X    if (!str2->str_pok)
X    (void)str_2ptr(str2);
X
X    if (str1->str_cur < str2->str_cur) {
X    if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
X        return retval;
X    else
X        return 1;
X    }
X    else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
X    return retval;
X    else if (str1->str_cur == str2->str_cur)
X    return 0;
X    else
X    return -1;
X}
X
Xchar *
Xstr_gets(str,fp,append)
Xregister STR *str;
Xregister FILE *fp;
Xint append;
X{
X#ifdef STDSTDIO        /* Here is some breathtakingly efficient cheating */
X
X    register char *bp;        /* we're going to steal some values */
X    register int cnt;        /*  from the stdio struct and put EVERYTHING */
X    register STDCHAR *ptr;    /*   in the innermost loop into registers */
X    register char newline = record_separator;/* (assuming >= 6 registers) */
X    int i;
X    int bpx;
X    int obpx;
X    register int get_paragraph;
X    register char *oldbp;
X
X    if (get_paragraph = !rslen) {    /* yes, that's an assignment */
X    newline = '\n';
X    oldbp = Nullch;            /* remember last \n position (none) */
X    }
X    cnt = fp->_cnt;            /* get count into register */
X    str->str_nok = 0;            /* invalidate number */
X    str->str_pok = 1;            /* validate pointer */
X    if (str->str_len <= cnt + 1)    /* make sure we have the room */
X    STR_GROW(str, append+cnt+2);    /* (remembering cnt can be -1) */
X    bp = str->str_ptr + append;        /* move these two too to registers */
X    ptr = fp->_ptr;
X    for (;;) {
X      screamer:
X    while (--cnt >= 0) {            /* this */    /* eat */
X        if ((*bp++ = *ptr++) == newline)    /* really */    /* dust */
X        goto thats_all_folks;        /* screams */    /* sed :-) */
X    }
X
X    fp->_cnt = cnt;            /* deregisterize cnt and ptr */
X    fp->_ptr = ptr;
X    i = _filbuf(fp);        /* get more characters */
X    cnt = fp->_cnt;
X    ptr = fp->_ptr;            /* reregisterize cnt and ptr */
X
X    bpx = bp - str->str_ptr;    /* prepare for possible relocation */
X    if (get_paragraph && oldbp)
X        obpx = oldbp - str->str_ptr;
X    STR_GROW(str, bpx + cnt + 2);
X    bp = str->str_ptr + bpx;    /* reconstitute our pointer */
X    if (get_paragraph && oldbp)
X        oldbp = str->str_ptr + obpx;
X
X    if (i == newline) {        /* all done for now? */
X        *bp++ = i;
X        goto thats_all_folks;
X    }
X    else if (i == EOF)        /* all done for ever? */
X        goto thats_really_all_folks;
X    *bp++ = i;            /* now go back to screaming loop */
X    }
X
Xthats_all_folks:
X    if (get_paragraph && bp - 1 != oldbp) {
X    oldbp = bp;    /* remember where this newline was */
X    goto screamer;    /* and go back to the fray */
X    }
Xthats_really_all_folks:
X    fp->_cnt = cnt;            /* put these back or we're in trouble */
X    fp->_ptr = ptr;
X    *bp = '\0';
X    str->str_cur = bp - str->str_ptr;    /* set length */
X
X#else /* !STDSTDIO */    /* The big, slow, and stupid way */
X
X    static char buf[8192];
X
X    if (fgets(buf, sizeof buf, fp) != Nullch) {
X    if (append)
X        str_cat(str, buf);
X    else
X        str_set(str, buf);
X    }
X    else
X    str_set(str, No);
X
X#endif /* STDSTDIO */
X
X    return str->str_cur - append ? str->str_ptr : Nullch;
X}
X
XARG *
Xparselist(str)
XSTR *str;
X{
X    register CMD *cmd;
X    register ARG *arg;
X    line_t oldline = line;
X    int retval;
X
X    str_sset(linestr,str);
X    in_eval++;
X    oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
X    bufend = bufptr + linestr->str_cur;
X    if (setjmp(eval_env)) {
X    in_eval = 0;
X    fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
X    }
X    error_count = 0;
X    retval = yyparse();
X    in_eval--;
X    if (retval || error_count)
X    fatal("Invalid component in string or format");
X    cmd = eval_root;
X    arg = cmd->c_expr;
X    if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
X    fatal("panic: error in parselist %d %x %d", cmd->c_type,
X      cmd->c_next, arg ? arg->arg_type : -1);
X    line = oldline;
X    Safefree(cmd);
X    return arg;
X}
X
Xvoid
Xintrpcompile(src)
XSTR *src;
X{
X    register char *s = str_get(src);
X    register char *send = s + src->str_cur;
X    register STR *str;
X    register char *t;
X    STR *toparse;
X    int len;
X    register int brackets;
X    register char *d;
X    STAB *stab;
X    char *checkpoint;
X
X    toparse = Str_new(76,0);
X    str = Str_new(77,0);
X
X    str_nset(str,"",0);
X    str_nset(toparse,"",0);
X    t = s;
X    while (s < send) {
X    if (*s == '\\' && s[1] && index("$@[{\\]}",s[1])) {
X        str_ncat(str, t, s - t);
X        ++s;
X        if (*nointrp && s+1 < send)
X        if (*s != '@' && (*s != '$' || index(nointrp,s[1])))
X            str_ncat(str,s-1,1);
X        str_ncat(str, "$b", 2);
X        str_ncat(str, s, 1);
X        ++s;
X        t = s;
X    }
X    else if ((*s == '@' || (*s == '$' && !index(nointrp,s[1]))) &&
X      s+1 < send) {
X        str_ncat(str,t,s-t);
X        t = s;
X        if (*s == '$' && s[1] == '#' && isalpha(s[2]) || s[2] == '_')
X        s++;
X        s = scanreg(s,send,tokenbuf);
X        if (*t == '@' &&
X          (!(stab = stabent(tokenbuf,FALSE)) || !stab_xarray(stab)) ) {
X        str_ncat(str,"@",1);
X        s = ++t;
X        continue;    /* grandfather @ from old scripts */
X        }
X        str_ncat(str,"$a",2);
X        str_ncat(toparse,",",1);
X        if (t[1] != '{' && (*s == '['  || *s == '{' /* }} */ ) &&
X          (stab = stabent(tokenbuf,FALSE)) &&
X          ((*s == '[') ? (stab_xarray(stab) != 0) : (stab_xhash(stab) != 0)) ) {
X        brackets = 0;
X        checkpoint = s;
X        do {
X            switch (*s) {
X            case '[': case '{':
X            brackets++;
X            break;
X            case ']': case '}':
X            brackets--;
X            break;
X            case '\'':
X            case '"':
X            if (s[-1] != '$') {
X                s = cpytill(tokenbuf,s+1,send,*s,&len);
X                if (s >= send)
X                fatal("Unterminated string");
X            }
X            break;
X            }
X            s++;
X        } while (brackets > 0 && s < send);
X        if (s > send)
X            fatal("Unmatched brackets in string");
X        if (*nointrp) {        /* we're in a regular expression */
X            d = checkpoint;
X            if (*d == '{' && s[-1] == '}') {    /* maybe {n,m} */
X            ++d;
X            if (isdigit(*d)) {    /* matches /^{\d,?\d*}$/ */
X                if (*++d == ',')
X                ++d;
X                while (isdigit(*d))
X                d++;
X                if (d == s - 1)
X                s = checkpoint;        /* Is {n,m}! Backoff! */
X            }
X            }
X            else if (*d == '[' && s[-1] == ']') { /* char class? */
X            int weight = 2;        /* let's weigh the evidence */
X            char seen[256];
X            unsigned char uchar = 0, lastuchar;
X
X            Zero(seen,256,char);
X            *--s = '\0';
X            if (d[1] == '^')
X                weight += 150;
X            else if (d[1] == '$')
X                weight -= 3;
X            if (isdigit(d[1])) {
X                if (d[2]) {
X                if (isdigit(d[2]) && !d[3])
X                    weight -= 10;
X                }
X                else
X                weight -= 100;
X            }
X            for (d++; d < s; d++) {
X                lastuchar = uchar;
X                uchar = (unsigned char)*d;
X                switch (*d) {
X                case '&':
X                case '$':
X                weight -= seen[uchar] * 10;
X                if (isalpha(d[1]) || isdigit(d[1]) ||
X                  d[1] == '_') {
X                    d = scanreg(d,s,tokenbuf);
X                    if (stabent(tokenbuf,FALSE))
X                    weight -= 100;
X                    else
X                    weight -= 10;
X                }
X                else if (*d == '$' && d[1] &&
X                  index("[#!%*<>()-=",d[1])) {
X                    if (!d[2] || /*{*/ index("])} =",d[2]))
X                    weight -= 10;
X                    else
X                    weight -= 1;
X                }
X                break;
X                case '\\':
X                uchar = 254;
X                if (d[1]) {
X                    if (index("wds",d[1]))
X                    weight += 100;
X                    else if (seen['\''] || seen['"'])
X                    weight += 1;
X                    else if (index("rnftb",d[1]))
X                    weight += 40;
X                    else if (isdigit(d[1])) {
X                    weight += 40;
X                    while (d[1] && isdigit(d[1]))
X                        d++;
X                    }
X                }
X                else
X                    weight += 100;
X                break;
X                case '-':
X                if (lastuchar < d[1] || d[1] == '\\') {
X                    if (index("aA01! ",lastuchar))
X                    weight += 30;
X                    if (index("zZ79~",d[1]))
X                    weight += 30;
X                }
X                else
X                    weight -= 1;
X                default:
X                if (isalpha(*d) && d[1] && isalpha(d[1])) {
X                    bufptr = d;
X                    if (yylex() != WORD)
X                    weight -= 150;
X                    d = bufptr;
X                }
X                if (uchar == lastuchar + 1)
X                    weight += 5;
X                weight -= seen[uchar];
X                break;
X                }
X                seen[uchar]++;
X            }
X#ifdef DEBUGGING
X            if (debug & 512)
X                fprintf(stderr,"[%s] weight %d\n",
X                  checkpoint+1,weight);
X#endif
X            *s++ = ']';
X            if (weight >= 0)    /* probably a character class */
X                s = checkpoint;
X            }
X        }
X        }
X        if (*t == '@')
X        str_ncat(toparse, "join($\",", 8);
X        if (t[1] == '{' && s[-1] == '}') {
X        str_ncat(toparse, t, 1);
X        str_ncat(toparse, t+2, s - t - 3);
X        }
X        else
X        str_ncat(toparse, t, s - t);
X        if (*t == '@')
X        str_ncat(toparse, ")", 1);
X        t = s;
X    }
X    else
X        s++;
X    }
X    str_ncat(str,t,s-t);
X    if (toparse->str_ptr && *toparse->str_ptr == ',') {
X    *toparse->str_ptr = '(';
X    str_ncat(toparse,",$$);",5);
X    str->str_u.str_args = parselist(toparse);
X    str->str_u.str_args->arg_len--;        /* ignore $$ reference */
X    }
X    else
X    str->str_u.str_args = Nullarg;
X    str_free(toparse);
X    str->str_pok |= SP_INTRP;
X    str->str_nok = 0;
X    str_replace(src,str);
X}
X
XSTR *
Xinterp(str,src,sp)
Xregister STR *str;
XSTR *src;
Xint sp;
X{
X    register char *s;
X    register char *t;
X    register char *send;
X    register STR **elem;
X
X    if (!(src->str_pok & SP_INTRP)) {
X    int oldsave = savestack->ary_fill;
X
X    (void)savehptr(&curstash);
X    curstash = src->str_u.str_hash;    /* so stabent knows right package */
X    intrpcompile(src);
X    restorelist(oldsave);
X    }
X    s = src->str_ptr;        /* assumed valid since str_pok set */
X    t = s;
X    send = s + src->str_cur;
X
X    if (src->str_u.str_args) {
X    (void)eval(src->str_u.str_args,G_ARRAY,sp);
X    /* Assuming we have correct # of args */
X    elem = stack->ary_array + sp;
X    }
X
X    str_nset(str,"",0);
X    while (s < send) {
X    if (*s == '$' && s+1 < send) {
X        str_ncat(str,t,s-t);
X        switch(*++s) {
X        case 'a':
X        str_scat(str,*++elem);
X        break;
X        case 'b':
X        str_ncat(str,++s,1);
X        break;
X        }
X        t = ++s;
X    }
X    else
X        s++;
X    }
X    str_ncat(str,t,s-t);
X    return str;
X}
X
Xvoid
Xstr_inc(str)
Xregister STR *str;
X{
X    register char *d;
X
X    if (!str)
X    return;
X    if (str->str_nok) {
X    str->str_u.str_nval += 1.0;
X    str->str_pok = 0;
X    return;
X    }
X    if (!str->str_pok || !*str->str_ptr) {
X    str->str_u.str_nval = 1.0;
X    str->str_nok = 1;
X    str->str_pok = 0;
X    return;
X    }
X    d = str->str_ptr;
X    while (isalpha(*d)) d++;
X    while (isdigit(*d)) d++;
X    if (*d) {
X        str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
X    return;
X    }
X    d--;
X    while (d >= str->str_ptr) {
X    if (isdigit(*d)) {
X        if (++*d <= '9')
X        return;
X        *(d--) = '0';
X    }
X    else {
X        ++*d;
X        if (isalpha(*d))
X        return;
X        *(d--) -= 'z' - 'a' + 1;
X    }
X    }
X    /* oh,oh, the number grew */
X    STR_GROW(str, str->str_cur + 2);
X    str->str_cur++;
X    for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
X    *d = d[-1];
X    if (isdigit(d[1]))
X    *d = '1';
X    else
X    *d = d[1];
X}
X
Xvoid
Xstr_dec(str)
Xregister STR *str;
X{
X    if (!str)
X    return;
X    if (str->str_nok) {
X    str->str_u.str_nval -= 1.0;
X    str->str_pok = 0;
X    return;
X    }
X    if (!str->str_pok) {
X    str->str_u.str_nval = -1.0;
X    str->str_nok = 1;
X    return;
X    }
X    str_numset(str,atof(str->str_ptr) - 1.0);
X}
X
X/* Make a string that will exist for the duration of the expression
X * evaluation.  Actually, it may have to last longer than that, but
X * hopefully cmd_exec won't free it until it has been assigned to a
X * permanent location. */
X
Xstatic long tmps_size = -1;
X
XSTR *
Xstr_static(oldstr)
XSTR *oldstr;
X{
X    register STR *str = Str_new(78,0);
X
X    str_sset(str,oldstr);
X    if (++tmps_max > tmps_size) {
X    tmps_size = tmps_max;
X    if (!(tmps_size & 127)) {
X        if (tmps_size)
X        Renew(tmps_list, tmps_size + 128, STR*);
X        else
X        New(702,tmps_list, 128, STR*);
X    }
X    }
X    tmps_list[tmps_max] = str;
X    return str;
X}
X
X/* same thing without the copying */
X
XSTR *
Xstr_2static(str)
Xregister STR *str;
X{
X    if (++tmps_max > tmps_size) {
X    tmps_size = tmps_max;
X    if (!(tmps_size & 127)) {
X        if (tmps_size)
X        Renew(tmps_list, tmps_size + 128, STR*);
X        else
X        New(704,tmps_list, 128, STR*);
X    }
X    }
X    tmps_list[tmps_max] = str;
X    return str;
X}
X
XSTR *
Xstr_make(s,len)
Xchar *s;
Xint len;
X{
X    register STR *str = Str_new(79,0);
X
X    if (!len)
X    len = strlen(s);
X    str_nset(str,s,len);
X    return str;
X}
X
XSTR *
Xstr_nmake(n)
Xdouble n;
X{
X    register STR *str = Str_new(80,0);
X
X    str_numset(str,n);
X    return str;
X}
X
X/* make an exact duplicate of old */
X
XSTR *
Xstr_smake(old)
Xregister STR *old;
X{
X    register STR *new = Str_new(81,0);
X
X    if (!old)
X    return Nullstr;
X    if (old->str_state == SS_FREE) {
X    warn("semi-panic: attempt to dup freed string");
X    return Nullstr;
X    }
X    if (old->str_state == SS_INCR && !(old->str_pok & 2))
X    str_grow(old,0);
X    if (new->str_ptr)
X    Safefree(new->str_ptr);
X    Copy(old,new,1,STR);
X    if (old->str_ptr)
X    new->str_ptr = nsavestr(old->str_ptr,old->str_len);
X    return new;
X}
X
Xstr_reset(s,stash)
Xregister char *s;
XHASH *stash;
X{
X    register HENT *entry;
X    register STAB *stab;
X    register STR *str;
X    register int i;
X    register SPAT *spat;
X    register int max;
X
X    if (!*s) {        /* reset ?? searches */
X    for (spat = stash->tbl_spatroot;
X      spat != Nullspat;
X      spat = spat->spat_next) {
X        spat->spat_flags &= ~SPAT_USED;
X    }
X    return;
X    }
X
X    /* reset variables */
X
X    while (*s) {
X    i = *s;
X    if (s[1] == '-') {
X        s += 2;
X    }
X    max = *s++;
X    for ( ; i <= max; i++) {
X        for (entry = stash->tbl_array[i];
X          entry;
X          entry = entry->hent_next) {
X        stab = (STAB*)entry->hent_val;
X        str = stab_val(stab);
X        str->str_cur = 0;
X        str->str_nok = 0;
X#ifdef TAINT
X        str->str_tainted = tainted;
X#endif
X        if (str->str_ptr != Nullch)
X            str->str_ptr[0] = '\0';
X        if (stab_xarray(stab)) {
X            aclear(stab_xarray(stab));
X        }
X        if (stab_xhash(stab)) {
X            hclear(stab_xhash(stab));
X            if (stab == envstab)
X            environ[0] = Nullch;
X        }
X        }
X    }
X    }
X}
X
X#ifdef TAINT
Xtaintproper(s)
Xchar *s;
X{
X#ifdef DEBUGGING
X    if (debug & 2048)
X    fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
X#endif
X    if (tainted && (!euid || euid != uid)) {
X    if (!unsafe)
X        fatal("%s", s);
X    else if (dowarn)
X        warn("%s", s);
X    }
X}
X
Xtaintenv()
X{
X    register STR *envstr;
X
X    envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
X    if (!envstr || envstr->str_tainted) {
X    tainted = 1;
X    taintproper("Insecure PATH");
X    }
X    envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
X    if (envstr && envstr->str_tainted) {
X    tainted = 1;
X    taintproper("Insecure IFS");
X    }
X}
X#endif /* TAINT */
!STUFFY!FUNK!
echo Extracting regexec.c
sed >regexec.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* NOTE: this is derived from Henry Spencer's regexp code, and should not
X * confused with the original package (see point 3 below).  Thanks, Henry!
X */
X
X/* Additional note: this code is very heavily munged from Henry's version
X * in places.  In some spots I've traded clarity for efficiency, so don't
X * blame Henry for some of the lack of readability.
X */
X
X/* $Header: regexec.c,v 3.0 89/10/18 15:22:53 lwall Locked $
X *
X * $Log:    regexec.c,v $
X * Revision 3.0  89/10/18  15:22:53  lwall
X * 3.0 baseline
X *
X */
X
X/*
X * regcomp and regexec -- regsub and regerror are not used in perl
X *
X *    Copyright (c) 1986 by University of Toronto.
X *    Written by Henry Spencer.  Not derived from licensed software.
X *
X *    Permission is granted to anyone to use this software for any
X *    purpose on any computer system, and to redistribute it freely,
X *    subject to the following restrictions:
X *
X *    1. The author is not responsible for the consequences of use of
X *        this software, no matter how awful, even if they arise
X *        from defects in it.
X *
X *    2. The origin of this software must not be misrepresented, either
X *        by explicit claim or by omission.
X *
X *    3. Altered versions must be plainly marked as such, and must not
X *        be misrepresented as being the original software.
X *
X ****    Alterations to Henry's code are...
X ****
X ****    Copyright (c) 1989, Larry Wall
X ****
X ****    You may distribute under the terms of the GNU General Public License
X ****    as specified in the README file that comes with the perl 3.0 kit.
X *
X * Beware that some of this code is subtly aware of the way operator
X * precedence is structured in regular expressions.  Serious changes in
X * regular-expression syntax might require a total rethink.
X */
X#include "EXTERN.h"
X#include "perl.h"
X#include "regcomp.h"
X
X#ifndef STATIC
X#define    STATIC    static
X#endif
X
X#ifdef DEBUGGING
Xint regnarrate = 0;
X#endif
X
X/*
X * regexec and friends
X */
X
X/*
X * Global work variables for regexec().
X */
Xstatic char *regprecomp;
Xstatic char *reginput;        /* String-input pointer. */
Xstatic char *regbol;        /* Beginning of input, for ^ check. */
Xstatic char *regeol;        /* End of input, for $ check. */
Xstatic char **regstartp;    /* Pointer to startp array. */
Xstatic char **regendp;        /* Ditto for endp. */
Xstatic char *reglastparen;    /* Similarly for lastparen. */
Xstatic char *regtill;
X
Xstatic char *regmystartp[10];    /* For remembering backreferences. */
Xstatic char *regmyendp[10];
X
X/*
X * Forwards.
X */
XSTATIC int regtry();
XSTATIC int regmatch();
XSTATIC int regrepeat();
X
Xextern int multiline;
X
X/*
X - regexec - match a regexp against a string
X */
Xint
Xregexec(prog, stringarg, strend, strbeg, minend, screamer, safebase)
Xregister regexp *prog;
Xchar *stringarg;
Xregister char *strend;    /* pointer to null at end of string */
Xchar *strbeg;    /* real beginning of string */
Xint minend;    /* end of match must be at least minend after stringarg */
XSTR *screamer;
Xint safebase;    /* no need to remember string in subbase */
X{
X    register char *s;
X    register int i;
X    register char *c;
X    register char *string = stringarg;
X    register int tmp;
X    int minlen = 0;        /* must match at least this many chars */
X    int dontbother = 0;    /* how many characters not to try at end */
X    int beginning = (string == strbeg);    /* is ^ valid at stringarg? */
X
X    /* Be paranoid... */
X    if (prog == NULL || string == NULL) {
X        fatal("NULL regexp parameter");
X        return(0);
X    }
X
X    regprecomp = prog->precomp;
X    /* Check validity of program. */
X    if (UCHARAT(prog->program) != MAGIC) {
X        FAIL("corrupted regexp program");
X    }
X
X    if (prog->do_folding) {
X        safebase = FALSE;
X        i = strend - string;
X        New(1101,c,i+1,char);
X        (void)bcopy(string, c, i+1);
X        string = c;
X        strend = string + i;
X        for (s = string; s < strend; s++)
X            if (isupper(*s))
X                *s = tolower(*s);
X    }
X
X    /* If there is a "must appear" string, look for it. */
X    s = string;
X    if (prog->regmust != Nullstr) {
X        if (beginning && screamer) {
X            if (screamfirst[prog->regmust->str_rare] >= 0)
X                s = screaminstr(screamer,prog->regmust);
X            else
X                s = Nullch;
X        }
X#ifndef lint
X        else
X            s = fbminstr((unsigned char*)s, (unsigned char*)strend,
X                prog->regmust);
X#endif
X        if (!s) {
X            ++prog->regmust->str_u.str_useful;    /* hooray */
X            goto phooey;    /* not present */
X        }
X        else if (prog->regback >= 0) {
X            s -= prog->regback;
X            if (s < string)
X                s = string;
X            minlen = prog->regback + prog->regmust->str_cur;
X        }
X        else if (--prog->regmust->str_u.str_useful < 0) { /* boo */
X            str_free(prog->regmust);
X            prog->regmust = Nullstr;    /* disable regmust */
X            s = string;
X        }
X        else {
X            s = string;
X            minlen = prog->regmust->str_cur;
X        }
X    }
X
X    /* Mark beginning of line for ^ . */
X    if (beginning)
X        regbol = string;
X    else
X        regbol = NULL;
X
X    /* Mark end of line for $ (and such) */
X    regeol = strend;
X
X    /* see how far we have to get to not match where we matched before */
X    regtill = string+minend;
X
X    /* Simplest case:  anchored match need be tried only once. */
X    /*  [unless multiline is set] */
X    if (prog->reganch) {
X        if (regtry(prog, string))
X            goto got_it;
X        else if (multiline) {
X            if (minlen)
X                dontbother = minlen - 1;
X            strend -= dontbother;
X            /* for multiline we only have to try after newlines */
X            if (s > string)
X                s--;
X            for (; s < strend; s++) {
X                if (*s == '\n') {
X                if (++s < strend && regtry(prog, s))
X                    goto got_it;
X                }
X            }
X        }
X        goto phooey;
X    }
X
X    /* Messy cases:  unanchored match. */
X    if (prog->regstart) {
X        /* We know what string it must start with. */
X        if (prog->regstart->str_pok == 3) {
X#ifndef lint
X            while ((s = fbminstr((unsigned char*)s,
X              (unsigned char*)strend, prog->regstart)) != NULL)
X#else
X            while (s = Nullch)
X#endif
X            {
X                if (regtry(prog, s))
X                    goto got_it;
X                s++;
X            }
X        }
X        else {
X            c = prog->regstart->str_ptr;
X            while ((s = ninstr(s, strend,
X              c, c + prog->regstart->str_cur )) != NULL) {
X                if (regtry(prog, s))
X                    goto got_it;
X                s++;
X            }
X        }
X        goto phooey;
X    }
X    if (c = prog->regstclass) {
X        if (minlen)
X            dontbother = minlen - 1;
X        strend -= dontbother;    /* don't bother with what can't match */
X        /* We know what class it must start with. */
X        switch (OP(c)) {
X        case ANYOF: case ANYBUT:
X            c = OPERAND(c);
X            while (s < strend) {
X                i = *s;
X                if (!(c[i >> 3] & (1 << (i&7))))
X                    if (regtry(prog, s))
X                        goto got_it;
X                s++;
X            }
X            break;
X        case BOUND:
X            if (minlen)
X            dontbother++,strend--;
X            if (s != string) {
X            i = s[-1];
X            tmp = (isalpha(i) || isdigit(i) || i == '_');
X            }
X            else
X            tmp = 0;    /* assume not alphanumeric */
X            while (s < strend) {
X                i = *s;
X                if (tmp != (isalpha(i) || isdigit(i) || i == '_')) {
X                    tmp = !tmp;
X                    if (regtry(prog, s))
X                        goto got_it;
X                }
X                s++;
X            }
X            if (tmp && regtry(prog,s))
X                goto got_it;
X            break;
X        case NBOUND:
X            if (minlen)
X            dontbother++,strend--;
X            if (s != string) {
X            i = s[-1];
X            tmp = (isalpha(i) || isdigit(i) || i == '_');
X            }
X            else
X            tmp = 0;    /* assume not alphanumeric */
X            while (s < strend) {
X                i = *s;
X                if (tmp != (isalpha(i) || isdigit(i) || i == '_'))
X                    tmp = !tmp;
X                else if (regtry(prog, s))
X                    goto got_it;
X                s++;
X            }
X            if (!tmp && regtry(prog,s))
X                goto got_it;
X            break;
X        case ALNUM:
X            while (s < strend) {
X                i = *s;
X                if (isalpha(i) || isdigit(i) || i == '_')
X                    if (regtry(prog, s))
X                        goto got_it;
X                s++;
X            }
X            break;
X        case NALNUM:
X            while (s < strend) {
X                i = *s;
X                if (!isalpha(i) && !isdigit(i) && i != '_')
X                    if (regtry(prog, s))
X                        goto got_it;
X                s++;
X            }
X            break;
X        case SPACE:
X            while (s < strend) {
X                if (isspace(*s))
X                    if (regtry(prog, s))
X                        goto got_it;
X                s++;
X            }
X            break;
X        case NSPACE:
X            while (s < strend) {
X                if (!isspace(*s))
X                    if (regtry(prog, s))
X                        goto got_it;
X                s++;
X            }
X            break;
X        case DIGIT:
X            while (s < strend) {
X                if (isdigit(*s))
X                    if (regtry(prog, s))
X                        goto got_it;
X                s++;
X            }
X            break;
X        case NDIGIT:
X            while (s < strend) {
X                if (!isdigit(*s))
X                    if (regtry(prog, s))
X                        goto got_it;
X                s++;
X            }
X            break;
X        }
X    }
X    else {
X        dontbother = minend;
X        strend -= dontbother;
X        /* We don't know much -- general case. */
X        do {
X            if (regtry(prog, s))
X                goto got_it;
X        } while (s++ < strend);
X    }
X
X    /* Failure. */
X    goto phooey;
X
X    got_it:
X    if ((!safebase && (prog->nparens || sawampersand)) || prog->do_folding){
X        strend += dontbother;    /* uncheat */
X        if (safebase)            /* no need for $digit later */
X            s = strbeg;
X        else if (strbeg != prog->subbase) {
X            i = strend - string + (stringarg - strbeg);
X            s = nsavestr(strbeg,i);    /* so $digit will work later */
X            if (prog->subbase)
X                Safefree(prog->subbase);
X            prog->subbase = s;
X        }
X        else
X            s = prog->subbase;
X        s += (stringarg - strbeg);
X        for (i = 0; i <= prog->nparens; i++) {
X            if (prog->endp[i]) {
X                prog->startp[i] = s + (prog->startp[i] - string);
X                prog->endp[i] = s + (prog->endp[i] - string);
X            }
X        }
X        if (prog->do_folding)
X            Safefree(string);
X    }
X    return(1);
X
X    phooey:
X    if (prog->do_folding)
X        Safefree(string);
X    return(0);
X}
X
X/*
X - regtry - try match at specific point
X */
Xstatic int            /* 0 failure, 1 success */
Xregtry(prog, string)
Xregexp *prog;
Xchar *string;
X{
X    register int i;
X    register char **sp;
X    register char **ep;
X
X    reginput = string;
X    regstartp = prog->startp;
X    regendp = prog->endp;
X    reglastparen = &prog->lastparen;
X    prog->lastparen = 0;
X
X    sp = prog->startp;
X    ep = prog->endp;
X    if (prog->nparens) {
X        for (i = NSUBEXP; i > 0; i--) {
X            *sp++ = NULL;
X            *ep++ = NULL;
X        }
X    }
X    if (regmatch(prog->program + 1) && reginput >= regtill) {
X        prog->startp[0] = string;
X        prog->endp[0] = reginput;
X        return(1);
X    } else
X        return(0);
X}
X
X/*
X - regmatch - main matching routine
X *
X * Conceptually the strategy is simple:  check to see whether the current
X * node matches, call self recursively to see whether the rest matches,
X * and then act accordingly.  In practice we make some effort to avoid
X * recursion, in particular by going through "ordinary" nodes (that don't
X * need to know whether the rest of the match failed) by a loop instead of
X * by recursion.
X */
X/* [lwall] I've hoisted the register declarations to the outer block in order to
X * maybe save a little bit of pushing and popping on the stack.  It also takes
X * advantage of machines that use a register save mask on subroutine entry.
X */
Xstatic int            /* 0 failure, 1 success */
Xregmatch(prog)
Xchar *prog;
X{
X    register char *scan;    /* Current node. */
X    char *next;        /* Next node. */
X    register int nextchar;
X    register int n;        /* no or next */
X    register int ln;        /* len or last */
X    register char *s;    /* operand or save */
X    register char *locinput = reginput;
X
X    nextchar = *locinput;
X    scan = prog;
X#ifdef DEBUGGING
X    if (scan != NULL && regnarrate)
X        fprintf(stderr, "%s(\n", regprop(scan));
X#endif
X    while (scan != NULL) {
X#ifdef DEBUGGING
X        if (regnarrate)
X            fprintf(stderr, "%s...\n", regprop(scan));
X#endif
X
X#ifdef REGALIGN
X        next = scan + NEXT(scan);
X        if (next == scan)
X            next = NULL;
X#else
X        next = regnext(scan);
X#endif
X
X        switch (OP(scan)) {
X        case BOL:
X            if (locinput == regbol ||
X                ((nextchar || locinput < regeol) &&
X                  locinput[-1] == '\n') )
X            {
X                regtill--;
X                break;
X            }
X            return(0);
X        case EOL:
X            if ((nextchar || locinput < regeol) && nextchar != '\n')
X                return(0);
X            regtill--;
X            break;
X        case ANY:
X            if ((nextchar == '\0' && locinput >= regeol) ||
X              nextchar == '\n')
X                return(0);
X            nextchar = *++locinput;
X            break;
X        case EXACTLY:
X            s = OPERAND(scan);
X            ln = *s++;
X            /* Inline the first character, for speed. */
X            if (*s != nextchar)
X                return(0);
X            if (locinput + ln > regeol)
X                return 0;
X            if (ln > 1 && bcmp(s, locinput, ln) != 0)
X                return(0);
X            locinput += ln;
X            nextchar = *locinput;
X            break;
X        case ANYOF:
X        case ANYBUT:
X            s = OPERAND(scan);
X            if (nextchar < 0)
X                nextchar = UCHARAT(locinput);
X            if (s[nextchar >> 3] & (1 << (nextchar&7)))
X                return(0);
X            nextchar = *++locinput;
X            if (!nextchar && locinput > regeol)
X                return 0;
X            break;
X        case ALNUM:
X            if (!nextchar)
X                return(0);
X            if (!isalpha(nextchar) && !isdigit(nextchar) &&
X              nextchar != '_')
X                return(0);
X            nextchar = *++locinput;
X            break;
X        case NALNUM:
X            if (!nextchar && locinput >= regeol)
X                return(0);
X            if (isalpha(nextchar) || isdigit(nextchar) ||
X              nextchar == '_')
X                return(0);
X            nextchar = *++locinput;
X            break;
X        case NBOUND:
X        case BOUND:
X            if (locinput == regbol)    /* was last char in word? */
X                ln = 0;
X            else
X                ln = (isalpha(locinput[-1]) ||
X                     isdigit(locinput[-1]) ||
X                     locinput[-1] == '_' );
X            n = (isalpha(nextchar) || isdigit(nextchar) ||
X                nextchar == '_' );    /* is next char in word? */
X            if ((ln == n) == (OP(scan) == BOUND))
X                return(0);
X            break;
X        case SPACE:
X            if (!nextchar && locinput >= regeol)
X                return(0);
X            if (!isspace(nextchar))
X                return(0);
X            nextchar = *++locinput;
X            break;
X        case NSPACE:
X            if (!nextchar)
X                return(0);
X            if (isspace(nextchar))
X                return(0);
X            nextchar = *++locinput;
X            break;
X        case DIGIT:
X            if (!isdigit(nextchar))
X                return(0);
X            nextchar = *++locinput;
X            break;
X        case NDIGIT:
X            if (!nextchar && locinput >= regeol)
X                return(0);
X            if (isdigit(nextchar))
X                return(0);
X            nextchar = *++locinput;
X            break;
X        case REF:
X        case REF+1:
X        case REF+2:
X        case REF+3:
X        case REF+4:
X        case REF+5:
X        case REF+6:
X        case REF+7:
X        case REF+8:
X        case REF+9:
X            n = OP(scan) - REF;
X            s = regmystartp[n];
X            if (!s)
X                return(0);
X            if (!regmyendp[n])
X                return(0);
X            if (s == regmyendp[n])
X                break;
X            /* Inline the first character, for speed. */
X            if (*s != nextchar)
X                return(0);
X            ln = regmyendp[n] - s;
X            if (locinput + ln > regeol)
X                return 0;
X            if (ln > 1 && bcmp(s, locinput, ln) != 0)
X                return(0);
X            locinput += ln;
X            nextchar = *locinput;
X            break;
X
X        case NOTHING:
X            break;
X        case BACK:
X            break;
X        case OPEN+1:
X        case OPEN+2:
X        case OPEN+3:
X        case OPEN+4:
X        case OPEN+5:
X        case OPEN+6:
X        case OPEN+7:
X        case OPEN+8:
X        case OPEN+9:
X            n = OP(scan) - OPEN;
X            reginput = locinput;
X
X            regmystartp[n] = locinput;    /* for REF */
X            if (regmatch(next)) {
X                /*
X                 * Don't set startp if some later
X                 * invocation of the same parentheses
X                 * already has.
X                 */
X                if (regstartp[n] == NULL)
X                    regstartp[n] = locinput;
X                return(1);
X            } else
X                return(0);
X            /* NOTREACHED */
X        case CLOSE+1:
X        case CLOSE+2:
X        case CLOSE+3:
X        case CLOSE+4:
X        case CLOSE+5:
X        case CLOSE+6:
X        case CLOSE+7:
X        case CLOSE+8:
X        case CLOSE+9: {
X                n = OP(scan) - CLOSE;
X                reginput = locinput;
X
X                regmyendp[n] = locinput;    /* for REF */
X                if (regmatch(next)) {
X                    /*
X                     * Don't set endp if some later
X                     * invocation of the same parentheses
X                     * already has.
X                     */
X                    if (regendp[n] == NULL) {
X                        regendp[n] = locinput;
X                        if (n > *reglastparen)
X                            *reglastparen = n;
X                    }
X                    return(1);
X                } else
X                    return(0);
X            }
X            /*NOTREACHED*/
X        case BRANCH: {
X                if (OP(next) != BRANCH)        /* No choice. */
X                    next = NEXTOPER(scan);    /* Avoid recursion. */
X                else {
X                    do {
X                        reginput = locinput;
X                        if (regmatch(NEXTOPER(scan)))
X                            return(1);
X#ifdef REGALIGN
X                        if (n = NEXT(scan))
X                            scan += n;
X                        else
X                            scan = NULL;
X#else
X                        scan = regnext(scan);
X#endif
X                    } while (scan != NULL && OP(scan) == BRANCH);
X                    return(0);
X                    /* NOTREACHED */
X                }
X            }
X            break;
X        case STAR:
X        case PLUS:
X            /*
X             * Lookahead to avoid useless match attempts
X             * when we know what character comes next.
X             */
X            if (OP(next) == EXACTLY)
X                nextchar = *(OPERAND(next)+1);
X            else
X                nextchar = -1000;
X            ln = (OP(scan) == STAR) ? 0 : 1;
X            reginput = locinput;
X            n = regrepeat(NEXTOPER(scan));
X            while (n >= ln) {
X                /* If it could work, try it. */
X                if (nextchar == -1000 || *reginput == nextchar)
X                    if (regmatch(next))
X                        return(1);
X                /* Couldn't or didn't -- back up. */
X                n--;
X                reginput = locinput + n;
X            }
X            return(0);
X        case END:
X            reginput = locinput; /* put where regtry can find it */
X            return(1);    /* Success! */
X        default:
X            printf("%x %d\n",scan,scan[1]);
X            FAIL("regexp memory corruption");
X        }
X
X        scan = next;
X    }
X
X    /*
X     * We get here only if there's trouble -- normally "case END" is
X     * the terminating point.
X     */
X    FAIL("corrupted regexp pointers");
X    /*NOTREACHED*/
X#ifdef lint
X    return 0;
X#endif
X}
X
X/*
X - regrepeat - repeatedly match something simple, report how many
X */
X/*
X * [This routine now assumes that it will only match on things of length 1.
X * That was true before, but now we assume scan - reginput is the count,
X * rather than incrementing count on every character.]
X */
Xstatic int
Xregrepeat(p)
Xchar *p;
X{
X    register char *scan;
X    register char *opnd;
X    register int c;
X    register char *loceol = regeol;
X
X    scan = reginput;
X    opnd = OPERAND(p);
X    switch (OP(p)) {
X    case ANY:
X        while (scan < loceol && *scan != '\n')
X            scan++;
X        break;
X    case EXACTLY:        /* length of string is 1 */
X        opnd++;
X        while (scan < loceol && *opnd == *scan)
X            scan++;
X        break;
X    case ANYOF:
X    case ANYBUT:
X        c = UCHARAT(scan);
X        while (scan < loceol && !(opnd[c >> 3] & (1 << (c & 7)))) {
X            scan++;
X            c = UCHARAT(scan);
X        }
X        break;
X    case ALNUM:
X        while (isalpha(*scan) || isdigit(*scan) || *scan == '_')
X            scan++;
X        break;
X    case NALNUM:
X        while (scan < loceol && (!isalpha(*scan) && !isdigit(*scan) &&
X          *scan != '_'))
X            scan++;
X        break;
X    case SPACE:
X        while (scan < loceol && isspace(*scan))
X            scan++;
X        break;
X    case NSPACE:
X        while (scan < loceol && !isspace(*scan))
X            scan++;
X        break;
X    case DIGIT:
X        while (isdigit(*scan))
X            scan++;
X        break;
X    case NDIGIT:
X        while (scan < loceol && !isdigit(*scan))
X            scan++;
X        break;
X    default:        /* Oh dear.  Called inappropriately. */
X        FAIL("internal regexp foulup");
X        /* NOTREACHED */
X    }
X
X    c = scan - reginput;
X    reginput = scan;
X
X    return(c);
X}
X
X/*
X - regnext - dig the "next" pointer out of a node
X *
X * [Note, when REGALIGN is defined there are two places in regmatch()
X * that bypass this code for speed.]
X */
Xchar *
Xregnext(p)
Xregister char *p;
X{
X    register int offset;
X
X    if (p == ®dummy)
X        return(NULL);
X
X    offset = NEXT(p);
X    if (offset == 0)
X        return(NULL);
X
X#ifdef REGALIGN
X    return(p+offset);
X#else
X    if (OP(p) == BACK)
X        return(p-offset);
X    else
X        return(p+offset);
X#endif
X}
!STUFFY!FUNK!
echo Extracting t/op.split
sed >t/op.split <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.split,v 3.0 89/10/18 15:31:24 lwall Locked $
X
Xprint "1..12\n";
X
X$FS = ':';
X
X$_ = 'a:b:c';
X
X($a,$b,$c) = split($FS,$_);
X
Xif (join(';',$a,$b,$c) eq 'a;b;c') {print "ok 1\n";} else {print "not ok 1\n";}
X
X@ary = split(/:b:/);
Xif (join("$_",@ary) eq 'aa:b:cc') {print "ok 2\n";} else {print "not ok 2\n";}
X
X$_ = "abc\n";
X@xyz = (@ary = split(//));
Xif (join(".",@ary) eq "a.b.c.\n") {print "ok 3\n";} else {print "not ok 3\n";}
X
X$_ = "a:b:c::::";
X@ary = split(/:/);
Xif (join(".",@ary) eq "a.b.c") {print "ok 4\n";} else {print "not ok 4\n";}
X
X$_ = join(':',split(' ',"    a b\tc \t d "));
Xif ($_ eq 'a:b:c:d') {print "ok 5\n";} else {print "not ok 5 #$_#\n";}
X
X$_ = join(':',split(/ */,"foo  bar bie\tdoll"));
Xif ($_ eq "f:o:o:b:a:r:b:i:e:\t:d:o:l:l")
X    {print "ok 6\n";} else {print "not ok 6\n";}
X
X$_ = join(':', 'foo', split(/ /,'a b  c'), 'bar');
Xif ($_ eq "foo:a:b::c:bar") {print "ok 7\n";} else {print "not ok 7 $_\n";}
X
X# Can we say how many fields to split to?
X$_ = join(':', split(' ','1 2 3 4 5 6', 3));
Xprint $_ eq '1:2:3 4 5 6' ? "ok 8\n" : "not ok 8 $_\n";
X
X# Can we do it as a variable?
X$x = 4;
X$_ = join(':', split(' ','1 2 3 4 5 6', $x));
Xprint $_ eq '1:2:3:4 5 6' ? "ok 9\n" : "not ok 9 $_\n";
X
X# Does the 999 suppress null field chopping?
X$_ = join(':', split(/:/,'1:2:3:4:5:6:::', 999));
Xprint $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n";
X
X# Does assignment to a list imply split to one more field than that?
X$foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1`;
Xprint $foo eq '' || $foo =~ /num\(3\)/ ? "ok 11\n" : "not ok 11\n";
X
X# Can we say how many fields to split to when assigning to a list?
X($a,$b) = split(' ','1 2 3 4 5 6', 2);
X$_ = join(':',$a,$b);
Xprint $_ eq '1:2 3 4 5 6' ? "ok 12\n" : "not ok 12 $_\n";
X
!STUFFY!FUNK!
echo ""
echo "End of kit 13 (of 24)"
cat /dev/null >kit13isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24; do
    if test -f kit${iskit}isdone; then
    run="$run $iskit"
    else
    todo="$todo $iskit"
    fi
done
case $todo in
    '')
    echo "You have run all your kits.  Please read README and then type Configure."
    chmod 755 Configure
    ;;
    *)  echo "You have run$run."
    echo "You still need to run$todo."
    ;;
esac
: Someone might mail this, so...
exit

--
Please send comp.sources.unix-related mail to [e-mail].
Use a domain-based address or give alternate paths, or you may lose out.