lwall@jato.Jpl.Nasa.Gov (Larry Wall) (09/03/89)
#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 23 through sh. When all 23 kits have been run, read README.
echo "This is perl 3.0 kit 4 (of 23). If kit 4 is complete, the line"
echo '"'"End of kit 4 (of 23)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir 2>/dev/null
echo Extracting toke.c
sed >toke.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: toke.c,v 2.0.1.7 88/11/22 01:20:15 lwall Locked $
X *
X * Copyright (c) 1989, Larry Wall
X *
X * You may distribute under the terms of the GNU General Public License
X * as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log: toke.c,v $
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X#include "perly.h"
X
X#define CLINE (cmdline = (line < cmdline ? line : cmdline))
X
X#define META(c) ((c) | 128)
X
X#define RETURN(retval) return (bufptr = s,(int)retval)
X#define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
X#define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
X#define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
X#define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
X#define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
X#define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
X#define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
X#define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
X#define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
X#define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
X#define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
X#define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
X#define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
X#define LFUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)LFUNC4)
X#define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
X#define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
X#define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
X#define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
X#define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
X#define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
X#define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
X#define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
X#define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
X#define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
X
X/* This bit of chicanery makes a unary function immediately 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 == '(' ? (int)FUNC1 : (int)UNIOP) )
X
X/* This does similarly for list operators, merely by pretending that the
X * paren came before the listop rather than after.
X */
X#define LOP(f) return(*s == '(' ? \
X (*s = META('('), bufptr = oldbufptr, '(') : \
X (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
X
Xyylex()
X{
X register char *s = bufptr;
X register char *d;
X register int tmp;
X static bool in_format = FALSE;
X static bool firstline = TRUE;
X extern int yychar; /* last token */
X
X oldoldbufptr = oldbufptr;
X oldbufptr = s;
X
X retry:
X#ifdef YYDEBUG
X if (yydebug)
X if (index(s,'\n'))
X fprintf(stderr,"Tokener at %s",s);
X else
X fprintf(stderr,"Tokener at %s\n",s);
X#endif
X switch (*s) {
X default:
X if ((*s & 127) == '(')
X *s++ = '(';
X else
X warn("Unrecognized character \\%03o ignored", *s++);
X goto retry;
X case 0:
X if (!rsfp)
X RETURN(0);
X if (s++ < bufend)
X goto retry; /* ignore stray nulls */
X if (firstline) {
X firstline = FALSE;
X if (minus_n || minus_p || perldb) {
X str_set(linestr,"");
X if (perldb)
X str_cat(linestr,"do 'perldb.pl'; print $@;");
X if (minus_n || minus_p) {
X str_cat(linestr,"line: while (<>) {");
X if (minus_a)
X str_cat(linestr,"@F=split(' ');");
X }
X oldoldbufptr = oldbufptr = s = str_get(linestr);
X bufend = linestr->str_ptr + linestr->str_cur;
X goto retry;
X }
X }
X if (in_format) {
X yylval.formval = load_format();
X in_format = FALSE;
X oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
X bufend = linestr->str_ptr + linestr->str_cur;
X TERM(FORMLIST);
X }
X line++;
X if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
X if (preprocess)
X (void)mypclose(rsfp);
X else if (rsfp != stdin)
X (void)fclose(rsfp);
X rsfp = Nullfp;
X if (minus_n || minus_p) {
X str_set(linestr,minus_p ? "}continue{print;" : "");
X str_cat(linestr,"}");
X oldoldbufptr = oldbufptr = s = str_get(linestr);
X bufend = linestr->str_ptr + linestr->str_cur;
X goto retry;
X }
X oldoldbufptr = oldbufptr = s = str_get(linestr);
X str_set(linestr,"");
X RETURN(0);
X }
X oldoldbufptr = oldbufptr = bufptr = s;
X if (perldb) {
X STR *str = str_new(0);
X
X str_sset(str,linestr);
X astore(lineary,(int)line,str);
X }
X#ifdef DEBUG
X if (firstline) {
X char *showinput();
X s = showinput();
X }
X#endif
X bufend = linestr->str_ptr + linestr->str_cur;
X firstline = FALSE;
X goto retry;
X case ' ': case '\t': case '\f':
X s++;
X goto retry;
X case '\n':
X case '#':
X if (preprocess && s == str_get(linestr) &&
X s[1] == ' ' && isdigit(s[2])) {
X line = atoi(s+2)-1;
X for (s += 2; isdigit(*s); s++) ;
X d = bufend;
X while (s < d && isspace(*s)) s++;
X if (filename)
X Safefree(filename);
X s[strlen(s)-1] = '\0'; /* wipe out newline */
X if (*s == '"') {
X s++;
X s[strlen(s)-1] = '\0'; /* wipe out trailing quote */
X }
X if (*s)
X filename = savestr(s);
X else
X filename = savestr(origfilename);
X oldoldbufptr = oldbufptr = s = str_get(linestr);
X }
X if (in_eval && !rsfp) {
X d = bufend;
X while (s < d && *s != '\n')
X s++;
X if (s < d) {
X s++;
X line++;
X }
X }
X else {
X *s = '\0';
X bufend = s;
X }
X goto retry;
X case '-':
X if (s[1] && isalpha(s[1]) && !isalpha(s[2])) {
X s++;
X switch (*s++) {
X case 'r': FTST(O_FTEREAD);
X case 'w': FTST(O_FTEWRITE);
X case 'x': FTST(O_FTEEXEC);
X case 'o': FTST(O_FTEOWNED);
X case 'R': FTST(O_FTRREAD);
X case 'W': FTST(O_FTRWRITE);
X case 'X': FTST(O_FTREXEC);
X case 'O': FTST(O_FTROWNED);
X case 'e': FTST(O_FTIS);
X case 'z': FTST(O_FTZERO);
X case 's': FTST(O_FTSIZE);
X case 'f': FTST(O_FTFILE);
X case 'd': FTST(O_FTDIR);
X case 'l': FTST(O_FTLINK);
X case 'p': FTST(O_FTPIPE);
X case 'S': FTST(O_FTSOCK);
X case 'u': FTST(O_FTSUID);
X case 'g': FTST(O_FTSGID);
X case 'k': FTST(O_FTSVTX);
X case 'b': FTST(O_FTBLK);
X case 'c': FTST(O_FTCHR);
X case 't': FTST(O_FTTTY);
X case 'T': FTST(O_FTTEXT);
X case 'B': FTST(O_FTBINARY);
X default:
X s -= 2;
X break;
X }
X }
X tmp = *s++;
X if (*s == tmp) {
X s++;
X RETURN(DEC);
X }
X if (expectterm)
X OPERATOR('-');
X else
X AOP(O_SUBTRACT);
X case '+':
X tmp = *s++;
X if (*s == tmp) {
X s++;
X RETURN(INC);
X }
X if (expectterm)
X OPERATOR('+');
X else
X AOP(O_ADD);
X
X case '*':
X if (expectterm) {
X s = scanreg(s,bufend,tokenbuf);
X yylval.stabval = stabent(tokenbuf,TRUE);
X TERM(STAR);
X }
X tmp = *s++;
X if (*s == tmp) {
X s++;
X OPERATOR(POW);
X }
X MOP(O_MULTIPLY);
X case '%':
X if (expectterm) {
X s = scanreg(s,bufend,tokenbuf);
X yylval.stabval = stabent(tokenbuf,TRUE);
X TERM(HSH);
X }
X s++;
X MOP(O_MODULO);
X
X case '^':
X case '~':
X case '(':
X case ',':
X case ':':
X case '[':
X tmp = *s++;
X OPERATOR(tmp);
X case '{':
X tmp = *s++;
X if (isspace(*s) || *s == '#')
X cmdline = NOLINE; /* invalidate current command line number */
X OPERATOR(tmp);
X case ';':
X if (line < cmdline)
X cmdline = line;
X tmp = *s++;
X OPERATOR(tmp);
X case ')':
X case ']':
X tmp = *s++;
X TERM(tmp);
X case '}':
X tmp = *s++;
X for (d = s; *d == ' ' || *d == '\t'; d++) ;
X if (*d == '\n' || *d == '#')
X OPERATOR(tmp); /* block end */
X else
X TERM(tmp); /* associative array end */
X case '&':
X s++;
X tmp = *s++;
X if (tmp == '&')
X OPERATOR(ANDAND);
X s--;
X if (expectterm) {
X d = bufend;
X while (s < d && isspace(*s))
X s++;
X if (isalpha(*s) || *s == '_' || *s == '\'')
X *(--s) = '\\'; /* force next ident to WORD */
X OPERATOR(AMPER);
X }
X OPERATOR('&');
X case '|':
X s++;
X tmp = *s++;
X if (tmp == '|')
X OPERATOR(OROR);
X s--;
X OPERATOR('|');
X case '=':
X s++;
X tmp = *s++;
X if (tmp == '=')
X EOP(O_EQ);
X if (tmp == '~')
X OPERATOR(MATCH);
X s--;
X OPERATOR('=');
X case '!':
X s++;
X tmp = *s++;
X if (tmp == '=')
X EOP(O_NE);
X if (tmp == '~')
X OPERATOR(NMATCH);
X s--;
X OPERATOR('!');
X case '<':
X if (expectterm) {
X s = scanstr(s);
X TERM(RSTRING);
X }
X s++;
X tmp = *s++;
X if (tmp == '<')
X OPERATOR(LS);
X if (tmp == '=')
X ROP(O_LE);
X s--;
X ROP(O_LT);
X case '>':
X s++;
X tmp = *s++;
X if (tmp == '>')
X OPERATOR(RS);
X if (tmp == '=')
X ROP(O_GE);
X s--;
X ROP(O_GT);
X
X#define SNARFWORD \
X d = tokenbuf; \
X while (isascii(*s) && \
X (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')) \
X *d++ = *s++; \
X if (d[-1] == '\'') \
X d--,s--; \
X *d = '\0'; \
X d = tokenbuf;
X
X case '$':
X if (s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) {
X s++;
X s = scanreg(s,bufend,tokenbuf);
X yylval.stabval = aadd(stabent(tokenbuf,TRUE));
X TERM(ARYLEN);
X }
X s = scanreg(s,bufend,tokenbuf);
X yylval.stabval = stabent(tokenbuf,TRUE);
X TERM(REG);
X
X case '@':
X s = scanreg(s,bufend,tokenbuf);
X yylval.stabval = stabent(tokenbuf,TRUE);
X TERM(ARY);
X
X case '/': /* may either be division or pattern */
X case '?': /* may either be conditional or pattern */
X if (expectterm) {
X s = scanpat(s);
X TERM(PATTERN);
X }
X tmp = *s++;
X if (tmp == '/')
X MOP(O_DIVIDE);
X OPERATOR(tmp);
X
X case '.':
X if (!expectterm || !isdigit(s[1])) {
X tmp = *s++;
X if (*s == tmp) {
X s++;
X OPERATOR(DOTDOT);
X }
X AOP(O_CONCAT);
X }
X /* FALL THROUGH */
X case '0': case '1': case '2': case '3': case '4':
X case '5': case '6': case '7': case '8': case '9':
X case '\'': case '"': case '`':
X s = scanstr(s);
X TERM(RSTRING);
X
X case '\\': /* some magic to force next word to be a WORD */
X s++; /* used by do and sub to force a separate namespace */
X /* FALL THROUGH */
X case '_':
X SNARFWORD;
X break;
X case 'a': case 'A':
X SNARFWORD;
X if (strEQ(d,"accept"))
X FOP22(O_ACCEPT);
X if (strEQ(d,"atan2"))
X FUN2(O_ATAN2);
X break;
X case 'b': case 'B':
X SNARFWORD;
X if (strEQ(d,"bind"))
X FOP2(O_BIND);
X break;
X case 'c': case 'C':
X SNARFWORD;
X if (strEQ(d,"chop"))
X LFUN(O_CHOP);
X if (strEQ(d,"continue"))
X OPERATOR(CONTINUE);
X if (strEQ(d,"chdir"))
X UNI(O_CHDIR);
X if (strEQ(d,"close"))
X FOP(O_CLOSE);
X if (strEQ(d,"crypt")) {
X#ifdef FCRYPT
X init_des();
X#endif
X FUN2(O_CRYPT);
X }
X if (strEQ(d,"chmod"))
X LOP(O_CHMOD);
X if (strEQ(d,"chown"))
X LOP(O_CHOWN);
X if (strEQ(d,"connect"))
X FOP2(O_CONNECT);
X if (strEQ(d,"cos"))
X UNI(O_COS);
X if (strEQ(d,"chroot"))
X UNI(O_CHROOT);
X break;
X case 'd': case 'D':
X SNARFWORD;
X if (strEQ(d,"do")) {
X d = bufend;
X while (s < d && isspace(*s))
X s++;
X if (isalpha(*s) || *s == '_')
X *(--s) = '\\'; /* force next ident to WORD */
X OPERATOR(DO);
X }
X if (strEQ(d,"die"))
X LOP(O_DIE);
X if (strEQ(d,"defined"))
X LFUN(O_DEFINED);
X if (strEQ(d,"delete"))
X OPERATOR(DELETE);
X if (strEQ(d,"dbmopen"))
X HFUN3(O_DBMOPEN);
X if (strEQ(d,"dbmclose"))
X HFUN(O_DBMCLOSE);
X if (strEQ(d,"dump"))
X LOOPX(O_DUMP);
X break;
X case 'e': case 'E':
X SNARFWORD;
X if (strEQ(d,"else"))
X OPERATOR(ELSE);
X if (strEQ(d,"elsif")) {
X yylval.ival = line;
X OPERATOR(ELSIF);
X }
X if (strEQ(d,"eq") || strEQ(d,"EQ"))
X EOP(O_SEQ);
X if (strEQ(d,"exit"))
X UNI(O_EXIT);
X if (strEQ(d,"eval")) {
X allstabs = TRUE; /* must initialize everything since */
X UNI(O_EVAL); /* we don't know what will be used */
X }
X if (strEQ(d,"eof"))
X FOP(O_EOF);
X if (strEQ(d,"exp"))
X UNI(O_EXP);
X if (strEQ(d,"each"))
X HFUN(O_EACH);
X if (strEQ(d,"exec")) {
X set_csh();
X LOP(O_EXEC);
X }
X if (strEQ(d,"endhostent"))
X FUN0(O_EHOSTENT);
X if (strEQ(d,"endnetent"))
X FUN0(O_ENETENT);
X if (strEQ(d,"endservent"))
X FUN0(O_ESERVENT);
X if (strEQ(d,"endprotoent"))
X FUN0(O_EPROTOENT);
X break;
X case 'f': case 'F':
X SNARFWORD;
X if (strEQ(d,"for"))
X OPERATOR(FOR);
X if (strEQ(d,"foreach"))
X OPERATOR(FOR);
X if (strEQ(d,"format")) {
X d = bufend;
X while (s < d && isspace(*s))
X s++;
X if (isalpha(*s) || *s == '_')
X *(--s) = '\\'; /* force next ident to WORD */
X in_format = TRUE;
X OPERATOR(FORMAT);
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 }
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 }
X d -= 3;
X }
X break;
X case 'h': case 'H':
X SNARFWORD;
X if (strEQ(d,"hex"))
X UNI(O_HEX);
X break;
X case 'i': case 'I':
X SNARFWORD;
X if (strEQ(d,"if")) {
X yylval.ival = line;
X OPERATOR(IF);
X }
X if (strEQ(d,"index"))
X FUN2(O_INDEX);
X if (strEQ(d,"int"))
X UNI(O_INT);
X if (strEQ(d,"ioctl"))
X FOP3(O_IOCTL);
X break;
X case 'j': case 'J':
X SNARFWORD;
X if (strEQ(d,"join"))
X FL2(O_JOIN);
X break;
X case 'k': case 'K':
X SNARFWORD;
X if (strEQ(d,"keys"))
X HFUN(O_KEYS);
X if (strEQ(d,"kill"))
X LOP(O_KILL);
X break;
X case 'l': case 'L':
X SNARFWORD;
X if (strEQ(d,"last"))
X LOOPX(O_LAST);
X if (strEQ(d,"local"))
X OPERATOR(LOCAL);
X if (strEQ(d,"length"))
X UNI(O_LENGTH);
X if (strEQ(d,"lt") || strEQ(d,"LT"))
X ROP(O_SLT);
X if (strEQ(d,"le") || strEQ(d,"LE"))
X ROP(O_SLE);
X if (strEQ(d,"localtime"))
X UNI(O_LOCALTIME);
X if (strEQ(d,"log"))
X UNI(O_LOG);
X if (strEQ(d,"link"))
X FUN2(O_LINK);
X if (strEQ(d,"listen"))
X FOP2(O_LISTEN);
X break;
X case 'm': case 'M':
X SNARFWORD;
X if (strEQ(d,"m")) {
X s = scanpat(s-1);
X TERM(PATTERN);
X }
X if (strEQ(d,"mkdir"))
X FUN2(O_MKDIR);
X break;
X case 'n': case 'N':
X SNARFWORD;
X if (strEQ(d,"next"))
X LOOPX(O_NEXT);
X if (strEQ(d,"ne") || strEQ(d,"NE"))
X EOP(O_SNE);
X break;
X case 'o': case 'O':
X SNARFWORD;
X if (strEQ(d,"open"))
X OPERATOR(OPEN);
X if (strEQ(d,"ord"))
X UNI(O_ORD);
X if (strEQ(d,"oct"))
X UNI(O_OCT);
X break;
X case 'p': case 'P':
X SNARFWORD;
X if (strEQ(d,"print")) {
X checkcomma(s,"filehandle");
X LOP(O_PRINT);
X }
X if (strEQ(d,"printf")) {
X checkcomma(s,"filehandle");
X LOP(O_PRTF);
X }
X if (strEQ(d,"push")) {
X yylval.ival = O_PUSH;
X OPERATOR(PUSH);
X }
X if (strEQ(d,"pop"))
X OPERATOR(POP);
X if (strEQ(d,"pack"))
X FL2(O_PACK);
X if (strEQ(d,"package"))
X OPERATOR(PACKAGE);
X break;
X case 'q': case 'Q':
X SNARFWORD;
X if (strEQ(d,"q")) {
X s = scanstr(s-1);
X TERM(RSTRING);
X }
X if (strEQ(d,"qq")) {
X s = scanstr(s-2);
X TERM(RSTRING);
X }
X break;
X case 'r': case 'R':
X SNARFWORD;
X if (strEQ(d,"return"))
X UNI(O_RETURN);
X if (strEQ(d,"reset"))
X UNI(O_RESET);
X if (strEQ(d,"redo"))
X LOOPX(O_REDO);
X if (strEQ(d,"rename"))
X FUN2(O_RENAME);
X if (strEQ(d,"rand"))
X UNI(O_RAND);
X if (strEQ(d,"rmdir"))
X UNI(O_RMDIR);
X if (strEQ(d,"rindex"))
X FUN2(O_RINDEX);
X if (strEQ(d,"read"))
X FOP3(O_READ);
X if (strEQ(d,"recv"))
X FOP4(O_RECV);
X if (strEQ(d,"reverse"))
X LOP(O_REVERSE);
X if (strEQ(d,"readlink"))
X UNI(O_READLINK);
X break;
X case 's': case 'S':
X SNARFWORD;
X if (strEQ(d,"s")) {
X s = scansubst(s);
X TERM(SUBST);
X }
X switch (d[1]) {
X case 'a':
X case 'b':
X case 'c':
X case 'd':
X break;
X case 'e':
X if (strEQ(d,"select"))
X OPERATOR(SELECT);
X if (strEQ(d,"seek"))
X FOP3(O_SEEK);
X if (strEQ(d,"send"))
X FOP3(O_SEND);
X if (strEQ(d,"setpgrp"))
X FUN2(O_SETPGRP);
X if (strEQ(d,"setpriority"))
X FUN3(O_SETPRIORITY);
X if (strEQ(d,"sethostent"))
X FUN1(O_SHOSTENT);
X if (strEQ(d,"setnetent"))
X FUN1(O_SNETENT);
X if (strEQ(d,"setservent"))
X FUN1(O_SSERVENT);
X if (strEQ(d,"setprotoent"))
X FUN1(O_SPROTOENT);
X break;
X case 'f':
X case 'g':
X break;
X case 'h':
X if (strEQ(d,"shift"))
X TERM(SHIFT);
X break;
X case 'i':
X if (strEQ(d,"sin"))
X UNI(O_SIN);
X break;
X case 'j':
X case 'k':
X break;
X case 'l':
X if (strEQ(d,"sleep"))
X UNI(O_SLEEP);
X break;
X case 'm':
X case 'n':
X break;
X case 'o':
X if (strEQ(d,"socket"))
X FOP4(O_SOCKET);
X if (strEQ(d,"socketpair"))
X FOP25(O_SOCKETPAIR);
X if (strEQ(d,"sort")) {
X checkcomma(s,"subroutine name");
X d = bufend;
X while (s < d && isascii(*s) && isspace(*s)) s++;
X if (*s == ';' || *s == ')') /* probably a close */
X fatal("sort is now a reserved word");
X if (isascii(*s) && (isalpha(*s) || *s == '_')) {
X for (d = s; isalpha(*d) || isdigit(*d) || *d == '_'; d++) ;
X if (d >= bufend || isspace(*d))
X *(--s) = '\\'; /* force next ident to WORD */
X }
X LOP(O_SORT);
X }
X break;
X case 'p':
X if (strEQ(d,"split"))
X TERM(SPLIT);
X if (strEQ(d,"sprintf"))
X FL(O_SPRINTF);
X break;
X case 'q':
X if (strEQ(d,"sqrt"))
X UNI(O_SQRT);
X break;
X case 'r':
X if (strEQ(d,"srand"))
X UNI(O_SRAND);
X break;
X case 's':
X break;
X case 't':
X if (strEQ(d,"stat"))
X FOP(O_STAT);
X if (strEQ(d,"study")) {
X sawstudy++;
X LFUN(O_STUDY);
X }
X break;
X case 'u':
X if (strEQ(d,"substr"))
X FUN3(O_SUBSTR);
X if (strEQ(d,"sub")) {
X subline = line;
X d = bufend;
X while (s < d && isspace(*s))
X s++;
X if (isalpha(*s) || *s == '_' || *s == '\'') {
X if (perldb) {
X str_sset(subname,curstname);
X str_ncat(subname,"'",1);
X for (d = s+1;
X isalpha(*d) || isdigit(*d) || *d == '_' || *d == '\'';
X d++);
X if (d[-1] == '\'')
X d--;
X str_ncat(subname,s,d-s);
X }
X *(--s) = '\\'; /* force next ident to WORD */
X }
X else
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 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 TERM(TRANS);
X }
X if (strEQ(d,"tell"))
X FOP(O_TELL);
X if (strEQ(d,"time"))
X FUN0(O_TIME);
X if (strEQ(d,"times"))
X FUN0(O_TMS);
X break;
X case 'u': case 'U':
X SNARFWORD;
X if (strEQ(d,"using"))
X OPERATOR(USING);
X if (strEQ(d,"until")) {
X yylval.ival = line;
X OPERATOR(UNTIL);
X }
X if (strEQ(d,"unless")) {
X yylval.ival = line;
X OPERATOR(UNLESS);
X }
X if (strEQ(d,"unlink"))
X LOP(O_UNLINK);
X if (strEQ(d,"undef"))
X LFUN(O_UNDEF);
X if (strEQ(d,"unpack"))
X FUN2(O_UNPACK);
X if (strEQ(d,"utime"))
X LOP(O_UTIME);
X if (strEQ(d,"umask"))
X UNI(O_UMASK);
X if (strEQ(d,"unshift")) {
X yylval.ival = O_UNSHIFT;
X OPERATOR(PUSH);
X }
X break;
X case 'v': case 'V':
X SNARFWORD;
X if (strEQ(d,"values"))
X HFUN(O_VALUES);
X if (strEQ(d,"vec")) {
X sawvec = TRUE;
X FUN3(O_VEC);
X }
X break;
X case 'w': case 'W':
X SNARFWORD;
X if (strEQ(d,"while")) {
X yylval.ival = line;
X OPERATOR(WHILE);
X }
X if (strEQ(d,"warn"))
X UNI(O_WARN);
X if (strEQ(d,"wait"))
X FUN0(O_WAIT);
X if (strEQ(d,"wantarray"))
X FUN0(O_WANTARRAY);
X if (strEQ(d,"write"))
X FOP(O_WRITE);
X break;
X case 'x': case 'X':
X SNARFWORD;
X if (!expectterm && strEQ(d,"x"))
X MOP(O_REPEAT);
X break;
X case 'y': case 'Y':
X SNARFWORD;
X if (strEQ(d,"y")) {
X s = scantrans(s);
X TERM(TRANS);
X }
X break;
X case 'z': case 'Z':
X SNARFWORD;
X break;
X }
X yylval.cval = savestr(d);
X return (CLINE, expectterm = (yychar==LISTOP), bufptr = s, (int)WORD);
X}
X
Xint
Xcheckcomma(s,what)
Xregister char *s;
Xchar *what;
X{
X if (*s == '(')
X s++;
X while (s < bufend && isascii(*s) && isspace(*s))
X s++;
X if (isascii(*s) && (isalpha(*s) || *s == '_')) {
X s++;
X while (isalpha(*s) || isdigit(*s) || *s == '_')
X s++;
X while (s < bufend && isspace(*s))
X s++;
X if (*s == ',')
X fatal("No comma allowed after %s", what);
X }
X}
X
Xchar *
Xscanreg(s,send,dest)
Xregister char *s;
Xregister char *send;
Xchar *dest;
X{
X register char *d;
X
X s++;
X d = dest;
X if (isdigit(*s)) {
X while (isdigit(*s))
X *d++ = *s++;
X }
X else {
X while (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')
X *d++ = *s++;
X }
X if (d > dest+1 && d[-1] == '\'')
X d--,s--;
X *d = '\0';
X d = dest;
X if (!*d) {
X *d = *s++;
X if (*d == '{') {
X d = dest;
X while (s < send && *s != '}')
X *d++ = *s++;
X *d = '\0';
X d = dest;
X if (s < send)
X s++;
X }
X else
X d[1] = '\0';
X }
X if (*d == '^' && !isspace(*s))
X *d = *s++ & 31;
X return s;
X}
X
XSTR *
Xscanconst(string,len)
Xchar *string;
Xint len;
X{
X register STR *retstr;
X register char *t;
X register char *d;
X register char *e;
X
X if (index(string,'|')) {
X return Nullstr;
X }
X retstr = str_new(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 (index("wWbB0123456789sSdD",d[1])) {
X e = d;
X break;
X }
X (void)bcopy(d+1,d,e-d);
X e--;
X switch(*d) {
X case 'n':
X *d = '\n';
X break;
X case 't':
X *d = '\t';
X break;
X case 'f':
X *d = '\f';
X break;
X case 'r':
X *d = '\r';
X break;
X }
X /* FALL THROUGH */
X default:
X defchar:
X if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
X e = d;
X break;
X }
X d++;
X }
X }
X if (d == t) {
X str_free(retstr);
X return Nullstr;
X }
X *d = '\0';
X retstr->str_cur = d - t;
X return retstr;
X}
X
Xchar *
Xscanpat(s)
Xregister char *s;
X{
X register SPAT *spat;
X register char *d;
X register char *e;
X int len;
X SPAT savespat;
X
X Newz(801,spat,1,SPAT);
X spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
X curstash->tbl_spatroot = spat;
X
X switch (*s++) {
X case 'm':
X s++;
X break;
X case '/':
X break;
X case '?':
X spat->spat_flags |= SPAT_ONCE;
X break;
X default:
X fatal("panic: scanpat");
X }
X s = cpytill(tokenbuf,s,bufend,s[-1],&len);
X if (s >= bufend) {
X yyerror("Search pattern not terminated");
X return s;
X }
X s++;
X while (*s == 'i' || *s == 'o') {
X if (*s == 'i') {
X s++;
X sawi = TRUE;
X spat->spat_flags |= SPAT_FOLD;
X }
X if (*s == 'o') {
X s++;
X spat->spat_flags |= SPAT_KEEP;
X }
X }
X e = tokenbuf + len;
X for (d=tokenbuf; d < e; d++) {
X if ((*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') ||
X (*d == '@' && d[-1] != '\\')) {
X register ARG *arg;
X
X spat->spat_runtime = arg = op_new(1);
X arg->arg_type = O_ITEM;
X arg[1].arg_type = A_DOUBLE;
X arg[1].arg_ptr.arg_str = str_make(tokenbuf,len);
X arg[1].arg_ptr.arg_str->str_u.str_hash = curstash;
X d = scanreg(d,bufend,buf);
X (void)stabent(buf,TRUE); /* make sure it's created */
X for (; d < e; d++) {
X if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
X d = scanreg(d,bufend,buf);
X (void)stabent(buf,TRUE);
X }
X else if (*d == '@' && d[-1] != '\\') {
X d = scanreg(d,bufend,buf);
X if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
X strEQ(buf,"SIG") || strEQ(buf,"INC"))
X (void)stabent(buf,TRUE);
X }
X }
X goto got_pat; /* skip compiling for now */
X }
X }
X if (spat->spat_flags & SPAT_FOLD)
X#ifdef STRUCTCOPY
X savespat = *spat;
X#else
X (void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT));
X#endif
X if (*tokenbuf == '^') {
X spat->spat_short = scanconst(tokenbuf+1,len-1);
X if (spat->spat_short) {
X spat->spat_slen = spat->spat_short->str_cur;
X if (spat->spat_slen == len - 1)
X spat->spat_flags |= SPAT_ALL;
X }
X }
X else {
X spat->spat_flags |= SPAT_SCANFIRST;
X spat->spat_short = scanconst(tokenbuf,len);
X if (spat->spat_short) {
X spat->spat_slen = spat->spat_short->str_cur;
X if (spat->spat_slen == len)
X spat->spat_flags |= SPAT_ALL;
X }
X }
X if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
X fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
X spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len,
X spat->spat_flags & SPAT_FOLD,1);
X /* Note that this regexp can still be used if someone says
X * something like /a/ && s//b/; so we can't delete it.
X */
X }
X else {
X if (spat->spat_flags & SPAT_FOLD)
X#ifdef STRUCTCOPY
X *spat = savespat;
X#else
X (void)bcopy((char *)&savespat, (char *)spat, sizeof(SPAT));
X#endif
X if (spat->spat_short)
X fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
X spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len,
X spat->spat_flags & SPAT_FOLD,1);
X hoistmust(spat);
X }
X got_pat:
X yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
X return s;
X}
X
Xchar *
Xscansubst(s)
Xregister char *s;
X{
X register SPAT *spat;
X register char *d;
X register char *e;
X int len;
X
X Newz(802,spat,1,SPAT);
X spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
X curstash->tbl_spatroot = spat;
X
X s = cpytill(tokenbuf,s+1,bufend,*s,&len);
X if (s >= bufend) {
X yyerror("Substitution pattern not terminated");
X return s;
X }
X e = tokenbuf + len;
X for (d=tokenbuf; d < e; d++) {
X if ((*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') ||
X (*d == '@' && d[-1] != '\\')) {
X register ARG *arg;
X
X spat->spat_runtime = arg = op_new(1);
X arg->arg_type = O_ITEM;
X arg[1].arg_type = A_DOUBLE;
X arg[1].arg_ptr.arg_str = str_make(tokenbuf,len);
X arg[1].arg_ptr.arg_str->str_u.str_hash = curstash;
X d = scanreg(d,bufend,buf);
X (void)stabent(buf,TRUE); /* make sure it's created */
X for (; *d; d++) {
X if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
X d = scanreg(d,bufend,buf);
X (void)stabent(buf,TRUE);
X }
X else if (*d == '@' && d[-1] != '\\') {
X d = scanreg(d,bufend,buf);
X if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
X strEQ(buf,"SIG") || strEQ(buf,"INC"))
X (void)stabent(buf,TRUE);
X }
X }
X goto get_repl; /* skip compiling for now */
X }
X }
X if (*tokenbuf == '^') {
X spat->spat_short = scanconst(tokenbuf+1,len-1);
X if (spat->spat_short)
X spat->spat_slen = spat->spat_short->str_cur;
X }
X else {
X spat->spat_flags |= SPAT_SCANFIRST;
X spat->spat_short = scanconst(tokenbuf,len);
X if (spat->spat_short)
X spat->spat_slen = spat->spat_short->str_cur;
X }
X d = nsavestr(tokenbuf,len);
Xget_repl:
X s = scanstr(s);
X if (s >= bufend) {
X yyerror("Substitution replacement not terminated");
X 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 == '$' && index("`'&+0123456789",t[1]))
X spat->spat_flags &= ~SPAT_CONST;
X }
X }
X while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
X if (*s == 'e') {
X s++;
X if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
X spat->spat_repl[1].arg_type = A_SINGLE;
X spat->spat_repl = fixeval(make_op(O_EVAL,2,
X spat->spat_repl,
X Nullarg,
X Nullarg,0));
X spat->spat_flags &= ~SPAT_CONST;
X }
X if (*s == 'g') {
X s++;
X spat->spat_flags &= ~SPAT_ONCE;
X }
X if (*s == 'i') {
X s++;
X sawi = TRUE;
X spat->spat_flags |= SPAT_FOLD;
X if (!(spat->spat_flags & SPAT_SCANFIRST)) {
X str_free(spat->spat_short); /* anchored opt doesn't do */
X spat->spat_short = Nullstr; /* case insensitive match */
X spat->spat_slen = 0;
X }
X }
X if (*s == 'o') {
X s++;
X spat->spat_flags |= SPAT_KEEP;
X }
X }
X if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
X fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
X if (!spat->spat_runtime) {
X spat->spat_regexp = regcomp(d,d+len,spat->spat_flags & SPAT_FOLD,1);
X hoistmust(spat);
X Safefree(d);
X }
X yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
X return s;
X}
X
Xhoistmust(spat)
Xregister SPAT *spat;
X{
X if (spat->spat_regexp->regmust) { /* is there a better short-circuit? */
X if (spat->spat_short &&
X str_eq(spat->spat_short,spat->spat_regexp->regmust))
X {
X if (spat->spat_flags & SPAT_SCANFIRST) {
X str_free(spat->spat_short);
X spat->spat_short = Nullstr;
X }
X else {
X str_free(spat->spat_regexp->regmust);
X spat->spat_regexp->regmust = Nullstr;
X return;
X }
X }
X if (!spat->spat_short || /* promote the better string */
X ((spat->spat_flags & SPAT_SCANFIRST) &&
X (spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
X str_free(spat->spat_short); /* ok if null */
X spat->spat_short = spat->spat_regexp->regmust;
X spat->spat_regexp->regmust = Nullstr;
X spat->spat_flags |= SPAT_SCANFIRST;
X }
X }
X}
X
Xchar *
Xexpand_charset(s,len,retlen)
Xregister char *s;
Xint len;
Xint *retlen;
X{
X char t[512];
X register char *d = t;
X register int i;
X register char *send = s + len;
X
X while (s < send) {
X if (s[1] == '-' && s+2 < send) {
X for (i = s[0]; i <= s[2]; i++)
X *d++ = i;
X s += 3;
X }
X else
X *d++ = *s++;
X }
X *d = '\0';
X *retlen = d - t;
X return nsavestr(t,d-t);
X}
X
Xchar *
Xscantrans(s)
Xregister char *s;
X{
X ARG *arg =
X l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg,0));
X register char *t;
X register char *r;
X register char *tbl;
X register int i;
X register int j;
X int tlen, rlen;
X
X Newz(803,tbl,256,char);
X arg[2].arg_type = A_NULL;
X arg[2].arg_ptr.arg_cval = tbl;
X s = scanstr(s);
X if (s >= bufend) {
X yyerror("Translation pattern not terminated");
X return s;
X }
X t = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
X yylval.arg[1].arg_ptr.arg_str->str_cur,&tlen);
X free_arg(yylval.arg);
X s = scanstr(s-1);
X if (s >= bufend) {
X yyerror("Translation replacement not terminated");
X return s;
X }
X r = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
X yylval.arg[1].arg_ptr.arg_str->str_cur,&rlen);
X free_arg(yylval.arg);
X yylval.arg = arg;
X if (!*r) {
X Safefree(r);
X r = t;
X }
X for (i = 0, j = 0; i < tlen; i++,j++) {
X if (j >= rlen)
X --j;
X tbl[t[i] & 0377] = r[j];
X }
X if (r != t)
X Safefree(r);
X Safefree(t);
X return s;
X}
X
Xchar *
Xscanstr(s)
Xregister char *s;
X{
X register char term;
X register char *d;
X register ARG *arg;
X register char *send;
X register bool makesingle = FALSE;
X register STAB *stab;
X bool alwaysdollar = FALSE;
X bool hereis = FALSE;
X STR *herewas;
X char *leave = "\\$@nrtfb0123456789[{"; /* which backslash sequences to keep */
X int len;
X
X arg = op_new(1);
X yylval.arg = arg;
X arg->arg_type = O_ITEM;
X
X switch (*s) {
X default: /* a substitution replacement */
X arg[1].arg_type = A_DOUBLE;
X makesingle = TRUE; /* maybe disable runtime scanning */
X term = *s;
X if (term == '\'')
X leave = Nullch;
X goto snarf_it;
X case '0':
X {
X long i;
X int shift;
X
X arg[1].arg_type = A_SINGLE;
X if (s[1] == 'x') {
X shift = 4;
X s += 2;
X }
X else if (s[1] == '.')
X goto decimal;
X else
X shift = 3;
X i = 0;
X for (;;) {
X switch (*s) {
X default:
X goto out;
X case '8': case '9':
X if (shift != 4)
X yyerror("Illegal octal digit");
X /* FALL THROUGH */
X case '0': case '1': case '2': case '3': case '4':
X case '5': case '6': case '7':
X i <<= shift;
X i += *s++ & 15;
X break;
X case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
X case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
X if (shift != 4)
X goto out;
X i <<= 4;
X i += (*s++ & 7) + 9;
X break;
X }
X }
X out:
X (void)sprintf(tokenbuf,"%ld",i);
X arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
X (void)str_2num(arg[1].arg_ptr.arg_str);
X }
X break;
X case '1': case '2': case '3': case '4': case '5':
X case '6': case '7': case '8': case '9': case '.':
X decimal:
X arg[1].arg_type = A_SINGLE;
X d = tokenbuf;
X while (isdigit(*s) || *s == '_') {
X if (*s == '_')
X s++;
X else
X *d++ = *s++;
X }
X if (*s == '.' && 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 (index("eE",*s) && index("+-0123456789",s[1])) {
X *d++ = *s++;
X if (*s == '+' || *s == '-')
X *d++ = *s++;
X while (isdigit(*s))
X *d++ = *s++;
X }
X *d = '\0';
X arg[1].arg_ptr.arg_str = str_make(tokenbuf, d - tokenbuf);
X (void)str_2num(arg[1].arg_ptr.arg_str);
X break;
X case '<':
X if (*++s == '<') {
X hereis = TRUE;
X d = tokenbuf;
X if (!rsfp)
X *d++ = '\n';
X if (index("`'\"",*++s)) {
X term = *s++;
X s = cpytill(d,s,bufend,term,&len);
X if (s < bufend)
X s++;
X d += len;
X }
X else {
X if (*s == '\\')
X s++, term = '\'';
X else
X term = '"';
X while (isascii(*s) && (isalpha(*s) || isdigit(*s) || *s == '_'))
X *d++ = *s++;
X } /* assuming tokenbuf won't clobber */
X *d++ = '\n';
X *d = '\0';
X len = d - tokenbuf;
X d = "\n";
X if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
X herewas = str_make(s,bufend-s);
X else
X s--, herewas = str_make(s,d-s);
X s += herewas->str_cur;
X if (term == '\'')
X goto do_single;
X if (term == '`')
X goto do_back;
X goto do_double;
X }
X d = tokenbuf;
X s = cpytill(d,s,bufend,'>',&len);
X if (s < bufend)
X s++;
X if (*d == '$') d++;
X while (*d &&
X (isalpha(*d) || isdigit(*d) || *d == '_' || *d == '\''))
X d++;
X if (d - tokenbuf != len) {
X d = tokenbuf;
X arg[1].arg_type = A_GLOB;
X d = nsavestr(d,len);
X arg[1].arg_ptr.arg_stab = stab = genstab();
X stab_io(stab) = stio_new();
X stab_val(stab) = str_make(d,len);
X stab_val(stab)->str_u.str_hash = curstash;
X Safefree(d);
X set_csh();
X }
X else {
X d = tokenbuf;
X if (!len)
X (void)strcpy(d,"ARGV");
X if (*d == '$') {
X arg[1].arg_type = A_INDREAD;
X arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
X }
X else {
X arg[1].arg_type = A_READ;
X if (rsfp == stdin && (strEQ(d,"stdin") || strEQ(d,"STDIN")))
X yyerror("Can't get both program and data from <STDIN>");
X arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
X if (!stab_io(arg[1].arg_ptr.arg_stab))
X stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
X if (strEQ(d,"ARGV")) {
X (void)aadd(arg[1].arg_ptr.arg_stab);
X stab_io(arg[1].arg_ptr.arg_stab)->flags |=
X IOF_ARGV|IOF_START;
X }
X }
X }
X break;
X
X case 'q':
X s++;
X if (*s == 'q') {
X s++;
X goto do_double;
X }
X /* FALL THROUGH */
X case '\'':
X do_single:
X term = *s;
X arg[1].arg_type = A_SINGLE;
X leave = Nullch;
X goto snarf_it;
X
X case '"':
X do_double:
X term = *s;
X arg[1].arg_type = A_DOUBLE;
X makesingle = TRUE; /* maybe disable runtime scanning */
X alwaysdollar = TRUE; /* treat $) and $| as variables */
X goto snarf_it;
X case '`':
X do_back:
X term = *s;
X arg[1].arg_type = A_BACKTICK;
X set_csh();
X alwaysdollar = TRUE; /* treat $) and $| as variables */
X snarf_it:
X {
X STR *tmpstr;
X char *tmps;
X
X multi_start = line;
X if (hereis)
X multi_open = multi_close = '<';
X else {
X multi_open = term;
X if (tmps = index("([{< )]}> )]}>",term))
X term = tmps[5];
X multi_close = term;
X }
X tmpstr = str_new(0);
X if (hereis) {
X term = *tokenbuf;
X if (!rsfp) {
X d = s;
X while (s < bufend &&
X (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
X if (*s++ == '\n')
X line++;
X }
X if (s >= bufend) {
X line = multi_start;
X fatal("EOF in string");
X }
X str_nset(tmpstr,d+1,s-d);
X s += len - 1;
X str_ncat(herewas,s,bufend-s);
X str_replace(linestr,herewas);
X oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
X bufend = linestr->str_ptr + linestr->str_cur;
X hereis = FALSE;
X }
X }
X else
X s = str_append_till(tmpstr,s+1,bufend,term,leave);
X while (s >= bufend) { /* multiple line string? */
X if (!rsfp ||
X !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
X line = multi_start;
X fatal("EOF in string");
X }
X line++;
X if (perldb) {
X STR *str = str_new(0);
X
X str_sset(str,linestr);
X astore(lineary,(int)line,str);
X }
X bufend = linestr->str_ptr + linestr->str_cur;
X if (hereis) {
X if (*s == term && bcmp(s,tokenbuf,len) == 0) {
X s = bufend - 1;
X *s = ' ';
X str_scat(linestr,herewas);
X bufend = linestr->str_ptr + linestr->str_cur;
X }
X else {
X s = bufend;
X str_scat(tmpstr,linestr);
X }
X }
X else
X s = str_append_till(tmpstr,s,bufend,term,leave);
X }
X multi_end = line;
X s++;
X if (tmpstr->str_cur + 5 < tmpstr->str_len) {
X tmpstr->str_len = tmpstr->str_cur + 1;
X Renew(tmpstr->str_ptr, tmpstr->str_len, char);
X }
X if ((arg[1].arg_type & A_MASK) == A_SINGLE) {
X arg[1].arg_ptr.arg_str = tmpstr;
X break;
X }
X tmps = s;
X s = tmpstr->str_ptr;
X send = s + tmpstr->str_cur;
X while (s < send) { /* see if we can make SINGLE */
X if (*s == '\\' && s[1] && isdigit(s[1]) && !isdigit(s[2]) &&
X !alwaysdollar )
X *s = '$'; /* grandfather \digit in subst */
X if ((*s == '$' || *s == '@') && s+1 < send &&
X (alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
X makesingle = FALSE; /* force interpretation */
X }
X else if (*s == '\\' && s+1 < send) {
X s++;
X }
X s++;
X }
X s = d = tmpstr->str_ptr; /* assuming shrinkage only */
X while (s < send) {
X if ((*s == '$' && s+1 < send &&
X (alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) ||
X (*s == '@' && s+1 < send) ) {
X len = scanreg(s,bufend,tokenbuf) - s;
X if (*s == '$' || strEQ(tokenbuf,"ARGV")
X || strEQ(tokenbuf,"ENV")
X || strEQ(tokenbuf,"SIG")
X || strEQ(tokenbuf,"INC") )
X (void)stabent(tokenbuf,TRUE); /* make sure it exists */
X while (len--)
X *d++ = *s++;
X continue;
X }
X else if (*s == '\\' && s+1 < send) {
X s++;
X switch (*s) {
X default:
X if (!makesingle && (!leave || index(leave,*s)))
X *d++ = '\\';
X *d++ = *s++;
X continue;
X case '0': case '1': case '2': case '3':
X case '4': case '5': case '6': case '7':
X *d = *s++ - '0';
X if (s < send && index("01234567",*s)) {
X *d <<= 3;
X *d += *s++ - '0';
X }
X if (s < send && index("01234567",*s)) {
X *d <<= 3;
X *d += *s++ - '0';
X }
X d++;
X continue;
X case 'b':
X *d++ = '\b';
X break;
X case 'n':
X *d++ = '\n';
X break;
X case 'r':
X *d++ = '\r';
X break;
X case 'f':
X *d++ = '\f';
X break;
X case 't':
X *d++ = '\t';
X break;
X }
X s++;
X continue;
X }
X *d++ = *s++;
X }
X *d = '\0';
X
X if ((arg[1].arg_type & A_MASK) == A_DOUBLE && makesingle)
X arg[1].arg_type = A_SINGLE; /* now we can optimize on it */
X
X tmpstr->str_u.str_hash = curstash; /* so interp knows package */
X
X tmpstr->str_cur = d - tmpstr->str_ptr;
X arg[1].arg_ptr.arg_str = tmpstr;
X s = tmps;
X break;
X }
X }
X if (hereis)
X str_free(herewas);
X return s;
X}
X
XFCMD *
Xload_format()
X{
X FCMD froot;
X FCMD *flinebeg;
X register FCMD *fprev = &froot;
X register FCMD *fcmd;
X register char *s;
X register char *t;
X register STR *str;
X bool noblank;
X
X Zero(&froot, 1, FCMD);
X while ((s = str_gets(linestr,rsfp, 0)) != Nullch) {
X line++;
X if (perldb) {
X STR *tmpstr = str_new(0);
X
X str_sset(tmpstr,linestr);
X astore(lineary,(int)line,tmpstr);
X }
X bufend = linestr->str_ptr + linestr->str_cur;
X if (strEQ(s,".\n")) {
X bufptr = s;
X return froot.f_next;
X }
X if (*s == '#')
X continue;
X flinebeg = Nullfcmd;
X noblank = FALSE;
X while (s < bufend) {
X Newz(804,fcmd,1,FCMD);
X fprev->f_next = fcmd;
X fprev = fcmd;
X for (t=s; t < bufend && *t != '@' && *t != '^'; t++) {
X if (*t == '~') {
X noblank = TRUE;
X *t = ' ';
X }
X }
X fcmd->f_pre = nsavestr(s, t-s);
X fcmd->f_presize = t-s;
X s = t;
X if (s >= bufend) {
X if (noblank)
X fcmd->f_flags |= FC_NOBLANK;
X break;
X }
X if (!flinebeg)
X flinebeg = fcmd; /* start values here */
X if (*s++ == '^')
X fcmd->f_flags |= FC_CHOP; /* for doing text filling */
X switch (*s) {
X case '*':
X fcmd->f_type = F_LINES;
X *s = '\0';
X break;
X case '<':
X fcmd->f_type = F_LEFT;
X while (*s == '<')
X s++;
X break;
X case '>':
X fcmd->f_type = F_RIGHT;
X while (*s == '>')
X s++;
X break;
X case '|':
X fcmd->f_type = F_CENTER;
X while (*s == '|')
X s++;
X break;
X default:
X fcmd->f_type = F_LEFT;
X break;
X }
X if (fcmd->f_flags & FC_CHOP && *s == '.') {
X fcmd->f_flags |= FC_MORE;
X while (*s == '.')
X s++;
X }
X fcmd->f_size = s-t;
X }
X if (flinebeg) {
X again:
X if ((s = str_gets(linestr, rsfp, 0)) == Nullch)
X goto badform;
X line++;
X if (perldb) {
X STR *tmpstr = str_new(0);
X
X str_sset(tmpstr,linestr);
X astore(lineary,(int)line,tmpstr);
X }
X if (strEQ(s,".\n")) {
X bufptr = s;
X yyerror("Missing values line");
X return froot.f_next;
X }
X if (*s == '#')
X goto again;
X bufend = linestr->str_ptr + linestr->str_cur;
X str = flinebeg->f_unparsed = str_new(bufend - bufptr);
X str->str_u.str_hash = curstash;
X str_nset(str,"(",1);
X flinebeg->f_line = line;
X if (!flinebeg->f_next->f_type || index(linestr->str_ptr, ',')) {
X str_scat(str,linestr);
X str_ncat(str,",$$);",5);
X }
X else {
X while (s < bufend && isspace(*s))
X s++;
X t = s;
X while (s < bufend) {
X switch (*s) {
X case ' ': case '\t': case '\n': case ';':
X str_ncat(str, t, s - t);
X str_ncat(str, "," ,1);
X while (s < bufend && (isspace(*s) || *s == ';'))
X s++;
X t = s;
X break;
X case '$':
X str_ncat(str, t, s - t);
X t = s;
X s = scanreg(s,bufend,tokenbuf);
X str_ncat(str, t, s - t);
X t = s;
X if (s < bufend && index("$'\"",*s))
X str_ncat(str, ",", 1);
X break;
X case '"': case '\'':
X str_ncat(str, t, s - t);
X t = s;
X s++;
X while (s < bufend && (*s != *t || s[-1] == '\\'))
X s++;
X if (s < bufend)
X s++;
X str_ncat(str, t, s - t);
X t = s;
X if (s < bufend && index("$'\"",*s))
X str_ncat(str, ",", 1);
X break;
X default:
X yyerror("Please use commas to separate fields");
X }
X str_ncat(str,"$$);",4);
X }
X }
X }
X }
X badform:
X bufptr = str_get(linestr);
X yyerror("Format not terminated");
X return froot.f_next;
X}
X
Xset_csh()
X{
X if (!csh) {
X if (stat("/bin/csh",&statbuf) < 0)
X csh = -1;
X else
X csh = 1;
X }
X}
!STUFFY!FUNK!
echo Extracting config.H
sed >config.H <<'!STUFFY!FUNK!' -e 's/X//'
X/* config.h
X * This file was produced by running the config.h.SH script, which
X * gets its values from config.sh, which is generally produced by
X * running Configure.
X *
X * Feel free to modify any of this as the need arises. Note, however,
X * that running config.h.SH again will wipe out any changes you've made.
X * For a more permanent change edit config.sh and rerun config.h.SH.
X */
X
X
X/* EUNICE:
X * This symbol, if defined, indicates that the program is being compiled
X * under the EUNICE package under VMS. The program will need to handle
X * things like files that don't go away the first time you unlink them,
X * due to version numbering. It will also need to compensate for lack
X * of a respectable link() command.
X */
X/* VMS:
X * This symbol, if defined, indicates that the program is running under
X * VMS. It is currently only set in conjunction with the EUNICE symbol.
X */
X#/*undef EUNICE /**/
X#/*undef VMS /**/
X
X/* CHARSPRINTF:
X * This symbol is defined if this system declares "char *sprintf()" in
X * stdio.h. The trend seems to be to declare it as "int sprintf()". It
X * is up to the package author to declare sprintf correctly based on the
X * symbol.
X */
X#define CHARSPRINTF /**/
X
X/* index:
X * This preprocessor symbol is defined, along with rindex, if the system
X * uses the strchr and strrchr routines instead.
X */
X/* rindex:
X * This preprocessor symbol is defined, along with index, if the system
X * uses the strchr and strrchr routines instead.
X */
X#/*undef index strchr /* cultural */
X#/*undef rindex strrchr /* differences? */
X
X/* STRUCTCOPY:
X * This symbol, if defined, indicates that this C compiler knows how
X * to copy structures. If undefined, you'll need to use a block copy
X * routine of some sort instead.
X */
X#define STRUCTCOPY /**/
X
X/* vfork:
X * This symbol, if defined, remaps the vfork routine to fork if the
X * vfork() routine isn't supported here.
X */
X#/*undef vfork fork /**/
X
X/* VOIDFLAGS:
X * This symbol indicates how much support of the void type is given by this
X * compiler. What various bits mean:
X *
X * 1 = supports declaration of void
X * 2 = supports arrays of pointers to functions returning void
X * 4 = supports comparisons between pointers to void functions and
X * addresses of void functions
X *
X * The package designer should define VOIDUSED to indicate the requirements
X * of the package. This can be done either by #defining VOIDUSED before
X * including config.h, or by defining defvoidused in Myinit.U. If the
X * level of void support necessary is not present, defines void to int.
X */
X#ifndef VOIDUSED
X#define VOIDUSED 7
X#endif
X#define VOIDFLAGS 7
X#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
X#define void int /* is void to be avoided? */
X#define M_VOID /* Xenix strikes again */
X#endif
X
!STUFFY!FUNK!
echo ""
echo "End of kit 4 (of 23)"
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; do
if test -f kit${iskit}isdone; then
run="$run $iskit"
else
todo="$todo $iskit"
fi
done
case $todo in
'')
echo "You have run all your kits. Please read README and then type Configure."
chmod 755 Configure
;;
*) echo "You have run$run."
echo "You still need to run$todo."
;;
esac
: Someone might mail this, so...
exit