Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/misc/volume18/perl/part04

Internet Message Format | 1991-04-14 | 52KB

From: [e-mail] (Larry Wall)
Newsgroups: comp.sources.misc
Subject: v18i022:  perl - The perl programming language, Part04/36
Message-ID: <[e-mail]>
Date: 15 Apr 91 01:53:09 GMT
Approved: [e-mail]
X-Checksum-Snefru: 7c482965 95799938 b0e3475e 84a04b12

Submitted-by: Larry Wall <[e-mail]>
Posting-number: Volume 18, Issue 22
Archive-name: perl/part04

[There are 36 kits for perl version 4.0.]

#! /bin/sh

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

echo "This is perl 4.0 kit 4 (of 36).  If kit 4 is complete, the line"
echo '"'"End of kit 4 (of 36)"'" 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:AA
sed >toke.c:AA <<'!STUFFY!FUNK!' -e 's/X//'
X/* $RCSfile: toke.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:18:18 $
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 4.0.1.1  91/04/12  09:18:18  lwall
X * patch1: perl -de "print" wouldn't stop at the first statement
X *
X * Revision 4.0  91/03/20  01:42:14  lwall
X * 4.0 baseline.
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X#include "perly.h"
X
X#ifdef I_FCNTL
X#include <fcntl.h>
X#endif
X#ifdef I_SYS_FILE
X#include <sys/file.h>
X#endif
X
X/* which backslash sequences to keep in m// or s// */
X
Xstatic char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtf0123456789[{]}";
X
Xchar *reparse;        /* if non-null, scanident found ${foo[$bar]} */
X
Xvoid checkcomma();
X
X#ifdef CLINE
X#undef CLINE
X#endif
X#define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_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 FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x)
X#define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
X#define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4)
X#define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5)
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 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(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
X    (*s = META('('), bufptr = oldbufptr, '(') : \
X    (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
X/* grandfather return to old style */
X#define OLDLOP(f) return(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
X#ifdef CRIPPLED_CC
X
X#undef UNI
X#undef LOP
X#define UNI(f) return uni(f,s)
X#define LOP(f) return lop(f,s)
X
Xint
Xuni(f,s)
Xint f;
Xchar *s;
X{
X    yylval.ival = f;
X    expectterm = TRUE;
X    bufptr = s;
X    if (*s == '(')
X    return FUNC1;
X    s = skipspace(s);
X    if (*s == '(')
X    return FUNC1;
X    else
X    return UNIOP;
X}
X
Xint
Xlop(f,s)
Xint f;
Xchar *s;
X{
X    CLINE;
X    if (*s != '(')
X    s = skipspace(s);
X    if (*s == '(') {
X    *s = META('(');
X    bufptr = oldbufptr;
X    return '(';
X    }
X    else {
X    yylval.ival=f;
X    expectterm = TRUE;
X    bufptr = s;
X    return LISTOP;
X    }
X}
X
X#endif /* CRIPPLED_CC */
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 (debug & 1)
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#ifdef BADSWITCH
X    if (*s & 128) {
X    if ((*s & 127) == '(')
X        *s++ = '(';
X    else
X        warn("Unrecognized character \\%03o ignored", *s++ & 255);
X    goto retry;
X    }
X#endif
X    switch (*s) {
X    default:
X    if ((*s & 127) == '(')
X        *s++ = '(';
X    else
X        warn("Unrecognized character \\%03o ignored", *s++ & 255);
X    goto retry;
X    case 4:
X    case 26:
X    goto fake_eof;            /* emulate EOF on ^D or ^Z */
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            char *getenv();
X            char *pdb = getenv("PERLDB");
X
X            str_cat(linestr, pdb ? pdb : "require 'perldb.pl'");
X            str_cat(linestr, ";");
X        }
X        if (minus_n || minus_p) {
X            str_cat(linestr,"line: while (<>) {");
X            if (minus_l)
X            str_cat(linestr,"chop;");
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        bufptr = bufend;
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        OPERATOR(FORMLIST);
X    }
X    curcmd->c_line++;
X#ifdef CRYPTSCRIPT
X    cryptswitch();
X#endif /* CRYPTSCRIPT */
X    do {
X        if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
X          fake_eof:
X        if (rsfp) {
X            if (preprocess)
X            (void)mypclose(rsfp);
X            else if (rsfp == stdin)
X            clearerr(stdin);
X            else
X            (void)fclose(rsfp);
X            rsfp = Nullfp;
X        }
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            minus_n = minus_p = 0;
X            goto retry;
X        }
X        oldoldbufptr = oldbufptr = s = str_get(linestr);
X        str_set(linestr,"");
X        RETURN(';');    /* not infinite loop because rsfp is NULL now */
X        }
X        if (doextract && *linestr->str_ptr == '#')
X        doextract = FALSE;
X    } while (doextract);
X    oldoldbufptr = oldbufptr = bufptr = s;
X    if (perldb) {
X        STR *str = Str_new(85,0);
X
X        str_sset(str,linestr);
X        astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_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    if (curcmd->c_line == 1) {
X        if (*s == '#' && s[1] == '!') {
X        if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
X            char **newargv;
X            char *cmd;
X
X            s += 2;
X            if (*s == ' ')
X            s++;
X            cmd = s;
X            while (s < bufend && !isspace(*s))
X            s++;
X            *s++ = '\0';
X            while (s < bufend && isspace(*s))
X            s++;
X            if (s < bufend) {
X            Newz(899,newargv,origargc+3,char*);
X            newargv[1] = s;
X            while (s < bufend && !isspace(*s))
X                s++;
X            *s = '\0';
X            Copy(origargv+1, newargv+2, origargc+1, char*);
X            }
X            else
X            newargv = origargv;
X            newargv[0] = cmd;
X            execv(cmd,newargv);
X            fatal("Can't exec %s", cmd);
X        }
X        }
X        else {
X        while (s < bufend && isspace(*s))
X            s++;
X        if (*s == ':')    /* for csh's that have to exec sh scripts */
X            s++;
X        }
X    }
X    goto retry;
X    case ' ': case '\t': case '\f': case '\r': case 013:
X    s++;
X    goto retry;
X    case '#':
X    if (preprocess && s == str_get(linestr) &&
X           s[1] == ' ' && isdigit(s[2])) {
X        curcmd->c_line = atoi(s+2)-1;
X        for (s += 2; isdigit(*s); s++) ;
X        d = bufend;
X        while (s < d && isspace(*s)) s++;
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        curcmd->c_filestab = fstab(s);
X        else
X        curcmd->c_filestab = fstab(origfilename);
X        oldoldbufptr = oldbufptr = s = str_get(linestr);
X    }
X    /* FALL THROUGH */
X    case '\n':
X    if (in_eval && !rsfp) {
X        d = bufend;
X        while (s < d && *s != '\n')
X        s++;
X        if (s < d)
X        s++;
X        if (perldb) {
X        STR *str = Str_new(85,0);
X
X        str_nset(str,linestr->str_ptr, s - linestr->str_ptr);
X        astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
X        str_chop(linestr, s);
X        }
X        if (in_format) {
X        bufptr = s;
X        yylval.formval = load_format();
X        in_format = FALSE;
X        oldoldbufptr = oldbufptr = s = bufptr + 1;
X        TERM(FORMLIST);
X        }
X        curcmd->c_line++;
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        case 'M': stabent("\024",TRUE); FTST(O_FTMTIME);
X        case 'A': stabent("\024",TRUE); FTST(O_FTATIME);
X        case 'C': stabent("\024",TRUE); FTST(O_FTCTIME);
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 = scanident(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 = scanident(s,bufend,tokenbuf);
X        yylval.stabval = hadd(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 (curcmd->c_line < cmdline)
X        cmdline = curcmd->c_line;
X    tmp = *s++;
X    OPERATOR(tmp);
X    case ')':
X    case ']':
X    tmp = *s++;
X    TERM(tmp);
X    case '}':
X    tmp = *s++;
X    RETURN(tmp);
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        tmp = *s++;
X        if (tmp == '>')
X        EOP(O_NCMP);
X        s--;
X        ROP(O_LE);
X    }
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    while (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 = scanident(s,bufend,tokenbuf);
X        yylval.stabval = aadd(stabent(tokenbuf,TRUE));
X        TERM(ARYLEN);
X    }
X    d = s;
X    s = scanident(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 = scanident(s,bufend,tokenbuf);
X    if (reparse)
X        goto do_reparse;
X    yylval.stabval = aadd(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    if (d[1] == '_') {
X        if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) {
X        ARG *arg = op_new(1);
X
X        yylval.arg = arg;
X        arg->arg_type = O_ITEM;
X        if (d[2] == 'L')
X            (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line);
X        else
X            strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr);
X        arg[1].arg_type = A_SINGLE;
X        arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
X        TERM(RSTRING);
X        }
X        else if (strEQ(d,"__END__")) {
X#ifndef TAINT
X        STAB *stab;
X        int fd;
X
X        if (stab = stabent("DATA",FALSE)) {
X            stab->str_pok |= SP_MULTI;
X            stab_io(stab) = stio_new();
X            stab_io(stab)->ifp = rsfp;
X#if defined(HAS_FCNTL) && defined(F_SETFD)
X            fd = fileno(rsfp);
X            fcntl(fd,F_SETFD,fd >= 3);
X#endif
X            if (preprocess)
X            stab_io(stab)->type = '|';
X            else if (rsfp == stdin)
X            stab_io(stab)->type = '-';
X            else
X            stab_io(stab)->type = '<';
X            rsfp = Nullfp;
X        }
X#endif
X        goto fake_eof;
X        }
X    }
X    break;
X    case 'a': case 'A':
X    SNARFWORD;
X    if (strEQ(d,"alarm"))
X        UNI(O_ALARM);
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    if (strEQ(d,"binmode"))
X        FOP(O_BINMODE);
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        (void)stabent("ENV",TRUE);    /* may use HOME */
X        UNI(O_CHDIR);
X    }
X    if (strEQ(d,"close"))
X        FOP(O_CLOSE);
X    if (strEQ(d,"closedir"))
X        FOP(O_CLOSEDIR);
X    if (strEQ(d,"cmp"))
X        EOP(O_SCMP);
X    if (strEQ(d,"caller"))
X        UNI(O_CALLER);
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 = curcmd->c_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_OP);
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") || strEQ(d,"foreach")) {
X        yylval.ival = curcmd->c_line;
X        OPERATOR(FOR);
X    }
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 = curcmd->c_line;
X        OPERATOR(IF);
X    }
X    if (strEQ(d,"index"))
X        FUN2x(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    if (s[1] == '\'') {
X        d = "m";
X        s++;
X    }
X    else {
X        SNARFWORD;
X    }
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    switch (d[1]) {
X    case 'k':
X        if (strEQ(d,"mkdir"))
X        FUN2(O_MKDIR);
X        break;
X    case 's':
X        if (strEQ(d,"msgctl"))
X        FUN3(O_MSGCTL);
X        if (strEQ(d,"msgget"))
X        FUN2(O_MSGGET);
X        if (strEQ(d,"msgrcv"))
X        FUN5(O_MSGRCV);
X        if (strEQ(d,"msgsnd"))
X        FUN3(O_MSGSND);
X        break;
X    }
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    if (strEQ(d,"pipe"))
X        FOP22(O_PIPE);
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    if (strEQ(d,"qx")) {
X        s = scanstr(s-2);
X        TERM(RSTRING);
X    }
X    break;
X    case 'r': case 'R':
X    SNARFWORD;
X    if (strEQ(d,"return"))
X        OLDLOP(O_RETURN);
X    if (strEQ(d,"require")) {
X        allstabs = TRUE;        /* must initialize everything since */
X        UNI(O_REQUIRE);        /* we don't know what will be used */
X    }
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        FUN2x(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    if (s[1] == '\'') {
X        d = "s";
X        s++;
X    }
X    else {
X        SNARFWORD;
X    }
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        break;
X    case 'c':
X        if (strEQ(d,"scalar"))
X        UNI(O_SCALAR);
X        break;
X    case 'd':
X        break;
X    case 'e':
X        if (strEQ(d,"select"))
X        OPERATOR(SSELECT);
X        if (strEQ(d,"seek"))
X        FOP3(O_SEEK);
X        if (strEQ(d,"semctl"))
X        FUN4(O_SEMCTL);
X        if (strEQ(d,"semget"))
X        FUN3(O_SEMGET);
X        if (strEQ(d,"semop"))
X        FUN2(O_SEMOP);
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,"shmctl"))
X        FUN3(O_SHMCTL);
X        if (strEQ(d,"shmget"))
X        FUN3(O_SHMGET);
X        if (strEQ(d,"shmread"))
X        FUN4(O_SHMREAD);
X        if (strEQ(d,"shmwrite"))
X        FUN4(O_SHMWRITE);
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_SOCKPAIR);
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            strncpy(tokenbuf,s,d-s);
X            if (strNE(tokenbuf,"keys") &&
X            strNE(tokenbuf,"values") &&
X            strNE(tokenbuf,"split") &&
X            strNE(tokenbuf,"grep") &&
X            strNE(tokenbuf,"readdir") &&
X            strNE(tokenbuf,"unpack") &&
X            strNE(tokenbuf,"do") &&
X            (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        if (strEQ(d,"splice")) {
X        yylval.ival = O_SPLICE;
X        OPERATOR(PUSH);
X        }
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        FUN2x(O_SUBSTR);
X        if (strEQ(d,"sub")) {
X        subline = curcmd->c_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        if (strEQ(d,"sysread"))
X        FOP3(O_SYSREAD);
X        if (strEQ(d,"syswrite"))
X        FOP3(O_SYSWRITE);
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    if (strEQ(d,"truncate"))
X        FOP2(O_TRUNCATE);
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 = curcmd->c_line;
X        OPERATOR(UNTIL);
X    }
X    if (strEQ(d,"unless")) {
X        yylval.ival = curcmd->c_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 = curcmd->c_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,"waitpid"))
X        FUN2(O_WAITPID);
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    if (s[1] == '\'') {
X        d = "y";
X        s++;
X    }
X    else {
X        SNARFWORD;
X    }
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
Xvoid
Xcheckcomma(s,what)
Xregister char *s;
Xchar *what;
X{
X    char *someword;
X
X    if (*s == '(')
X    s++;
X    while (s < bufend && isascii(*s) && isspace(*s))
X    s++;
X    if (isascii(*s) && (isalpha(*s) || *s == '_')) {
X    someword = s++;
X    while (isalpha(*s) || isdigit(*s) || *s == '_')
X        s++;
X    while (s < bufend && isspace(*s))
X        s++;
X    if (*s == ',') {
X        *s = '\0';
X        someword = instr(
X          "tell eof times getlogin wait length shift umask getppid \
X          cos exp int log rand sin sqrt ord wantarray",
X          someword);
X        *s = ',';
X        if (someword)
X        return;
X        fatal("No comma allowed after %s", what);
X    }
X    }
X}
X
Xchar *
Xscanident(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    while (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 == '^' && (isupper(*s) || index("[\\]^_?",*s)))
X    *d = *s++ ^ 64;
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("wWbB0123456789sSdDlLuUE",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        case 'e':
X        *d = '\033';
X        break;
X        case 'a':
X        *d = '\007';
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    STR *str = Str_new(93,0);
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 = str_append_till(str,s,bufend,s[-1],patleave);
X    if (s >= bufend) {
X    str_free(str);
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    len = str->str_cur;
X    e = str->str_ptr + len;
X    for (d = str->str_ptr; d < e; d++) {
X    if (*d == '\\')
X        d++;
X    else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
X         (*d == '@')) {
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_smake(str);
X        d = scanident(d,bufend,buf);
X        (void)stabent(buf,TRUE);        /* make sure it's created */
X        for (; d < e; d++) {
X        if (*d == '\\')
X            d++;
X        else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') {
X            d = scanident(d,bufend,buf);
X            (void)stabent(buf,TRUE);
X        }
X        else if (*d == '@') {
X            d = scanident(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 (*str->str_ptr == '^') {
X    spat->spat_short = scanconst(str->str_ptr+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(str->str_ptr,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(str->str_ptr,str->str_ptr+len,
X        spat->spat_flags & SPAT_FOLD);
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(str->str_ptr,str->str_ptr+len,
X        spat->spat_flags & SPAT_FOLD);
X    hoistmust(spat);
X    }
X  got_pat:
X    str_free(str);
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    STR *str = Str_new(93,0);
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 = str_append_till(str,s+1,bufend,*s,patleave);
X    if (s >= bufend) {
X    str_free(str);
X    yyerror("Substitution pattern not terminated");
X    yylval.arg = Nullarg;
X    return s;
X    }
X    len = str->str_cur;
X    e = str->str_ptr + len;
X    for (d = str->str_ptr; d < e; d++) {
X    if (*d == '\\')
X        d++;
X    else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') ||
X        *d == '@' ) {
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_smake(str);
X        d = scanident(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 = scanident(d,bufend,buf);
X            (void)stabent(buf,TRUE);
X        }
X        else if (*d == '@' && d[-1] != '\\') {
X            d = scanident(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 (*str->str_ptr == '^') {
X    spat->spat_short = scanconst(str->str_ptr+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(str->str_ptr,len);
X    if (spat->spat_short)
X        spat->spat_slen = spat->spat_short->str_cur;
X    }
Xget_repl:
X    s = scanstr(s);
X    if (s >= bufend) {
X    str_free(str);
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          (t[1] == '{' /*}*/ && isdigit(t[2])) ))
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 = 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(str->str_ptr,str->str_ptr+len,
X      spat->spat_flags & SPAT_FOLD);
X    hoistmust(spat);
X    }
X    yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
X    str_free(str);
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[520];
X    register char *d = t;
X    register int i;
X    register char *send = s + len;
X
X    while (s < send && d - t <= 256) {
X    if (s[1] == '-' && s+2 < send) {
X        for (i = (s[0] & 0377); i <= (s[2] & 0377); 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 short *tbl;
X    register int i;
X    register int j;
X    int tlen, rlen;
X    int squash;
X    int delete;
X    int complement;
X
X    New(803,tbl,256,short);
X    arg[2].arg_type = A_NULL;
X    arg[2].arg_ptr.arg_cval = (char*) 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    arg_free(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    complement = delete = squash = 0;
X    while (*s == 'c' || *s == 'd' || *s == 's') {
X    if (*s == 'c')
X        complement = 1;
X    else if (*s == 'd')
X        delete = 2;
X    else
X        squash = 1;
X    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    arg_free(yylval.arg);
X    arg[2].arg_len = delete|squash;
X    yylval.arg = arg;
X    if (!rlen && !delete) {
X    Safefree(r);
X    r = t; rlen = tlen;
X    }
X    if (complement) {
X    Zero(tbl, 256, short);
X    for (i = 0; i < tlen; i++)
X        tbl[t[i] & 0377] = -1;
X    for (i = 0, j = 0; i < 256; i++) {
X        if (!tbl[i]) {
X        if (j >= rlen) {
X            if (delete)
X            tbl[i] = -2;
X            else
X            tbl[i] = r[j-1];
X        }
X        else
X            tbl[i] = r[j++];
X        }
X    }
X    }
X    else {
X    for (i = 0; i < 256; i++)
X        tbl[i] = -1;
X    for (i = 0, j = 0; i < tlen; i++,j++) {
X        if (j >= rlen) {
X        if (delete) {
X            if (tbl[t[i] & 0377] == -1)
X            tbl[t[i] & 0377] = -2;
X            continue;
X        }
X        --j;
X        }
X        if (tbl[t[i] & 0377] == -1)
X        tbl[t[i] & 0377] = r[j] & 0377;
X    }
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    STR *str;
X    char *leave = "\\$@nrtfbeacx0123456789[{]}lLuUE"; /* 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        unsigned 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        str = Str_new(92,0);
X        str_numset(str,(double)i);
X        if (str->str_ptr) {
X        Safefree(str->str_ptr);
X        str->str_ptr = Nullch;
X        str->str_len = str->str_cur = 0;
X        }
X        arg[1].arg_ptr.arg_str = 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    str = Str_new(92,0);
X    str_numset(str,atof(tokenbuf));
X    if (str->str_ptr) {
X        Safefree(str->str_ptr);
X        str->str_ptr = Nullch;
X        str->str_len = str->str_cur = 0;
X    }
X    arg[1].arg_ptr.arg_str = 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        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        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    if (*s == 'x') {
X        s++;
X        goto do_back;
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 = curcmd->c_line;
X        if (hereis)
X        multi_open = multi_close = '<';
X        else {
X        multi_open = term;
X        if (term && (tmps = index("([{< )]}> )]}>",term)))
X            term = tmps[5];
X        multi_close = term;
X        }
X        tmpstr = Str_new(87,80);
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                curcmd->c_line++;
X            }
X            if (s >= bufend) {
X            curcmd->c_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);
!STUFFY!FUNK!
echo " "
echo "End of kit 4 (of 36)"
cat /dev/null >kit4isdone
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 25 26 27 28 29 30 31 32 33 34 35 36; 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."
    for combo in *:AA; do
        if test -f "$combo"; then
        realfile=`basename $combo :AA`
        cat $realfile:[A-Z][A-Z] >$realfile
        rm -rf $realfile:[A-Z][A-Z]
        fi
    done
    rm -rf kit*isdone
    chmod 755 Configure
    ;;
    *)  echo "You have run$run."
    echo "You still need to run$todo."
    ;;
esac
: Someone might mail this, so...
exit

exit 0 # Just in case...
--
Kent Landfield                   INTERNET: [e-mail]
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    [phone]         FAX:      [phone]
Please send comp.sources.misc-related mail to [e-mail].