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

Internet Message Format | 1989-10-29 | 49.4 KB

Subject:  v20i088:  Perl, a language with features of C/sed/awk/shell/etc, Part05/24
Newsgroups: comp.sources.unix
Sender: sources
Approved: [e-mail]

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

#! /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 5 (of 24).  If kit 5 is complete, the line"
echo '"'"End of kit 5 (of 24)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir  2>/dev/null
echo Extracting toke.c
sed >toke.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: toke.c,v 3.0 89/10/18 15:32:33 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:    toke.c,v $
X * Revision 3.0  89/10/18  15:32:33  lwall
X * 3.0 baseline
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X#include "perly.h"
X
Xchar *reparse;        /* if non-null, scanreg found ${foo[$bar]} */
X
X#define CLINE (cmdline = (line < cmdline ? line : cmdline))
X
X#define META(c) ((c) | 128)
X
X#define RETURN(retval) return (bufptr = s,(int)retval)
X#define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
X#define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
X#define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
X#define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
X#define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
X#define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
X#define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
X#define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
X#define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
X#define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
X#define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
X#define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
X#define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
X#define LFUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)LFUNC4)
X#define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
X#define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
X#define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
X#define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
X#define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
X#define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
X#define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
X#define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
X#define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
X#define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
X
X/* This bit of chicanery makes a unary function followed by
X * a parenthesis into a function with one argument, highest precedence.
X */
X#define UNI(f) return(yylval.ival = f,expectterm = TRUE,bufptr = s, \
X    (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
X
X/* This does similarly for list operators, merely by pretending that the
X * paren came before the listop rather than after.
X */
X#define LOP(f) return(*s == '(' || (s = skipspace(s), *s == '(') ? \
X    (*s = META('('), bufptr = oldbufptr, '(') : \
X    (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
X
Xchar *
Xskipspace(s)
Xregister char *s;
X{
X    while (s < bufend && isascii(*s) && isspace(*s))
X    s++;
X    return s;
X}
X
Xyylex()
X{
X    register char *s = bufptr;
X    register char *d;
X    register int tmp;
X    static bool in_format = FALSE;
X    static bool firstline = TRUE;
X    extern int yychar;        /* last token */
X
X    oldoldbufptr = oldbufptr;
X    oldbufptr = s;
X
X  retry:
X#ifdef YYDEBUG
X    if (yydebug)
X    if (index(s,'\n'))
X        fprintf(stderr,"Tokener at %s",s);
X    else
X        fprintf(stderr,"Tokener at %s\n",s);
X#endif
X    switch (*s) {
X    default:
X    if ((*s & 127) == '(')
X        *s++ = '(';
X    else
X        warn("Unrecognized character \\%03o ignored", *s++);
X    goto retry;
X    case 0:
X    if (!rsfp)
X        RETURN(0);
X    if (s++ < bufend)
X        goto retry;            /* ignore stray nulls */
X    if (firstline) {
X        firstline = FALSE;
X        if (minus_n || minus_p || perldb) {
X        str_set(linestr,"");
X        if (perldb)
X            str_cat(linestr,"do 'perldb.pl'; print $@;");
X        if (minus_n || minus_p) {
X            str_cat(linestr,"line: while (<>) {");
X            if (minus_a)
X            str_cat(linestr,"@F=split(' ');");
X        }
X        oldoldbufptr = oldbufptr = s = str_get(linestr);
X        bufend = linestr->str_ptr + linestr->str_cur;
X        goto retry;
X        }
X    }
X    if (in_format) {
X        yylval.formval = load_format();
X        in_format = FALSE;
X        oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
X        bufend = linestr->str_ptr + linestr->str_cur;
X        TERM(FORMLIST);
X    }
X    line++;
X    if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
X        if (preprocess)
X        (void)mypclose(rsfp);
X        else if (rsfp != stdin)
X        (void)fclose(rsfp);
X        rsfp = Nullfp;
X        if (minus_n || minus_p) {
X        str_set(linestr,minus_p ? "}continue{print;" : "");
X        str_cat(linestr,"}");
X        oldoldbufptr = oldbufptr = s = str_get(linestr);
X        bufend = linestr->str_ptr + linestr->str_cur;
X        goto retry;
X        }
X        oldoldbufptr = oldbufptr = s = str_get(linestr);
X        str_set(linestr,"");
X        RETURN(0);
X    }
X    oldoldbufptr = oldbufptr = bufptr = s;
X    if (perldb) {
X        STR *str = Str_new(85,0);
X
X        str_sset(str,linestr);
X        astore(lineary,(int)line,str);
X    }
X#ifdef DEBUG
X    if (firstline) {
X        char *showinput();
X        s = showinput();
X    }
X#endif
X    bufend = linestr->str_ptr + linestr->str_cur;
X    firstline = FALSE;
X    goto retry;
X    case ' ': case '\t': case '\f':
X    s++;
X    goto retry;
X    case '\n':
X    case '#':
X    if (preprocess && s == str_get(linestr) &&
X           s[1] == ' ' && isdigit(s[2])) {
X        line = atoi(s+2)-1;
X        for (s += 2; isdigit(*s); s++) ;
X        d = bufend;
X        while (s < d && isspace(*s)) s++;
X        if (filename)
X        Safefree(filename);
X        s[strlen(s)-1] = '\0';    /* wipe out newline */
X        if (*s == '"') {
X        s++;
X        s[strlen(s)-1] = '\0';    /* wipe out trailing quote */
X        }
X        if (*s)
X        filename = savestr(s);
X        else
X        filename = savestr(origfilename);
X        oldoldbufptr = oldbufptr = s = str_get(linestr);
X    }
X    if (in_eval && !rsfp) {
X        d = bufend;
X        while (s < d && *s != '\n')
X        s++;
X        if (s < d) {
X        s++;
X        line++;
X        }
X    }
X    else {
X        *s = '\0';
X        bufend = s;
X    }
X    goto retry;
X    case '-':
X    if (s[1] && isalpha(s[1]) && !isalpha(s[2])) {
X        s++;
X        switch (*s++) {
X        case 'r': FTST(O_FTEREAD);
X        case 'w': FTST(O_FTEWRITE);
X        case 'x': FTST(O_FTEEXEC);
X        case 'o': FTST(O_FTEOWNED);
X        case 'R': FTST(O_FTRREAD);
X        case 'W': FTST(O_FTRWRITE);
X        case 'X': FTST(O_FTREXEC);
X        case 'O': FTST(O_FTROWNED);
X        case 'e': FTST(O_FTIS);
X        case 'z': FTST(O_FTZERO);
X        case 's': FTST(O_FTSIZE);
X        case 'f': FTST(O_FTFILE);
X        case 'd': FTST(O_FTDIR);
X        case 'l': FTST(O_FTLINK);
X        case 'p': FTST(O_FTPIPE);
X        case 'S': FTST(O_FTSOCK);
X        case 'u': FTST(O_FTSUID);
X        case 'g': FTST(O_FTSGID);
X        case 'k': FTST(O_FTSVTX);
X        case 'b': FTST(O_FTBLK);
X        case 'c': FTST(O_FTCHR);
X        case 't': FTST(O_FTTTY);
X        case 'T': FTST(O_FTTEXT);
X        case 'B': FTST(O_FTBINARY);
X        default:
X        s -= 2;
X        break;
X        }
X    }
X    tmp = *s++;
X    if (*s == tmp) {
X        s++;
X        RETURN(DEC);
X    }
X    if (expectterm)
X        OPERATOR('-');
X    else
X        AOP(O_SUBTRACT);
X    case '+':
X    tmp = *s++;
X    if (*s == tmp) {
X        s++;
X        RETURN(INC);
X    }
X    if (expectterm)
X        OPERATOR('+');
X    else
X        AOP(O_ADD);
X
X    case '*':
X    if (expectterm) {
X        s = scanreg(s,bufend,tokenbuf);
X        yylval.stabval = stabent(tokenbuf,TRUE);
X        TERM(STAR);
X    }
X    tmp = *s++;
X    if (*s == tmp) {
X        s++;
X        OPERATOR(POW);
X    }
X    MOP(O_MULTIPLY);
X    case '%':
X    if (expectterm) {
X        s = scanreg(s,bufend,tokenbuf);
X        yylval.stabval = stabent(tokenbuf,TRUE);
X        TERM(HSH);
X    }
X    s++;
X    MOP(O_MODULO);
X
X    case '^':
X    case '~':
X    case '(':
X    case ',':
X    case ':':
X    case '[':
X    tmp = *s++;
X    OPERATOR(tmp);
X    case '{':
X    tmp = *s++;
X    if (isspace(*s) || *s == '#')
X        cmdline = NOLINE;   /* invalidate current command line number */
X    OPERATOR(tmp);
X    case ';':
X    if (line < cmdline)
X        cmdline = line;
X    tmp = *s++;
X    OPERATOR(tmp);
X    case ')':
X    case ']':
X    tmp = *s++;
X    TERM(tmp);
X    case '}':
X    tmp = *s++;
X    for (d = s; *d == ' ' || *d == '\t'; d++) ;
X    if (*d == '\n' || *d == '#')
X        OPERATOR(tmp);        /* block end */
X    else
X        TERM(tmp);            /* associative array end */
X    case '&':
X    s++;
X    tmp = *s++;
X    if (tmp == '&')
X        OPERATOR(ANDAND);
X    s--;
X    if (expectterm) {
X        d = bufend;
X        while (s < d && isspace(*s))
X        s++;
X        if (isalpha(*s) || *s == '_' || *s == '\'')
X        *(--s) = '\\';    /* force next ident to WORD */
X        OPERATOR(AMPER);
X    }
X    OPERATOR('&');
X    case '|':
X    s++;
X    tmp = *s++;
X    if (tmp == '|')
X        OPERATOR(OROR);
X    s--;
X    OPERATOR('|');
X    case '=':
X    s++;
X    tmp = *s++;
X    if (tmp == '=')
X        EOP(O_EQ);
X    if (tmp == '~')
X        OPERATOR(MATCH);
X    s--;
X    OPERATOR('=');
X    case '!':
X    s++;
X    tmp = *s++;
X    if (tmp == '=')
X        EOP(O_NE);
X    if (tmp == '~')
X        OPERATOR(NMATCH);
X    s--;
X    OPERATOR('!');
X    case '<':
X    if (expectterm) {
X        s = scanstr(s);
X        TERM(RSTRING);
X    }
X    s++;
X    tmp = *s++;
X    if (tmp == '<')
X        OPERATOR(LS);
X    if (tmp == '=')
X        ROP(O_LE);
X    s--;
X    ROP(O_LT);
X    case '>':
X    s++;
X    tmp = *s++;
X    if (tmp == '>')
X        OPERATOR(RS);
X    if (tmp == '=')
X        ROP(O_GE);
X    s--;
X    ROP(O_GT);
X
X#define SNARFWORD \
X    d = tokenbuf; \
X    while (isascii(*s) && \
X      (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')) \
X        *d++ = *s++; \
X    if (d[-1] == '\'') \
X        d--,s--; \
X    *d = '\0'; \
X    d = tokenbuf;
X
X    case '$':
X    if (s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) {
X        s++;
X        s = scanreg(s,bufend,tokenbuf);
X        yylval.stabval = aadd(stabent(tokenbuf,TRUE));
X        TERM(ARYLEN);
X    }
X    d = s;
X    s = scanreg(s,bufend,tokenbuf);
X    if (reparse) {        /* turn ${foo[bar]} into ($foo[bar]) */
X      do_reparse:
X        s[-1] = ')';
X        s = d;
X        s[1] = s[0];
X        s[0] = '(';
X        goto retry;
X    }
X    yylval.stabval = stabent(tokenbuf,TRUE);
X    TERM(REG);
X
X    case '@':
X    d = s;
X    s = scanreg(s,bufend,tokenbuf);
X    if (reparse)
X        goto do_reparse;
X    yylval.stabval = stabent(tokenbuf,TRUE);
X    TERM(ARY);
X
X    case '/':            /* may either be division or pattern */
X    case '?':            /* may either be conditional or pattern */
X    if (expectterm) {
X        s = scanpat(s);
X        TERM(PATTERN);
X    }
X    tmp = *s++;
X    if (tmp == '/')
X        MOP(O_DIVIDE);
X    OPERATOR(tmp);
X
X    case '.':
X    if (!expectterm || !isdigit(s[1])) {
X        tmp = *s++;
X        if (*s == tmp) {
X        s++;
X        OPERATOR(DOTDOT);
X        }
X        AOP(O_CONCAT);
X    }
X    /* FALL THROUGH */
X    case '0': case '1': case '2': case '3': case '4':
X    case '5': case '6': case '7': case '8': case '9':
X    case '\'': case '"': case '`':
X    s = scanstr(s);
X    TERM(RSTRING);
X
X    case '\\':    /* some magic to force next word to be a WORD */
X    s++;    /* used by do and sub to force a separate namespace */
X    /* FALL THROUGH */
X    case '_':
X    SNARFWORD;
X    break;
X    case 'a': case 'A':
X    SNARFWORD;
X    if (strEQ(d,"accept"))
X        FOP22(O_ACCEPT);
X    if (strEQ(d,"atan2"))
X        FUN2(O_ATAN2);
X    break;
X    case 'b': case 'B':
X    SNARFWORD;
X    if (strEQ(d,"bind"))
X        FOP2(O_BIND);
X    break;
X    case 'c': case 'C':
X    SNARFWORD;
X    if (strEQ(d,"chop"))
X        LFUN(O_CHOP);
X    if (strEQ(d,"continue"))
X        OPERATOR(CONTINUE);
X    if (strEQ(d,"chdir"))
X        UNI(O_CHDIR);
X    if (strEQ(d,"close"))
X        FOP(O_CLOSE);
X    if (strEQ(d,"closedir"))
X        FOP(O_CLOSEDIR);
X    if (strEQ(d,"crypt")) {
X#ifdef FCRYPT
X        init_des();
X#endif
X        FUN2(O_CRYPT);
X    }
X    if (strEQ(d,"chmod"))
X        LOP(O_CHMOD);
X    if (strEQ(d,"chown"))
X        LOP(O_CHOWN);
X    if (strEQ(d,"connect"))
X        FOP2(O_CONNECT);
X    if (strEQ(d,"cos"))
X        UNI(O_COS);
X    if (strEQ(d,"chroot"))
X        UNI(O_CHROOT);
X    break;
X    case 'd': case 'D':
X    SNARFWORD;
X    if (strEQ(d,"do")) {
X        d = bufend;
X        while (s < d && isspace(*s))
X        s++;
X        if (isalpha(*s) || *s == '_')
X        *(--s) = '\\';    /* force next ident to WORD */
X        OPERATOR(DO);
X    }
X    if (strEQ(d,"die"))
X        LOP(O_DIE);
X    if (strEQ(d,"defined"))
X        LFUN(O_DEFINED);
X    if (strEQ(d,"delete"))
X        OPERATOR(DELETE);
X    if (strEQ(d,"dbmopen"))
X        HFUN3(O_DBMOPEN);
X    if (strEQ(d,"dbmclose"))
X        HFUN(O_DBMCLOSE);
X    if (strEQ(d,"dump"))
X        LOOPX(O_DUMP);
X    break;
X    case 'e': case 'E':
X    SNARFWORD;
X    if (strEQ(d,"else"))
X        OPERATOR(ELSE);
X    if (strEQ(d,"elsif")) {
X        yylval.ival = line;
X        OPERATOR(ELSIF);
X    }
X    if (strEQ(d,"eq") || strEQ(d,"EQ"))
X        EOP(O_SEQ);
X    if (strEQ(d,"exit"))
X        UNI(O_EXIT);
X    if (strEQ(d,"eval")) {
X        allstabs = TRUE;        /* must initialize everything since */
X        UNI(O_EVAL);        /* we don't know what will be used */
X    }
X    if (strEQ(d,"eof"))
X        FOP(O_EOF);
X    if (strEQ(d,"exp"))
X        UNI(O_EXP);
X    if (strEQ(d,"each"))
X        HFUN(O_EACH);
X    if (strEQ(d,"exec")) {
X        set_csh();
X        LOP(O_EXEC);
X    }
X    if (strEQ(d,"endhostent"))
X        FUN0(O_EHOSTENT);
X    if (strEQ(d,"endnetent"))
X        FUN0(O_ENETENT);
X    if (strEQ(d,"endservent"))
X        FUN0(O_ESERVENT);
X    if (strEQ(d,"endprotoent"))
X        FUN0(O_EPROTOENT);
X    if (strEQ(d,"endpwent"))
X        FUN0(O_EPWENT);
X    if (strEQ(d,"endgrent"))
X        FUN0(O_EGRENT);
X    break;
X    case 'f': case 'F':
X    SNARFWORD;
X    if (strEQ(d,"for"))
X        OPERATOR(FOR);
X    if (strEQ(d,"foreach"))
X        OPERATOR(FOR);
X    if (strEQ(d,"format")) {
X        d = bufend;
X        while (s < d && isspace(*s))
X        s++;
X        if (isalpha(*s) || *s == '_')
X        *(--s) = '\\';    /* force next ident to WORD */
X        in_format = TRUE;
X        allstabs = TRUE;        /* must initialize everything since */
X        OPERATOR(FORMAT);        /* we don't know what will be used */
X    }
X    if (strEQ(d,"fork"))
X        FUN0(O_FORK);
X    if (strEQ(d,"fcntl"))
X        FOP3(O_FCNTL);
X    if (strEQ(d,"fileno"))
X        FOP(O_FILENO);
X    if (strEQ(d,"flock"))
X        FOP2(O_FLOCK);
X    break;
X    case 'g': case 'G':
X    SNARFWORD;
X    if (strEQ(d,"gt") || strEQ(d,"GT"))
X        ROP(O_SGT);
X    if (strEQ(d,"ge") || strEQ(d,"GE"))
X        ROP(O_SGE);
X    if (strEQ(d,"grep"))
X        FL2(O_GREP);
X    if (strEQ(d,"goto"))
X        LOOPX(O_GOTO);
X    if (strEQ(d,"gmtime"))
X        UNI(O_GMTIME);
X    if (strEQ(d,"getc"))
X        FOP(O_GETC);
X    if (strnEQ(d,"get",3)) {
X        d += 3;
X        if (*d == 'p') {
X        if (strEQ(d,"ppid"))
X            FUN0(O_GETPPID);
X        if (strEQ(d,"pgrp"))
X            UNI(O_GETPGRP);
X        if (strEQ(d,"priority"))
X            FUN2(O_GETPRIORITY);
X        if (strEQ(d,"protobyname"))
X            UNI(O_GPBYNAME);
X        if (strEQ(d,"protobynumber"))
X            FUN1(O_GPBYNUMBER);
X        if (strEQ(d,"protoent"))
X            FUN0(O_GPROTOENT);
X        if (strEQ(d,"pwent"))
X            FUN0(O_GPWENT);
X        if (strEQ(d,"pwnam"))
X            FUN1(O_GPWNAM);
X        if (strEQ(d,"pwuid"))
X            FUN1(O_GPWUID);
X        if (strEQ(d,"peername"))
X            FOP(O_GETPEERNAME);
X        }
X        else if (*d == 'h') {
X        if (strEQ(d,"hostbyname"))
X            UNI(O_GHBYNAME);
X        if (strEQ(d,"hostbyaddr"))
X            FUN2(O_GHBYADDR);
X        if (strEQ(d,"hostent"))
X            FUN0(O_GHOSTENT);
X        }
X        else if (*d == 'n') {
X        if (strEQ(d,"netbyname"))
X            UNI(O_GNBYNAME);
X        if (strEQ(d,"netbyaddr"))
X            FUN2(O_GNBYADDR);
X        if (strEQ(d,"netent"))
X            FUN0(O_GNETENT);
X        }
X        else if (*d == 's') {
X        if (strEQ(d,"servbyname"))
X            FUN2(O_GSBYNAME);
X        if (strEQ(d,"servbyport"))
X            FUN2(O_GSBYPORT);
X        if (strEQ(d,"servent"))
X            FUN0(O_GSERVENT);
X        if (strEQ(d,"sockname"))
X            FOP(O_GETSOCKNAME);
X        if (strEQ(d,"sockopt"))
X            FOP3(O_GSOCKOPT);
X        }
X        else if (*d == 'g') {
X        if (strEQ(d,"grent"))
X            FUN0(O_GGRENT);
X        if (strEQ(d,"grnam"))
X            FUN1(O_GGRNAM);
X        if (strEQ(d,"grgid"))
X            FUN1(O_GGRGID);
X        }
X        else if (*d == 'l') {
X        if (strEQ(d,"login"))
X            FUN0(O_GETLOGIN);
X        }
X        d -= 3;
X    }
X    break;
X    case 'h': case 'H':
X    SNARFWORD;
X    if (strEQ(d,"hex"))
X        UNI(O_HEX);
X    break;
X    case 'i': case 'I':
X    SNARFWORD;
X    if (strEQ(d,"if")) {
X        yylval.ival = line;
X        OPERATOR(IF);
X    }
X    if (strEQ(d,"index"))
X        FUN2(O_INDEX);
X    if (strEQ(d,"int"))
X        UNI(O_INT);
X    if (strEQ(d,"ioctl"))
X        FOP3(O_IOCTL);
X    break;
X    case 'j': case 'J':
X    SNARFWORD;
X    if (strEQ(d,"join"))
X        FL2(O_JOIN);
X    break;
X    case 'k': case 'K':
X    SNARFWORD;
X    if (strEQ(d,"keys"))
X        HFUN(O_KEYS);
X    if (strEQ(d,"kill"))
X        LOP(O_KILL);
X    break;
X    case 'l': case 'L':
X    SNARFWORD;
X    if (strEQ(d,"last"))
X        LOOPX(O_LAST);
X    if (strEQ(d,"local"))
X        OPERATOR(LOCAL);
X    if (strEQ(d,"length"))
X        UNI(O_LENGTH);
X    if (strEQ(d,"lt") || strEQ(d,"LT"))
X        ROP(O_SLT);
X    if (strEQ(d,"le") || strEQ(d,"LE"))
X        ROP(O_SLE);
X    if (strEQ(d,"localtime"))
X        UNI(O_LOCALTIME);
X    if (strEQ(d,"log"))
X        UNI(O_LOG);
X    if (strEQ(d,"link"))
X        FUN2(O_LINK);
X    if (strEQ(d,"listen"))
X        FOP2(O_LISTEN);
X    if (strEQ(d,"lstat"))
X        FOP(O_LSTAT);
X    break;
X    case 'm': case 'M':
X    SNARFWORD;
X    if (strEQ(d,"m")) {
X        s = scanpat(s-1);
X        if (yylval.arg)
X        TERM(PATTERN);
X        else
X        RETURN(1);    /* force error */
X    }
X    if (strEQ(d,"mkdir"))
X        FUN2(O_MKDIR);
X    break;
X    case 'n': case 'N':
X    SNARFWORD;
X    if (strEQ(d,"next"))
X        LOOPX(O_NEXT);
X    if (strEQ(d,"ne") || strEQ(d,"NE"))
X        EOP(O_SNE);
X    break;
X    case 'o': case 'O':
X    SNARFWORD;
X    if (strEQ(d,"open"))
X        OPERATOR(OPEN);
X    if (strEQ(d,"ord"))
X        UNI(O_ORD);
X    if (strEQ(d,"oct"))
X        UNI(O_OCT);
X    if (strEQ(d,"opendir"))
X        FOP2(O_OPENDIR);
X    break;
X    case 'p': case 'P':
X    SNARFWORD;
X    if (strEQ(d,"print")) {
X        checkcomma(s,"filehandle");
X        LOP(O_PRINT);
X    }
X    if (strEQ(d,"printf")) {
X        checkcomma(s,"filehandle");
X        LOP(O_PRTF);
X    }
X    if (strEQ(d,"push")) {
X        yylval.ival = O_PUSH;
X        OPERATOR(PUSH);
X    }
X    if (strEQ(d,"pop"))
X        OPERATOR(POP);
X    if (strEQ(d,"pack"))
X        FL2(O_PACK);
X    if (strEQ(d,"package"))
X        OPERATOR(PACKAGE);
X    break;
X    case 'q': case 'Q':
X    SNARFWORD;
X    if (strEQ(d,"q")) {
X        s = scanstr(s-1);
X        TERM(RSTRING);
X    }
X    if (strEQ(d,"qq")) {
X        s = scanstr(s-2);
X        TERM(RSTRING);
X    }
X    break;
X    case 'r': case 'R':
X    SNARFWORD;
X    if (strEQ(d,"return"))
X        LOP(O_RETURN);
X    if (strEQ(d,"reset"))
X        UNI(O_RESET);
X    if (strEQ(d,"redo"))
X        LOOPX(O_REDO);
X    if (strEQ(d,"rename"))
X        FUN2(O_RENAME);
X    if (strEQ(d,"rand"))
X        UNI(O_RAND);
X    if (strEQ(d,"rmdir"))
X        UNI(O_RMDIR);
X    if (strEQ(d,"rindex"))
X        FUN2(O_RINDEX);
X    if (strEQ(d,"read"))
X        FOP3(O_READ);
X    if (strEQ(d,"readdir"))
X        FOP(O_READDIR);
X    if (strEQ(d,"rewinddir"))
X        FOP(O_REWINDDIR);
X    if (strEQ(d,"recv"))
X        FOP4(O_RECV);
X    if (strEQ(d,"reverse"))
X        LOP(O_REVERSE);
X    if (strEQ(d,"readlink"))
X        UNI(O_READLINK);
X    break;
X    case 's': case 'S':
X    SNARFWORD;
X    if (strEQ(d,"s")) {
X        s = scansubst(s);
X        if (yylval.arg)
X        TERM(SUBST);
X        else
X        RETURN(1);    /* force error */
X    }
X    switch (d[1]) {
X    case 'a':
X    case 'b':
X    case 'c':
X    case 'd':
X        break;
X    case 'e':
X        if (strEQ(d,"select"))
X        OPERATOR(SELECT);
X        if (strEQ(d,"seek"))
X        FOP3(O_SEEK);
X        if (strEQ(d,"send"))
X        FOP3(O_SEND);
X        if (strEQ(d,"setpgrp"))
X        FUN2(O_SETPGRP);
X        if (strEQ(d,"setpriority"))
X        FUN3(O_SETPRIORITY);
X        if (strEQ(d,"sethostent"))
X        FUN1(O_SHOSTENT);
X        if (strEQ(d,"setnetent"))
X        FUN1(O_SNETENT);
X        if (strEQ(d,"setservent"))
X        FUN1(O_SSERVENT);
X        if (strEQ(d,"setprotoent"))
X        FUN1(O_SPROTOENT);
X        if (strEQ(d,"setpwent"))
X        FUN0(O_SPWENT);
X        if (strEQ(d,"setgrent"))
X        FUN0(O_SGRENT);
X        if (strEQ(d,"seekdir"))
X        FOP2(O_SEEKDIR);
X        if (strEQ(d,"setsockopt"))
X        FOP4(O_SSOCKOPT);
X        break;
X    case 'f':
X    case 'g':
X        break;
X    case 'h':
X        if (strEQ(d,"shift"))
X        TERM(SHIFT);
X        if (strEQ(d,"shutdown"))
X        FOP2(O_SHUTDOWN);
X        break;
X    case 'i':
X        if (strEQ(d,"sin"))
X        UNI(O_SIN);
X        break;
X    case 'j':
X    case 'k':
X        break;
X    case 'l':
X        if (strEQ(d,"sleep"))
X        UNI(O_SLEEP);
X        break;
X    case 'm':
X    case 'n':
X        break;
X    case 'o':
X        if (strEQ(d,"socket"))
X        FOP4(O_SOCKET);
X        if (strEQ(d,"socketpair"))
X        FOP25(O_SOCKETPAIR);
X        if (strEQ(d,"sort")) {
X        checkcomma(s,"subroutine name");
X        d = bufend;
X        while (s < d && isascii(*s) && isspace(*s)) s++;
X        if (*s == ';' || *s == ')')        /* probably a close */
X            fatal("sort is now a reserved word");
X        if (isascii(*s) && (isalpha(*s) || *s == '_')) {
X            for (d = s; isalpha(*d) || isdigit(*d) || *d == '_'; d++) ;
X            if (d >= bufend || isspace(*d))
X            *(--s) = '\\';    /* force next ident to WORD */
X        }
X        LOP(O_SORT);
X        }
X        break;
X    case 'p':
X        if (strEQ(d,"split"))
X        TERM(SPLIT);
X        if (strEQ(d,"sprintf"))
X        FL(O_SPRINTF);
X        break;
X    case 'q':
X        if (strEQ(d,"sqrt"))
X        UNI(O_SQRT);
X        break;
X    case 'r':
X        if (strEQ(d,"srand"))
X        UNI(O_SRAND);
X        break;
X    case 's':
X        break;
X    case 't':
X        if (strEQ(d,"stat"))
X        FOP(O_STAT);
X        if (strEQ(d,"study")) {
X        sawstudy++;
X        LFUN(O_STUDY);
X        }
X        break;
X    case 'u':
X        if (strEQ(d,"substr"))
X        FUN3(O_SUBSTR);
X        if (strEQ(d,"sub")) {
X        subline = line;
X        d = bufend;
X        while (s < d && isspace(*s))
X            s++;
X        if (isalpha(*s) || *s == '_' || *s == '\'') {
X            if (perldb) {
X            str_sset(subname,curstname);
X            str_ncat(subname,"'",1);
X            for (d = s+1;
X              isalpha(*d) || isdigit(*d) || *d == '_' || *d == '\'';
X              d++);
X            if (d[-1] == '\'')
X                d--;
X            str_ncat(subname,s,d-s);
X            }
X            *(--s) = '\\';    /* force next ident to WORD */
X        }
X        else if (perldb)
X            str_set(subname,"?");
X        OPERATOR(SUB);
X        }
X        break;
X    case 'v':
X    case 'w':
X    case 'x':
X        break;
X    case 'y':
X        if (strEQ(d,"system")) {
X        set_csh();
X        LOP(O_SYSTEM);
X        }
X        if (strEQ(d,"symlink"))
X        FUN2(O_SYMLINK);
X        if (strEQ(d,"syscall"))
X        LOP(O_SYSCALL);
X        break;
X    case 'z':
X        break;
X    }
X    break;
X    case 't': case 'T':
X    SNARFWORD;
X    if (strEQ(d,"tr")) {
X        s = scantrans(s);
X        if (yylval.arg)
X        TERM(TRANS);
X        else
X        RETURN(1);    /* force error */
X    }
X    if (strEQ(d,"tell"))
X        FOP(O_TELL);
X    if (strEQ(d,"telldir"))
X        FOP(O_TELLDIR);
X    if (strEQ(d,"time"))
X        FUN0(O_TIME);
X    if (strEQ(d,"times"))
X        FUN0(O_TMS);
X    break;
X    case 'u': case 'U':
X    SNARFWORD;
X    if (strEQ(d,"using"))
X        OPERATOR(USING);
X    if (strEQ(d,"until")) {
X        yylval.ival = line;
X        OPERATOR(UNTIL);
X    }
X    if (strEQ(d,"unless")) {
X        yylval.ival = line;
X        OPERATOR(UNLESS);
X    }
X    if (strEQ(d,"unlink"))
X        LOP(O_UNLINK);
X    if (strEQ(d,"undef"))
X        LFUN(O_UNDEF);
X    if (strEQ(d,"unpack"))
X        FUN2(O_UNPACK);
X    if (strEQ(d,"utime"))
X        LOP(O_UTIME);
X    if (strEQ(d,"umask"))
X        UNI(O_UMASK);
X    if (strEQ(d,"unshift")) {
X        yylval.ival = O_UNSHIFT;
X        OPERATOR(PUSH);
X    }
X    break;
X    case 'v': case 'V':
X    SNARFWORD;
X    if (strEQ(d,"values"))
X        HFUN(O_VALUES);
X    if (strEQ(d,"vec")) {
X        sawvec = TRUE;
X        FUN3(O_VEC);
X    }
X    break;
X    case 'w': case 'W':
X    SNARFWORD;
X    if (strEQ(d,"while")) {
X        yylval.ival = line;
X        OPERATOR(WHILE);
X    }
X    if (strEQ(d,"warn"))
X        LOP(O_WARN);
X    if (strEQ(d,"wait"))
X        FUN0(O_WAIT);
X    if (strEQ(d,"wantarray")) {
X        yylval.arg = op_new(1);
X        yylval.arg->arg_type = O_ITEM;
X        yylval.arg[1].arg_type = A_WANTARRAY;
X        TERM(RSTRING);
X    }
X    if (strEQ(d,"write"))
X        FOP(O_WRITE);
X    break;
X    case 'x': case 'X':
X    SNARFWORD;
X    if (!expectterm && strEQ(d,"x"))
X        MOP(O_REPEAT);
X    break;
X    case 'y': case 'Y':
X    SNARFWORD;
X    if (strEQ(d,"y")) {
X        s = scantrans(s);
X        TERM(TRANS);
X    }
X    break;
X    case 'z': case 'Z':
X    SNARFWORD;
X    break;
X    }
X    yylval.cval = savestr(d);
X    expectterm = FALSE;
X    if (oldoldbufptr && oldoldbufptr < bufptr) {
X    while (isspace(*oldoldbufptr))
X        oldoldbufptr++;
X    if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
X        expectterm = TRUE;
X    else if (*oldoldbufptr == 's' && strnEQ(oldoldbufptr,"sort",4))
X        expectterm = TRUE;
X    }
X    return (CLINE, bufptr = s, (int)WORD);
X}
X
Xint
Xcheckcomma(s,what)
Xregister char *s;
Xchar *what;
X{
X    if (*s == '(')
X    s++;
X    while (s < bufend && isascii(*s) && isspace(*s))
X    s++;
X    if (isascii(*s) && (isalpha(*s) || *s == '_')) {
X    s++;
X    while (isalpha(*s) || isdigit(*s) || *s == '_')
X        s++;
X    while (s < bufend && isspace(*s))
X        s++;
X    if (*s == ',')
X        fatal("No comma allowed after %s", what);
X    }
X}
X
Xchar *
Xscanreg(s,send,dest)
Xregister char *s;
Xregister char *send;
Xchar *dest;
X{
X    register char *d;
X    int brackets = 0;
X
X    reparse = Nullch;
X    s++;
X    d = dest;
X    if (isdigit(*s)) {
X    while (isdigit(*s))
X        *d++ = *s++;
X    }
X    else {
X    while (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')
X        *d++ = *s++;
X    }
X    if (d > dest+1 && d[-1] == '\'')
X    d--,s--;
X    *d = '\0';
X    d = dest;
X    if (!*d) {
X    *d = *s++;
X    if (*d == '{' /* } */ ) {
X        d = dest;
X        brackets++;
X        while (s < send && brackets) {
X        if (!reparse && (d == dest || (*s && isascii(*s) &&
X          (isalpha(*s) || isdigit(*s) || *s == '_') ))) {
X            *d++ = *s++;
X            continue;
X        }
X        else if (!reparse)
X            reparse = s;
X        switch (*s++) {
X        /* { */
X        case '}':
X            brackets--;
X            if (reparse && reparse == s - 1)
X            reparse = Nullch;
X            break;
X        case '{':   /* } */
X            brackets++;
X            break;
X        }
X        }
X        *d = '\0';
X        d = dest;
X    }
X    else
X        d[1] = '\0';
X    }
X    if (*d == '^' && !isspace(*s))
X    *d = *s++ & 31;
X    return s;
X}
X
XSTR *
Xscanconst(string,len)
Xchar *string;
Xint len;
X{
X    register STR *retstr;
X    register char *t;
X    register char *d;
X    register char *e;
X
X    if (index(string,'|')) {
X    return Nullstr;
X    }
X    retstr = Str_new(86,len);
X    str_nset(retstr,string,len);
X    t = str_get(retstr);
X    e = t + len;
X    retstr->str_u.str_useful = 100;
X    for (d=t; d < e; ) {
X    switch (*d) {
X    case '{':
X        if (isdigit(d[1]))
X        e = d;
X        else
X        goto defchar;
X        break;
X    case '.': case '[': case '$': case '(': case ')': case '|': case '+':
X        e = d;
X        break;
X    case '\\':
X        if (d[1] && index("wWbB0123456789sSdD",d[1])) {
X        e = d;
X        break;
X        }
X        (void)bcopy(d+1,d,e-d);
X        e--;
X        switch(*d) {
X        case 'n':
X        *d = '\n';
X        break;
X        case 't':
X        *d = '\t';
X        break;
X        case 'f':
X        *d = '\f';
X        break;
X        case 'r':
X        *d = '\r';
X        break;
X        }
X        /* FALL THROUGH */
X    default:
X      defchar:
X        if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
X        e = d;
X        break;
X        }
X        d++;
X    }
X    }
X    if (d == t) {
X    str_free(retstr);
X    return Nullstr;
X    }
X    *d = '\0';
X    retstr->str_cur = d - t;
X    return retstr;
X}
X
Xchar *
Xscanpat(s)
Xregister char *s;
X{
X    register SPAT *spat;
X    register char *d;
X    register char *e;
X    int len;
X    SPAT savespat;
X
X    Newz(801,spat,1,SPAT);
X    spat->spat_next = curstash->tbl_spatroot;    /* link into spat list */
X    curstash->tbl_spatroot = spat;
X
X    switch (*s++) {
X    case 'm':
X    s++;
X    break;
X    case '/':
X    break;
X    case '?':
X    spat->spat_flags |= SPAT_ONCE;
X    break;
X    default:
X    fatal("panic: scanpat");
X    }
X    s = cpytill(tokenbuf,s,bufend,s[-1],&len);
X    if (s >= bufend) {
X    yyerror("Search pattern not terminated");
X    yylval.arg = Nullarg;
X    return s;
X    }
X    s++;
X    while (*s == 'i' || *s == 'o') {
X    if (*s == 'i') {
X        s++;
X        sawi = TRUE;
X        spat->spat_flags |= SPAT_FOLD;
X    }
X    if (*s == 'o') {
X        s++;
X        spat->spat_flags |= SPAT_KEEP;
X    }
X    }
X    e = tokenbuf + len;
X    for (d=tokenbuf; d < e; d++) {
X    if ((*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') ||
X        (*d == '@' && d[-1] != '\\')) {
X        register ARG *arg;
X
X        spat->spat_runtime = arg = op_new(1);
X        arg->arg_type = O_ITEM;
X        arg[1].arg_type = A_DOUBLE;
X        arg[1].arg_ptr.arg_str = str_make(tokenbuf,len);
X        arg[1].arg_ptr.arg_str->str_u.str_hash = curstash;
X        d = scanreg(d,bufend,buf);
X        (void)stabent(buf,TRUE);        /* make sure it's created */
X        for (; d < e; d++) {
X        if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
X            d = scanreg(d,bufend,buf);
X            (void)stabent(buf,TRUE);
X        }
X        else if (*d == '@' && d[-1] != '\\') {
X            d = scanreg(d,bufend,buf);
X            if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
X              strEQ(buf,"SIG") || strEQ(buf,"INC"))
X            (void)stabent(buf,TRUE);
X        }
X        }
X        goto got_pat;        /* skip compiling for now */
X    }
X    }
X    if (spat->spat_flags & SPAT_FOLD)
X#ifdef STRUCTCOPY
X    savespat = *spat;
X#else
X    (void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT));
X#endif
X    if (*tokenbuf == '^') {
X    spat->spat_short = scanconst(tokenbuf+1,len-1);
X    if (spat->spat_short) {
X        spat->spat_slen = spat->spat_short->str_cur;
X        if (spat->spat_slen == len - 1)
X        spat->spat_flags |= SPAT_ALL;
X    }
X    }
X    else {
X    spat->spat_flags |= SPAT_SCANFIRST;
X    spat->spat_short = scanconst(tokenbuf,len);
X    if (spat->spat_short) {
X        spat->spat_slen = spat->spat_short->str_cur;
X        if (spat->spat_slen == len)
X        spat->spat_flags |= SPAT_ALL;
X    }
X    }
X    if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
X    fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
X    spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len,
X        spat->spat_flags & SPAT_FOLD,1);
X        /* Note that this regexp can still be used if someone says
X         * something like /a/ && s//b/;  so we can't delete it.
X         */
X    }
X    else {
X    if (spat->spat_flags & SPAT_FOLD)
X#ifdef STRUCTCOPY
X        *spat = savespat;
X#else
X        (void)bcopy((char *)&savespat, (char *)spat, sizeof(SPAT));
X#endif
X    if (spat->spat_short)
X        fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
X    spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len,
X        spat->spat_flags & SPAT_FOLD,1);
X    hoistmust(spat);
X    }
X  got_pat:
X    yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
X    return s;
X}
X
Xchar *
Xscansubst(s)
Xregister char *s;
X{
X    register SPAT *spat;
X    register char *d;
X    register char *e;
X    int len;
X
X    Newz(802,spat,1,SPAT);
X    spat->spat_next = curstash->tbl_spatroot;    /* link into spat list */
X    curstash->tbl_spatroot = spat;
X
X    s = cpytill(tokenbuf,s+1,bufend,*s,&len);
X    if (s >= bufend) {
X    yyerror("Substitution pattern not terminated");
X    yylval.arg = Nullarg;
X    return s;
X    }
X    e = tokenbuf + len;
X    for (d=tokenbuf; d < e; d++) {
X    if ((*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') ||
X        (*d == '@' && d[-1] != '\\')) {
X        register ARG *arg;
X
X        spat->spat_runtime = arg = op_new(1);
X        arg->arg_type = O_ITEM;
X        arg[1].arg_type = A_DOUBLE;
X        arg[1].arg_ptr.arg_str = str_make(tokenbuf,len);
X        arg[1].arg_ptr.arg_str->str_u.str_hash = curstash;
X        d = scanreg(d,bufend,buf);
X        (void)stabent(buf,TRUE);        /* make sure it's created */
X        for (; *d; d++) {
X        if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
X            d = scanreg(d,bufend,buf);
X            (void)stabent(buf,TRUE);
X        }
X        else if (*d == '@' && d[-1] != '\\') {
X            d = scanreg(d,bufend,buf);
X            if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
X              strEQ(buf,"SIG") || strEQ(buf,"INC"))
X            (void)stabent(buf,TRUE);
X        }
X        }
X        goto get_repl;        /* skip compiling for now */
X    }
X    }
X    if (*tokenbuf == '^') {
X    spat->spat_short = scanconst(tokenbuf+1,len-1);
X    if (spat->spat_short)
X        spat->spat_slen = spat->spat_short->str_cur;
X    }
X    else {
X    spat->spat_flags |= SPAT_SCANFIRST;
X    spat->spat_short = scanconst(tokenbuf,len);
X    if (spat->spat_short)
X        spat->spat_slen = spat->spat_short->str_cur;
X    }
X    d = nsavestr(tokenbuf,len);
Xget_repl:
X    s = scanstr(s);
X    if (s >= bufend) {
X    yyerror("Substitution replacement not terminated");
X    yylval.arg = Nullarg;
X    return s;
X    }
X    spat->spat_repl = yylval.arg;
X    spat->spat_flags |= SPAT_ONCE;
X    if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
X    spat->spat_flags |= SPAT_CONST;
X    else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
X    STR *tmpstr;
X    register char *t;
X
X    spat->spat_flags |= SPAT_CONST;
X    tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
X    e = tmpstr->str_ptr + tmpstr->str_cur;
X    for (t = tmpstr->str_ptr; t < e; t++) {
X        if (*t == '$' && t[1] && index("`'&+0123456789",t[1]))
X        spat->spat_flags &= ~SPAT_CONST;
X    }
X    }
X    while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
X    if (*s == 'e') {
X        s++;
X        if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
X        spat->spat_repl[1].arg_type = A_SINGLE;
X        spat->spat_repl = fixeval(make_op(O_EVAL,2,
X        spat->spat_repl,
X        Nullarg,
X        Nullarg));
X        spat->spat_flags &= ~SPAT_CONST;
X    }
X    if (*s == 'g') {
X        s++;
X        spat->spat_flags &= ~SPAT_ONCE;
X    }
X    if (*s == 'i') {
X        s++;
X        sawi = TRUE;
X        spat->spat_flags |= SPAT_FOLD;
X        if (!(spat->spat_flags & SPAT_SCANFIRST)) {
X        str_free(spat->spat_short);    /* anchored opt doesn't do */
X        spat->spat_short = Nullstr;    /* case insensitive match */
X        spat->spat_slen = 0;
X        }
X    }
X    if (*s == 'o') {
X        s++;
X        spat->spat_flags |= SPAT_KEEP;
X    }
X    }
X    if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
X    fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
X    if (!spat->spat_runtime) {
X    spat->spat_regexp = regcomp(d,d+len,spat->spat_flags & SPAT_FOLD,1);
X    hoistmust(spat);
X    Safefree(d);
X    }
X    yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
X    return s;
X}
X
Xhoistmust(spat)
Xregister SPAT *spat;
X{
X    if (spat->spat_regexp->regmust) {    /* is there a better short-circuit? */
X    if (spat->spat_short &&
X      str_eq(spat->spat_short,spat->spat_regexp->regmust))
X    {
X        if (spat->spat_flags & SPAT_SCANFIRST) {
X        str_free(spat->spat_short);
X        spat->spat_short = Nullstr;
X        }
X        else {
X        str_free(spat->spat_regexp->regmust);
X        spat->spat_regexp->regmust = Nullstr;
X        return;
X        }
X    }
X    if (!spat->spat_short ||    /* promote the better string */
X      ((spat->spat_flags & SPAT_SCANFIRST) &&
X       (spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
X        str_free(spat->spat_short);        /* ok if null */
X        spat->spat_short = spat->spat_regexp->regmust;
X        spat->spat_regexp->regmust = Nullstr;
X        spat->spat_flags |= SPAT_SCANFIRST;
X    }
X    }
X}
X
Xchar *
Xexpand_charset(s,len,retlen)
Xregister char *s;
Xint len;
Xint *retlen;
X{
X    char t[512];
X    register char *d = t;
X    register int i;
X    register char *send = s + len;
X
X    while (s < send) {
X    if (s[1] == '-' && s+2 < send) {
X        for (i = s[0]; i <= s[2]; i++)
X        *d++ = i;
X        s += 3;
X    }
X    else
X        *d++ = *s++;
X    }
X    *d = '\0';
X    *retlen = d - t;
X    return nsavestr(t,d-t);
X}
X
Xchar *
Xscantrans(s)
Xregister char *s;
X{
X    ARG *arg =
X    l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
X    register char *t;
X    register char *r;
X    register char *tbl;
X    register int i;
X    register int j;
X    int tlen, rlen;
X
X    Newz(803,tbl,256,char);
X    arg[2].arg_type = A_NULL;
X    arg[2].arg_ptr.arg_cval = tbl;
X    s = scanstr(s);
X    if (s >= bufend) {
X    yyerror("Translation pattern not terminated");
X    yylval.arg = Nullarg;
X    return s;
X    }
X    t = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
X    yylval.arg[1].arg_ptr.arg_str->str_cur,&tlen);
X    free_arg(yylval.arg);
X    s = scanstr(s-1);
X    if (s >= bufend) {
X    yyerror("Translation replacement not terminated");
X    yylval.arg = Nullarg;
X    return s;
X    }
X    r = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
X    yylval.arg[1].arg_ptr.arg_str->str_cur,&rlen);
X    free_arg(yylval.arg);
X    yylval.arg = arg;
X    if (!*r) {
X    Safefree(r);
X    r = t;
X    }
X    for (i = 0, j = 0; i < tlen; i++,j++) {
X    if (j >= rlen)
X        --j;
X    tbl[t[i] & 0377] = r[j];
X    }
X    if (r != t)
X    Safefree(r);
X    Safefree(t);
X    return s;
X}
X
Xchar *
Xscanstr(s)
Xregister char *s;
X{
X    register char term;
X    register char *d;
X    register ARG *arg;
X    register char *send;
X    register bool makesingle = FALSE;
X    register STAB *stab;
X    bool alwaysdollar = FALSE;
X    bool hereis = FALSE;
X    STR *herewas;
X    char *leave = "\\$@nrtfb0123456789[{]}"; /* which backslash sequences to keep */
X    int len;
X
X    arg = op_new(1);
X    yylval.arg = arg;
X    arg->arg_type = O_ITEM;
X
X    switch (*s) {
X    default:            /* a substitution replacement */
X    arg[1].arg_type = A_DOUBLE;
X    makesingle = TRUE;    /* maybe disable runtime scanning */
X    term = *s;
X    if (term == '\'')
X        leave = Nullch;
X    goto snarf_it;
X    case '0':
X    {
X        long i;
X        int shift;
X
X        arg[1].arg_type = A_SINGLE;
X        if (s[1] == 'x') {
X        shift = 4;
X        s += 2;
X        }
X        else if (s[1] == '.')
X        goto decimal;
X        else
X        shift = 3;
X        i = 0;
X        for (;;) {
X        switch (*s) {
X        default:
X            goto out;
X        case '8': case '9':
X            if (shift != 4)
X            yyerror("Illegal octal digit");
X            /* FALL THROUGH */
X        case '0': case '1': case '2': case '3': case '4':
X        case '5': case '6': case '7':
X            i <<= shift;
X            i += *s++ & 15;
X            break;
X        case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
X        case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
X            if (shift != 4)
X            goto out;
X            i <<= 4;
X            i += (*s++ & 7) + 9;
X            break;
X        }
X        }
X      out:
X        (void)sprintf(tokenbuf,"%ld",i);
X        arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
X        (void)str_2num(arg[1].arg_ptr.arg_str);
X    }
X    break;
X    case '1': case '2': case '3': case '4': case '5':
X    case '6': case '7': case '8': case '9': case '.':
X      decimal:
X    arg[1].arg_type = A_SINGLE;
X    d = tokenbuf;
X    while (isdigit(*s) || *s == '_') {
X        if (*s == '_')
X        s++;
X        else
X        *d++ = *s++;
X    }
X    if (*s == '.' && s[1] && index("0123456789eE ;",s[1])) {
X        *d++ = *s++;
X        while (isdigit(*s) || *s == '_') {
X        if (*s == '_')
X            s++;
X        else
X            *d++ = *s++;
X        }
X    }
X    if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
X        *d++ = *s++;
X        if (*s == '+' || *s == '-')
X        *d++ = *s++;
X        while (isdigit(*s))
X        *d++ = *s++;
X    }
X    *d = '\0';
X    arg[1].arg_ptr.arg_str = str_make(tokenbuf, d - tokenbuf);
X    (void)str_2num(arg[1].arg_ptr.arg_str);
X    break;
X    case '<':
X    if (*++s == '<') {
X        hereis = TRUE;
X        d = tokenbuf;
X        if (!rsfp)
X        *d++ = '\n';
X        if (*++s && index("`'\"",*s)) {
X        term = *s++;
X        s = cpytill(d,s,bufend,term,&len);
X        if (s < bufend)
X            s++;
X        d += len;
X        }
X        else {
X        if (*s == '\\')
X            s++, term = '\'';
X        else
X            term = '"';
X        while (isascii(*s) && (isalpha(*s) || isdigit(*s) || *s == '_'))
X            *d++ = *s++;
X        }                /* assuming tokenbuf won't clobber */
X        *d++ = '\n';
X        *d = '\0';
X        len = d - tokenbuf;
X        d = "\n";
X        if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
X        herewas = str_make(s,bufend-s);
X        else
X        s--, herewas = str_make(s,d-s);
X        s += herewas->str_cur;
X        if (term == '\'')
X        goto do_single;
X        if (term == '`')
X        goto do_back;
X        goto do_double;
X    }
X    d = tokenbuf;
X    s = cpytill(d,s,bufend,'>',&len);
X    if (s < bufend)
X        s++;
X    if (*d == '$') d++;
X    while (*d &&
X      (isalpha(*d) || isdigit(*d) || *d == '_' || *d == '\''))
X        d++;
X    if (d - tokenbuf != len) {
X        d = tokenbuf;
X        arg[1].arg_type = A_GLOB;
X        d = nsavestr(d,len);
X        arg[1].arg_ptr.arg_stab = stab = genstab();
X        stab_io(stab) = stio_new();
X        stab_val(stab) = str_make(d,len);
X        stab_val(stab)->str_u.str_hash = curstash;
X        Safefree(d);
X        set_csh();
X    }
X    else {
X        d = tokenbuf;
X        if (!len)
X        (void)strcpy(d,"ARGV");
X        if (*d == '$') {
X        arg[1].arg_type = A_INDREAD;
X        arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
X        }
X        else {
X        arg[1].arg_type = A_READ;
X        if (rsfp == stdin && (strEQ(d,"stdin") || strEQ(d,"STDIN")))
X            yyerror("Can't get both program and data from <STDIN>");
X        arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
X        if (!stab_io(arg[1].arg_ptr.arg_stab))
X            stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
X        if (strEQ(d,"ARGV")) {
X            (void)aadd(arg[1].arg_ptr.arg_stab);
X            stab_io(arg[1].arg_ptr.arg_stab)->flags |=
X              IOF_ARGV|IOF_START;
X        }
X        }
X    }
X    break;
X
X    case 'q':
X    s++;
X    if (*s == 'q') {
X        s++;
X        goto do_double;
X    }
X    /* FALL THROUGH */
X    case '\'':
X      do_single:
X    term = *s;
X    arg[1].arg_type = A_SINGLE;
X    leave = Nullch;
X    goto snarf_it;
X
X    case '"':
X      do_double:
X    term = *s;
X    arg[1].arg_type = A_DOUBLE;
X    makesingle = TRUE;    /* maybe disable runtime scanning */
X    alwaysdollar = TRUE;    /* treat $) and $| as variables */
X    goto snarf_it;
X    case '`':
X      do_back:
X    term = *s;
X    arg[1].arg_type = A_BACKTICK;
X    set_csh();
X    alwaysdollar = TRUE;    /* treat $) and $| as variables */
X      snarf_it:
X    {
X        STR *tmpstr;
X        char *tmps;
X
X        multi_start = line;
X        if (hereis)
X        multi_open = multi_close = '<';
X        else {
X        multi_open = term;
X        if (tmps = index("([{< )]}> )]}>",term))
X            term = tmps[5];
X        multi_close = term;
X        }
X        tmpstr = Str_new(87,0);
X        if (hereis) {
X        term = *tokenbuf;
X        if (!rsfp) {
X            d = s;
X            while (s < bufend &&
X              (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
X            if (*s++ == '\n')
X                line++;
X            }
X            if (s >= bufend) {
X            line = multi_start;
X            fatal("EOF in string");
X            }
X            str_nset(tmpstr,d+1,s-d);
X            s += len - 1;
X            str_ncat(herewas,s,bufend-s);
X            str_replace(linestr,herewas);
X            oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
X            bufend = linestr->str_ptr + linestr->str_cur;
X            hereis = FALSE;
X        }
X        }
X        else
X        s = str_append_till(tmpstr,s+1,bufend,term,leave);
X        while (s >= bufend) {    /* multiple line string? */
X        if (!rsfp ||
X         !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
X            line = multi_start;
X            fatal("EOF in string");
X        }
X        line++;
X        if (perldb) {
X            STR *str = Str_new(88,0);
X
X            str_sset(str,linestr);
X            astore(lineary,(int)line,str);
X        }
X        bufend = linestr->str_ptr + linestr->str_cur;
X        if (hereis) {
X            if (*s == term && bcmp(s,tokenbuf,len) == 0) {
X            s = bufend - 1;
X            *s = ' ';
X            str_scat(linestr,herewas);
X            bufend = linestr->str_ptr + linestr->str_cur;
X            }
X            else {
X            s = bufend;
X            str_scat(tmpstr,linestr);
X            }
X        }
X        else
X            s = str_append_till(tmpstr,s,bufend,term,leave);
X        }
X        multi_end = line;
X        s++;
X        if (tmpstr->str_cur + 5 < tmpstr->str_len) {
X        tmpstr->str_len = tmpstr->str_cur + 1;
X        Renew(tmpstr->str_ptr, tmpstr->str_len, char);
X        }
X        if ((arg[1].arg_type & A_MASK) == A_SINGLE) {
X        arg[1].arg_ptr.arg_str = tmpstr;
X        break;
X        }
X        tmps = s;
X        s = tmpstr->str_ptr;
X        send = s + tmpstr->str_cur;
X        while (s < send) {        /* see if we can make SINGLE */
X        if (*s == '\\' && s[1] && isdigit(s[1]) && !isdigit(s[2]) &&
X          !alwaysdollar )
X            *s = '$';        /* grandfather \digit in subst */
X        if ((*s == '$' || *s == '@') && s+1 < send &&
X          (alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
X            makesingle = FALSE;    /* force interpretation */
X        }
X        else if (*s == '\\' && s+1 < send) {
X            s++;
X        }
X        s++;
X        }
X        s = d = tmpstr->str_ptr;    /* assuming shrinkage only */
X        while (s < send) {
X        if ((*s == '$' && s+1 < send &&
X            (alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) ||
X            (*s == '@' && s+1 < send) ) {
X            len = scanreg(s,bufend,tokenbuf) - s;
X            if (*s == '$' || strEQ(tokenbuf,"ARGV")
X              || strEQ(tokenbuf,"ENV")
X              || strEQ(tokenbuf,"SIG")
X              || strEQ(tokenbuf,"INC") )
X            (void)stabent(tokenbuf,TRUE); /* make sure it exists */
X            while (len--)
X            *d++ = *s++;
X            continue;
X        }
X        else if (*s == '\\' && s+1 < send) {
X            s++;
X            switch (*s) {
X            default:
X            if (!makesingle && (!leave || (*s && index(leave,*s))))
X                *d++ = '\\';
X            *d++ = *s++;
X            continue;
X            case '0': case '1': case '2': case '3':
X            case '4': case '5': case '6': case '7':
X            *d = *s++ - '0';
X            if (s < send && *s && index("01234567",*s)) {
X                *d <<= 3;
X                *d += *s++ - '0';
X            }
X            if (s < send && *s && index("01234567",*s)) {
X                *d <<= 3;
X                *d += *s++ - '0';
X            }
X            d++;
X            continue;
X            case 'b':
X            *d++ = '\b';
X            break;
X            case 'n':
X            *d++ = '\n';
X            break;
X            case 'r':
X            *d++ = '\r';
X            break;
X            case 'f':
X            *d++ = '\f';
X            break;
X            case 't':
X            *d++ = '\t';
X            break;
X            }
X            s++;
X            continue;
X        }
X        *d++ = *s++;
X        }
X        *d = '\0';
X
X        if ((arg[1].arg_type & A_MASK) == A_DOUBLE && makesingle)
X            arg[1].arg_type = A_SINGLE;    /* now we can optimize on it */
X
X        tmpstr->str_u.str_hash = curstash;    /* so interp knows package */
X
X        tmpstr->str_cur = d - tmpstr->str_ptr;
X        arg[1].arg_ptr.arg_str = tmpstr;
X        s = tmps;
X        break;
X    }
X    }
X    if (hereis)
X    str_free(herewas);
X    return s;
X}
X
XFCMD *
Xload_format()
X{
X    FCMD froot;
X    FCMD *flinebeg;
X    register FCMD *fprev = &froot;
X    register FCMD *fcmd;
X    register char *s;
X    register char *t;
X    register STR *str;
X    bool noblank;
X    bool repeater;
X
X    Zero(&froot, 1, FCMD);
X    while ((s = str_gets(linestr,rsfp, 0)) != Nullch) {
X    line++;
X    if (perldb) {
X        STR *tmpstr = Str_new(89,0);
X
X        str_sset(tmpstr,linestr);
X        astore(lineary,(int)line,tmpstr);
X    }
X    bufend = linestr->str_ptr + linestr->str_cur;
X    if (strEQ(s,".\n")) {
X        bufptr = s;
X        return froot.f_next;
X    }
X    if (*s == '#')
X        continue;
X    flinebeg = Nullfcmd;
X    noblank = FALSE;
X    repeater = FALSE;
X    while (s < bufend) {
X        Newz(804,fcmd,1,FCMD);
X        fprev->f_next = fcmd;
X        fprev = fcmd;
X        for (t=s; t < bufend && *t != '@' && *t != '^'; t++) {
X        if (*t == '~') {
X            noblank = TRUE;
X            *t = ' ';
X            if (t[1] == '~') {
X            repeater = TRUE;
X            t[1] = ' ';
X            }
X        }
X        }
X        fcmd->f_pre = nsavestr(s, t-s);
X        fcmd->f_presize = t-s;
X        s = t;
X        if (s >= bufend) {
X        if (noblank)
X            fcmd->f_flags |= FC_NOBLANK;
X        if (repeater)
X            fcmd->f_flags |= FC_REPEAT;
X        break;
X        }
X        if (!flinebeg)
X        flinebeg = fcmd;        /* start values here */
X        if (*s++ == '^')
X        fcmd->f_flags |= FC_CHOP;    /* for doing text filling */
X        switch (*s) {
X        case '*':
X        fcmd->f_type = F_LINES;
X        *s = '\0';
X        break;
X        case '<':
X        fcmd->f_type = F_LEFT;
X        while (*s == '<')
X            s++;
X        break;
X        case '>':
X        fcmd->f_type = F_RIGHT;
X        while (*s == '>')
X            s++;
X        break;
X        case '|':
X        fcmd->f_type = F_CENTER;
X        while (*s == '|')
X            s++;
X        break;
X        default:
X        fcmd->f_type = F_LEFT;
X        break;
X        }
X        if (fcmd->f_flags & FC_CHOP && *s == '.') {
X        fcmd->f_flags |= FC_MORE;
X        while (*s == '.')
X            s++;
X        }
X        fcmd->f_size = s-t;
X    }
X    if (flinebeg) {
X      again:
X        if ((s = str_gets(linestr, rsfp, 0)) == Nullch)
X        goto badform;
X        line++;
X        if (perldb) {
X        STR *tmpstr = Str_new(90,0);
X
X        str_sset(tmpstr,linestr);
X        astore(lineary,(int)line,tmpstr);
X        }
X        if (strEQ(s,".\n")) {
X        bufptr = s;
X        yyerror("Missing values line");
X        return froot.f_next;
X        }
X        if (*s == '#')
X        goto again;
X        bufend = linestr->str_ptr + linestr->str_cur;
X        str = flinebeg->f_unparsed = Str_new(91,bufend - bufptr);
X        str->str_u.str_hash = curstash;
X        str_nset(str,"(",1);
X        flinebeg->f_line = line;
X        if (!flinebeg->f_next->f_type || index(linestr->str_ptr, ',')) {
X        str_scat(str,linestr);
X        str_ncat(str,",$$);",5);
X        }
X        else {
X        while (s < bufend && isspace(*s))
X            s++;
X        t = s;
X        while (s < bufend) {
X            switch (*s) {
X            case ' ': case '\t': case '\n': case ';':
X            str_ncat(str, t, s - t);
X            str_ncat(str, "," ,1);
X            while (s < bufend && (isspace(*s) || *s == ';'))
X                s++;
X            t = s;
X            break;
X            case '$':
X            str_ncat(str, t, s - t);
X            t = s;
X            s = scanreg(s,bufend,tokenbuf);
X            str_ncat(str, t, s - t);
X            t = s;
X            if (s < bufend && *s && index("$'\"",*s))
X                str_ncat(str, ",", 1);
X            break;
X            case '"': case '\'':
X            str_ncat(str, t, s - t);
X            t = s;
X            s++;
X            while (s < bufend && (*s != *t || s[-1] == '\\'))
X                s++;
X            if (s < bufend)
X                s++;
X            str_ncat(str, t, s - t);
X            t = s;
X            if (s < bufend && *s && index("$'\"",*s))
X                str_ncat(str, ",", 1);
X            break;
X            default:
X            yyerror("Please use commas to separate fields");
X            }
X        }
X        str_ncat(str,"$$);",4);
X        }
X    }
X    }
X  badform:
X    bufptr = str_get(linestr);
X    yyerror("Format not terminated");
X    return froot.f_next;
X}
X
Xset_csh()
X{
X    if (!csh) {
X    if (stat("/bin/csh",&statbuf) < 0)
X        csh = -1;
X    else
X        csh = 1;
X    }
X}
!STUFFY!FUNK!
echo ""
echo "End of kit 5 (of 24)"
cat /dev/null >kit5isdone
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