lwall@netlabs.com (Larry Wall) (04/15/91)
Submitted-by: Larry Wall <lwall@netlabs.com>
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: kent@sparky.IMD.Sterling.COM
Sterling Software, IMD UUCP: uunet!sparky!kent
Phone: (402) 291-8300 FAX: (402) 291-4362
Please send comp.sources.misc-related mail to kent@uunet.uu.net.