summaryrefslogtreecommitdiff
path: root/toke.c.orig
diff options
context:
space:
mode:
Diffstat (limited to 'toke.c.orig')
-rw-r--r--toke.c.orig2754
1 files changed, 2754 insertions, 0 deletions
diff --git a/toke.c.orig b/toke.c.orig
new file mode 100644
index 0000000000..8019756220
--- /dev/null
+++ b/toke.c.orig
@@ -0,0 +1,2754 @@
+/* $RCSfile: toke.c,v $$Revision: 4.0.1.8 $$Date: 92/06/23 12:33:45 $
+ *
+ * Copyright (c) 1991, Larry Wall
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ *
+ * $Log: toke.c,v $
+ * Revision 4.0.1.8 92/06/23 12:33:45 lwall
+ * patch35: bad interaction between backslash and hyphen in tr///
+ *
+ * Revision 4.0.1.7 92/06/11 21:16:30 lwall
+ * patch34: expectterm incorrectly set to indicate start of program or block
+ *
+ * Revision 4.0.1.6 92/06/08 16:03:49 lwall
+ * patch20: an EXPR may now start with a bareword
+ * patch20: print $fh EXPR can now expect term rather than operator in EXPR
+ * patch20: added ... as variant on ..
+ * patch20: new warning on spurious backslash
+ * patch20: new warning on missing $ for foreach variable
+ * patch20: "foo"x1024 now legal without space after x
+ * patch20: new warning on print accidentally used as function
+ * patch20: tr/stuff// wasn't working right
+ * patch20: 2. now eats the dot
+ * patch20: <@ARGV> now notices @ARGV
+ * patch20: tr/// now lets you say \-
+ *
+ * Revision 4.0.1.5 91/11/11 16:45:51 lwall
+ * patch19: default arg for shift was wrong after first subroutine definition
+ *
+ * Revision 4.0.1.4 91/11/05 19:02:48 lwall
+ * patch11: \x and \c were subject to double interpretation in regexps
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: nested list operators could miscount parens
+ * patch11: once-thru blocks didn't display right in the debugger
+ * patch11: sort eval "whatever" didn't work
+ * patch11: underscore is now allowed within literal octal and hex numbers
+ *
+ * Revision 4.0.1.3 91/06/10 01:32:26 lwall
+ * patch10: m'$foo' now treats string as single quoted
+ * patch10: certain pattern optimizations were botched
+ *
+ * Revision 4.0.1.2 91/06/07 12:05:56 lwall
+ * patch4: new copyright notice
+ * patch4: debugger lost track of lines in eval
+ * patch4: //o and s///o now optimize themselves fully at runtime
+ * patch4: added global modifier for pattern matches
+ *
+ * Revision 4.0.1.1 91/04/12 09:18:18 lwall
+ * patch1: perl -de "print" wouldn't stop at the first statement
+ *
+ * Revision 4.0 91/03/20 01:42:14 lwall
+ * 4.0 baseline.
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "perly.h"
+
+static void set_csh();
+
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
+#ifdef f_next
+#undef f_next
+#endif
+
+/* which backslash sequences to keep in m// or s// */
+
+static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}";
+
+char *reparse; /* if non-null, scanident found ${foo[$bar]} */
+
+void checkcomma();
+
+#ifdef CLINE
+#undef CLINE
+#endif
+#define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_line : cmdline))
+
+#ifdef atarist
+#define PERL_META(c) ((c) | 128)
+#else
+#define META(c) ((c) | 128)
+#endif
+
+#define RETURN(retval) return (bufptr = s,(int)retval)
+#define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
+#define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
+#define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
+#define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
+#define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
+#define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
+#define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
+#define FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x)
+#define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
+#define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4)
+#define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5)
+#define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
+#define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
+#define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
+#define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
+#define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
+#define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
+#define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
+#define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
+#define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
+#define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
+#define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
+#define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
+#define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
+#define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
+#define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
+
+static char *last_uni;
+
+/* This bit of chicanery makes a unary function followed by
+ * a parenthesis into a function with one argument, highest precedence.
+ */
+#define UNI(f) return(yylval.ival = f, \
+ expectterm = TRUE, \
+ bufptr = s, \
+ last_uni = oldbufptr, \
+ (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
+
+/* This does similarly for list operators, merely by pretending that the
+ * paren came before the listop rather than after.
+ */
+#ifdef atarist
+#define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
+ (*s = (char) PERL_META('('), bufptr = oldbufptr, '(') : \
+ (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
+#else
+#define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
+ (*s = (char) META('('), bufptr = oldbufptr, '(') : \
+ (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
+#endif
+/* grandfather return to old style */
+#define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
+
+char *
+skipspace(s)
+register char *s;
+{
+ while (s < bufend && isSPACE(*s))
+ s++;
+ return s;
+}
+
+void
+check_uni() {
+ char *s;
+ char ch;
+
+ if (oldoldbufptr != last_uni)
+ return;
+ while (isSPACE(*last_uni))
+ last_uni++;
+ for (s = last_uni; isALNUM(*s); s++) ;
+ ch = *s;
+ *s = '\0';
+ warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
+ *s = ch;
+}
+
+#ifdef CRIPPLED_CC
+
+#undef UNI
+#undef LOP
+#define UNI(f) return uni(f,s)
+#define LOP(f) return lop(f,s)
+
+int
+uni(f,s)
+int f;
+char *s;
+{
+ yylval.ival = f;
+ expectterm = TRUE;
+ bufptr = s;
+ last_uni = oldbufptr;
+ if (*s == '(')
+ return FUNC1;
+ s = skipspace(s);
+ if (*s == '(')
+ return FUNC1;
+ else
+ return UNIOP;
+}
+
+int
+lop(f,s)
+int f;
+char *s;
+{
+ CLINE;
+ if (*s != '(')
+ s = skipspace(s);
+ if (*s == '(') {
+#ifdef atarist
+ *s = PERL_META('(');
+#else
+ *s = META('(');
+#endif
+ bufptr = oldbufptr;
+ return '(';
+ }
+ else {
+ yylval.ival=f;
+ expectterm = TRUE;
+ bufptr = s;
+ return LISTOP;
+ }
+}
+
+#endif /* CRIPPLED_CC */
+
+int
+yylex()
+{
+ register char *s = bufptr;
+ register char *d;
+ register int tmp;
+ static bool in_format = FALSE;
+ static bool firstline = TRUE;
+ extern int yychar; /* last token */
+
+ oldoldbufptr = oldbufptr;
+ oldbufptr = s;
+
+ retry:
+#ifdef YYDEBUG
+ if (debug & 1)
+ if (index(s,'\n'))
+ fprintf(stderr,"Tokener at %s",s);
+ else
+ fprintf(stderr,"Tokener at %s\n",s);
+#endif
+#ifdef BADSWITCH
+ if (*s & 128) {
+ if ((*s & 127) == '(') {
+ *s++ = '(';
+ oldbufptr = s;
+ }
+ else if ((*s & 127) == '}') {
+ *s++ = '}';
+ RETURN('}');
+ }
+ else
+ warn("Unrecognized character \\%03o ignored", *s++ & 255);
+ goto retry;
+ }
+#endif
+ switch (*s) {
+ default:
+ if ((*s & 127) == '(') {
+ *s++ = '(';
+ oldbufptr = s;
+ }
+ else if ((*s & 127) == '}') {
+ *s++ = '}';
+ RETURN('}');
+ }
+ else
+ warn("Unrecognized character \\%03o ignored", *s++ & 255);
+ goto retry;
+ case 4:
+ case 26:
+ goto fake_eof; /* emulate EOF on ^D or ^Z */
+ case 0:
+ if (!rsfp)
+ RETURN(0);
+ if (s++ < bufend)
+ goto retry; /* ignore stray nulls */
+ last_uni = 0;
+ if (firstline) {
+ firstline = FALSE;
+ if (minus_n || minus_p || perldb) {
+ str_set(linestr,"");
+ if (perldb) {
+ char *getenv();
+ char *pdb = getenv("PERLDB");
+
+ str_cat(linestr, pdb ? pdb : "require 'perldb.pl'");
+ str_cat(linestr, ";");
+ }
+ if (minus_n || minus_p) {
+ str_cat(linestr,"line: while (<>) {");
+ if (minus_l)
+ str_cat(linestr,"chop;");
+ if (minus_a)
+ str_cat(linestr,"@F=split(' ');");
+ }
+ oldoldbufptr = oldbufptr = s = str_get(linestr);
+ bufend = linestr->str_ptr + linestr->str_cur;
+ goto retry;
+ }
+ }
+ if (in_format) {
+ bufptr = bufend;
+ yylval.formval = load_format();
+ in_format = FALSE;
+ oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
+ bufend = linestr->str_ptr + linestr->str_cur;
+ OPERATOR(FORMLIST);
+ }
+ curcmd->c_line++;
+#ifdef CRYPTSCRIPT
+ cryptswitch();
+#endif /* CRYPTSCRIPT */
+ do {
+ if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
+ fake_eof:
+ if (rsfp) {
+ if (preprocess)
+ (void)mypclose(rsfp);
+ else if ((FILE*)rsfp == stdin)
+ clearerr(stdin);
+ else
+ (void)fclose(rsfp);
+ rsfp = Nullfp;
+ }
+ if (minus_n || minus_p) {
+ str_set(linestr,minus_p ? ";}continue{print" : "");
+ str_cat(linestr,";}");
+ oldoldbufptr = oldbufptr = s = str_get(linestr);
+ bufend = linestr->str_ptr + linestr->str_cur;
+ minus_n = minus_p = 0;
+ goto retry;
+ }
+ oldoldbufptr = oldbufptr = s = str_get(linestr);
+ str_set(linestr,"");
+ RETURN(';'); /* not infinite loop because rsfp is NULL now */
+ }
+ if (doextract && *linestr->str_ptr == '#')
+ doextract = FALSE;
+ } while (doextract);
+ oldoldbufptr = oldbufptr = bufptr = s;
+ if (perldb) {
+ STR *str = Str_new(85,0);
+
+ str_sset(str,linestr);
+ astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
+ }
+#ifdef DEBUG
+ if (firstline) {
+ char *showinput();
+ s = showinput();
+ }
+#endif
+ bufend = linestr->str_ptr + linestr->str_cur;
+ if (curcmd->c_line == 1) {
+ if (*s == '#' && s[1] == '!') {
+ if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
+ char **newargv;
+ char *cmd;
+
+ s += 2;
+ if (*s == ' ')
+ s++;
+ cmd = s;
+ while (s < bufend && !isSPACE(*s))
+ s++;
+ *s++ = '\0';
+ while (s < bufend && isSPACE(*s))
+ s++;
+ if (s < bufend) {
+ Newz(899,newargv,origargc+3,char*);
+ newargv[1] = s;
+ while (s < bufend && !isSPACE(*s))
+ s++;
+ *s = '\0';
+ Copy(origargv+1, newargv+2, origargc+1, char*);
+ }
+ else
+ newargv = origargv;
+ newargv[0] = cmd;
+ execv(cmd,newargv);
+ fatal("Can't exec %s", cmd);
+ }
+ }
+ else {
+ while (s < bufend && isSPACE(*s))
+ s++;
+ if (*s == ':') /* for csh's that have to exec sh scripts */
+ s++;
+ }
+ }
+ goto retry;
+ case ' ': case '\t': case '\f': case '\r': case 013:
+ s++;
+ goto retry;
+ case '#':
+ if (preprocess && s == str_get(linestr) &&
+ s[1] == ' ' && (isDIGIT(s[2]) || strnEQ(s+2,"line ",5)) ) {
+ while (*s && !isDIGIT(*s))
+ s++;
+ curcmd->c_line = atoi(s)-1;
+ while (isDIGIT(*s))
+ s++;
+ d = bufend;
+ while (s < d && isSPACE(*s)) s++;
+ s[strlen(s)-1] = '\0'; /* wipe out newline */
+ if (*s == '"') {
+ s++;
+ s[strlen(s)-1] = '\0'; /* wipe out trailing quote */
+ }
+ if (*s)
+ curcmd->c_filestab = fstab(s);
+ else
+ curcmd->c_filestab = fstab(origfilename);
+ oldoldbufptr = oldbufptr = s = str_get(linestr);
+ }
+ /* FALL THROUGH */
+ case '\n':
+ if (in_eval && !rsfp) {
+ d = bufend;
+ while (s < d && *s != '\n')
+ s++;
+ if (s < d)
+ s++;
+ if (in_format) {
+ bufptr = s;
+ yylval.formval = load_format();
+ in_format = FALSE;
+ oldoldbufptr = oldbufptr = s = bufptr + 1;
+ TERM(FORMLIST);
+ }
+ curcmd->c_line++;
+ }
+ else {
+ *s = '\0';
+ bufend = s;
+ }
+ goto retry;
+ case '-':
+ if (s[1] && isALPHA(s[1]) && !isALPHA(s[2])) {
+ s++;
+ switch (*s++) {
+ case 'r': FTST(O_FTEREAD);
+ case 'w': FTST(O_FTEWRITE);
+ case 'x': FTST(O_FTEEXEC);
+ case 'o': FTST(O_FTEOWNED);
+ case 'R': FTST(O_FTRREAD);
+ case 'W': FTST(O_FTRWRITE);
+ case 'X': FTST(O_FTREXEC);
+ case 'O': FTST(O_FTROWNED);
+ case 'e': FTST(O_FTIS);
+ case 'z': FTST(O_FTZERO);
+ case 's': FTST(O_FTSIZE);
+ case 'f': FTST(O_FTFILE);
+ case 'd': FTST(O_FTDIR);
+ case 'l': FTST(O_FTLINK);
+ case 'p': FTST(O_FTPIPE);
+ case 'S': FTST(O_FTSOCK);
+ case 'u': FTST(O_FTSUID);
+ case 'g': FTST(O_FTSGID);
+ case 'k': FTST(O_FTSVTX);
+ case 'b': FTST(O_FTBLK);
+ case 'c': FTST(O_FTCHR);
+ case 't': FTST(O_FTTTY);
+ case 'T': FTST(O_FTTEXT);
+ case 'B': FTST(O_FTBINARY);
+ case 'M': stabent("\024",TRUE); FTST(O_FTMTIME);
+ case 'A': stabent("\024",TRUE); FTST(O_FTATIME);
+ case 'C': stabent("\024",TRUE); FTST(O_FTCTIME);
+ default:
+ s -= 2;
+ break;
+ }
+ }
+ tmp = *s++;
+ if (*s == tmp) {
+ s++;
+ RETURN(DEC);
+ }
+ if (expectterm) {
+ if (isSPACE(*s) || !isSPACE(*bufptr))
+ check_uni();
+ OPERATOR('-');
+ }
+ else
+ AOP(O_SUBTRACT);
+ case '+':
+ tmp = *s++;
+ if (*s == tmp) {
+ s++;
+ RETURN(INC);
+ }
+ if (expectterm) {
+ if (isSPACE(*s) || !isSPACE(*bufptr))
+ check_uni();
+ OPERATOR('+');
+ }
+ else
+ AOP(O_ADD);
+
+ case '*':
+ if (expectterm) {
+ check_uni();
+ s = scanident(s,bufend,tokenbuf);
+ yylval.stabval = stabent(tokenbuf,TRUE);
+ TERM(STAR);
+ }
+ tmp = *s++;
+ if (*s == tmp) {
+ s++;
+ OPERATOR(POW);
+ }
+ MOP(O_MULTIPLY);
+ case '%':
+ if (expectterm) {
+ if (!isALPHA(s[1]))
+ check_uni();
+ s = scanident(s,bufend,tokenbuf);
+ yylval.stabval = hadd(stabent(tokenbuf,TRUE));
+ TERM(HSH);
+ }
+ s++;
+ MOP(O_MODULO);
+
+ case '^':
+ case '~':
+ case '(':
+ case ',':
+ case ':':
+ case '[':
+ tmp = *s++;
+ OPERATOR(tmp);
+ case '{':
+ tmp = *s++;
+ yylval.ival = curcmd->c_line;
+ if (isSPACE(*s) || *s == '#')
+ cmdline = NOLINE; /* invalidate current command line number */
+ expectterm = 2;
+ RETURN(tmp);
+ case ';':
+ if (curcmd->c_line < cmdline)
+ cmdline = curcmd->c_line;
+ tmp = *s++;
+ OPERATOR(tmp);
+ case ')':
+ case ']':
+ tmp = *s++;
+ TERM(tmp);
+ case '}':
+ *s |= 128;
+ RETURN(';');
+ case '&':
+ s++;
+ tmp = *s++;
+ if (tmp == '&')
+ OPERATOR(ANDAND);
+ s--;
+ if (expectterm) {
+ d = bufend;
+ while (s < d && isSPACE(*s))
+ s++;
+ if (isALPHA(*s) || *s == '_' || *s == '\'')
+ *(--s) = '\\'; /* force next ident to WORD */
+ else
+ check_uni();
+ OPERATOR(AMPER);
+ }
+ OPERATOR('&');
+ case '|':
+ s++;
+ tmp = *s++;
+ if (tmp == '|')
+ OPERATOR(OROR);
+ s--;
+ OPERATOR('|');
+ case '=':
+ s++;
+ tmp = *s++;
+ if (tmp == '=')
+ EOP(O_EQ);
+ if (tmp == '~')
+ OPERATOR(MATCH);
+ s--;
+ OPERATOR('=');
+ case '!':
+ s++;
+ tmp = *s++;
+ if (tmp == '=')
+ EOP(O_NE);
+ if (tmp == '~')
+ OPERATOR(NMATCH);
+ s--;
+ OPERATOR('!');
+ case '<':
+ if (expectterm) {
+ if (s[1] != '<' && !index(s,'>'))
+ check_uni();
+ s = scanstr(s, SCAN_DEF);
+ TERM(RSTRING);
+ }
+ s++;
+ tmp = *s++;
+ if (tmp == '<')
+ OPERATOR(LS);
+ if (tmp == '=') {
+ tmp = *s++;
+ if (tmp == '>')
+ EOP(O_NCMP);
+ s--;
+ ROP(O_LE);
+ }
+ s--;
+ ROP(O_LT);
+ case '>':
+ s++;
+ tmp = *s++;
+ if (tmp == '>')
+ OPERATOR(RS);
+ if (tmp == '=')
+ ROP(O_GE);
+ s--;
+ ROP(O_GT);
+
+#define SNARFWORD \
+ d = tokenbuf; \
+ while (isALNUM(*s) || *s == '\'') \
+ *d++ = *s++; \
+ while (d[-1] == '\'') \
+ d--,s--; \
+ *d = '\0'; \
+ d = tokenbuf;
+
+ case '$':
+ if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) {
+ s++;
+ s = scanident(s,bufend,tokenbuf);
+ yylval.stabval = aadd(stabent(tokenbuf,TRUE));
+ TERM(ARYLEN);
+ }
+ d = s;
+ s = scanident(s,bufend,tokenbuf);
+ if (reparse) { /* turn ${foo[bar]} into ($foo[bar]) */
+ do_reparse:
+ s[-1] = ')';
+ s = d;
+ s[1] = s[0];
+ s[0] = '(';
+ goto retry;
+ }
+ yylval.stabval = stabent(tokenbuf,TRUE);
+ expectterm = FALSE;
+ if (isSPACE(*s) && oldoldbufptr && oldoldbufptr < bufptr) {
+ s++;
+ while (isSPACE(*oldoldbufptr))
+ oldoldbufptr++;
+ if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5)) {
+ if (index("&*<%", *s) && isALPHA(s[1]))
+ expectterm = TRUE; /* e.g. print $fh &sub */
+ else if (*s == '.' && isDIGIT(s[1]))
+ expectterm = TRUE; /* e.g. print $fh .3 */
+ else if (index("/?-+", *s) && !isSPACE(s[1]))
+ expectterm = TRUE; /* e.g. print $fh -1 */
+ }
+ }
+ RETURN(REG);
+
+ case '@':
+ d = s;
+ s = scanident(s,bufend,tokenbuf);
+ if (reparse)
+ goto do_reparse;
+ yylval.stabval = aadd(stabent(tokenbuf,TRUE));
+ TERM(ARY);
+
+ case '/': /* may either be division or pattern */
+ case '?': /* may either be conditional or pattern */
+ if (expectterm) {
+ check_uni();
+ s = scanpat(s);
+ TERM(PATTERN);
+ }
+ tmp = *s++;
+ if (tmp == '/')
+ MOP(O_DIVIDE);
+ OPERATOR(tmp);
+
+ case '.':
+ if (!expectterm || !isDIGIT(s[1])) {
+ tmp = *s++;
+ if (*s == tmp) {
+ s++;
+ if (*s == tmp) {
+ s++;
+ yylval.ival = 0;
+ }
+ else
+ yylval.ival = AF_COMMON;
+ OPERATOR(DOTDOT);
+ }
+ if (expectterm)
+ check_uni();
+ AOP(O_CONCAT);
+ }
+ /* FALL THROUGH */
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ case '\'': case '"': case '`':
+ s = scanstr(s, SCAN_DEF);
+ TERM(RSTRING);
+
+ case '\\': /* some magic to force next word to be a WORD */
+ s++; /* used by do and sub to force a separate namespace */
+ if (!isALPHA(*s) && *s != '_' && *s != '\'') {
+ warn("Spurious backslash ignored");
+ goto retry;
+ }
+ /* FALL THROUGH */
+ case '_':
+ SNARFWORD;
+ if (d[1] == '_') {
+ if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) {
+ ARG *arg = op_new(1);
+
+ yylval.arg = arg;
+ arg->arg_type = O_ITEM;
+ if (d[2] == 'L')
+ (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line);
+ else
+ strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr);
+ arg[1].arg_type = A_SINGLE;
+ arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
+ TERM(RSTRING);
+ }
+ else if (strEQ(d,"__END__")) {
+ STAB *stab;
+ int fd;
+
+ /*SUPPRESS 560*/
+ if (!in_eval && (stab = stabent("DATA",FALSE))) {
+ stab->str_pok |= SP_MULTI;
+ if (!stab_io(stab))
+ stab_io(stab) = stio_new();
+ stab_io(stab)->ifp = rsfp;
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+ fd = fileno(rsfp);
+ fcntl(fd,F_SETFD,fd >= 3);
+#endif
+ if (preprocess)
+ stab_io(stab)->type = '|';
+ else if ((FILE*)rsfp == stdin)
+ stab_io(stab)->type = '-';
+ else
+ stab_io(stab)->type = '<';
+ rsfp = Nullfp;
+ }
+ goto fake_eof;
+ }
+ }
+ break;
+ case 'a': case 'A':
+ SNARFWORD;
+ if (strEQ(d,"alarm"))
+ UNI(O_ALARM);
+ if (strEQ(d,"accept"))
+ FOP22(O_ACCEPT);
+ if (strEQ(d,"atan2"))
+ FUN2(O_ATAN2);
+ break;
+ case 'b': case 'B':
+ SNARFWORD;
+ if (strEQ(d,"bind"))
+ FOP2(O_BIND);
+ if (strEQ(d,"binmode"))
+ FOP(O_BINMODE);
+ break;
+ case 'c': case 'C':
+ SNARFWORD;
+ if (strEQ(d,"chop"))
+ LFUN(O_CHOP);
+ if (strEQ(d,"continue"))
+ OPERATOR(CONTINUE);
+ if (strEQ(d,"chdir")) {
+ (void)stabent("ENV",TRUE); /* may use HOME */
+ UNI(O_CHDIR);
+ }
+ if (strEQ(d,"close"))
+ FOP(O_CLOSE);
+ if (strEQ(d,"closedir"))
+ FOP(O_CLOSEDIR);
+ if (strEQ(d,"cmp"))
+ EOP(O_SCMP);
+ if (strEQ(d,"caller"))
+ UNI(O_CALLER);
+ if (strEQ(d,"crypt")) {
+#ifdef FCRYPT
+ static int cryptseen = 0;
+
+ if (!cryptseen++)
+ init_des();
+#endif
+ FUN2(O_CRYPT);
+ }
+ if (strEQ(d,"chmod"))
+ LOP(O_CHMOD);
+ if (strEQ(d,"chown"))
+ LOP(O_CHOWN);
+ if (strEQ(d,"connect"))
+ FOP2(O_CONNECT);
+ if (strEQ(d,"cos"))
+ UNI(O_COS);
+ if (strEQ(d,"chroot"))
+ UNI(O_CHROOT);
+ break;
+ case 'd': case 'D':
+ SNARFWORD;
+ if (strEQ(d,"do")) {
+ d = bufend;
+ while (s < d && isSPACE(*s))
+ s++;
+ if (isALPHA(*s) || *s == '_')
+ *(--s) = '\\'; /* force next ident to WORD */
+ OPERATOR(DO);
+ }
+ if (strEQ(d,"die"))
+ LOP(O_DIE);
+ if (strEQ(d,"defined"))
+ LFUN(O_DEFINED);
+ if (strEQ(d,"delete"))
+ OPERATOR(DELETE);
+ if (strEQ(d,"dbmopen"))
+ HFUN3(O_DBMOPEN);
+ if (strEQ(d,"dbmclose"))
+ HFUN(O_DBMCLOSE);
+ if (strEQ(d,"dump"))
+ LOOPX(O_DUMP);
+ break;
+ case 'e': case 'E':
+ SNARFWORD;
+ if (strEQ(d,"else"))
+ OPERATOR(ELSE);
+ if (strEQ(d,"elsif")) {
+ yylval.ival = curcmd->c_line;
+ OPERATOR(ELSIF);
+ }
+ if (strEQ(d,"eq") || strEQ(d,"EQ"))
+ EOP(O_SEQ);
+ if (strEQ(d,"exit"))
+ UNI(O_EXIT);
+ if (strEQ(d,"eval")) {
+ allstabs = TRUE; /* must initialize everything since */
+ UNI(O_EVAL); /* we don't know what will be used */
+ }
+ if (strEQ(d,"eof"))
+ FOP(O_EOF);
+ if (strEQ(d,"exp"))
+ UNI(O_EXP);
+ if (strEQ(d,"each"))
+ HFUN(O_EACH);
+ if (strEQ(d,"exec")) {
+ set_csh();
+ LOP(O_EXEC_OP);
+ }
+ if (strEQ(d,"endhostent"))
+ FUN0(O_EHOSTENT);
+ if (strEQ(d,"endnetent"))
+ FUN0(O_ENETENT);
+ if (strEQ(d,"endservent"))
+ FUN0(O_ESERVENT);
+ if (strEQ(d,"endprotoent"))
+ FUN0(O_EPROTOENT);
+ if (strEQ(d,"endpwent"))
+ FUN0(O_EPWENT);
+ if (strEQ(d,"endgrent"))
+ FUN0(O_EGRENT);
+ break;
+ case 'f': case 'F':
+ SNARFWORD;
+ if (strEQ(d,"for") || strEQ(d,"foreach")) {
+ yylval.ival = curcmd->c_line;
+ while (s < bufend && isSPACE(*s))
+ s++;
+ if (isALPHA(*s))
+ fatal("Missing $ on loop variable");
+ OPERATOR(FOR);
+ }
+ if (strEQ(d,"format")) {
+ d = bufend;
+ while (s < d && isSPACE(*s))
+ s++;
+ if (isALPHA(*s) || *s == '_')
+ *(--s) = '\\'; /* force next ident to WORD */
+ in_format = TRUE;
+ allstabs = TRUE; /* must initialize everything since */
+ OPERATOR(FORMAT); /* we don't know what will be used */
+ }
+ if (strEQ(d,"fork"))
+ FUN0(O_FORK);
+ if (strEQ(d,"fcntl"))
+ FOP3(O_FCNTL);
+ if (strEQ(d,"fileno"))
+ FOP(O_FILENO);
+ if (strEQ(d,"flock"))
+ FOP2(O_FLOCK);
+ break;
+ case 'g': case 'G':
+ SNARFWORD;
+ if (strEQ(d,"gt") || strEQ(d,"GT"))
+ ROP(O_SGT);
+ if (strEQ(d,"ge") || strEQ(d,"GE"))
+ ROP(O_SGE);
+ if (strEQ(d,"grep"))
+ FL2(O_GREP);
+ if (strEQ(d,"goto"))
+ LOOPX(O_GOTO);
+ if (strEQ(d,"gmtime"))
+ UNI(O_GMTIME);
+ if (strEQ(d,"getc"))
+ FOP(O_GETC);
+ if (strnEQ(d,"get",3)) {
+ d += 3;
+ if (*d == 'p') {
+ if (strEQ(d,"ppid"))
+ FUN0(O_GETPPID);
+ if (strEQ(d,"pgrp"))
+ UNI(O_GETPGRP);
+ if (strEQ(d,"priority"))
+ FUN2(O_GETPRIORITY);
+ if (strEQ(d,"protobyname"))
+ UNI(O_GPBYNAME);
+ if (strEQ(d,"protobynumber"))
+ FUN1(O_GPBYNUMBER);
+ if (strEQ(d,"protoent"))
+ FUN0(O_GPROTOENT);
+ if (strEQ(d,"pwent"))
+ FUN0(O_GPWENT);
+ if (strEQ(d,"pwnam"))
+ FUN1(O_GPWNAM);
+ if (strEQ(d,"pwuid"))
+ FUN1(O_GPWUID);
+ if (strEQ(d,"peername"))
+ FOP(O_GETPEERNAME);
+ }
+ else if (*d == 'h') {
+ if (strEQ(d,"hostbyname"))
+ UNI(O_GHBYNAME);
+ if (strEQ(d,"hostbyaddr"))
+ FUN2(O_GHBYADDR);
+ if (strEQ(d,"hostent"))
+ FUN0(O_GHOSTENT);
+ }
+ else if (*d == 'n') {
+ if (strEQ(d,"netbyname"))
+ UNI(O_GNBYNAME);
+ if (strEQ(d,"netbyaddr"))
+ FUN2(O_GNBYADDR);
+ if (strEQ(d,"netent"))
+ FUN0(O_GNETENT);
+ }
+ else if (*d == 's') {
+ if (strEQ(d,"servbyname"))
+ FUN2(O_GSBYNAME);
+ if (strEQ(d,"servbyport"))
+ FUN2(O_GSBYPORT);
+ if (strEQ(d,"servent"))
+ FUN0(O_GSERVENT);
+ if (strEQ(d,"sockname"))
+ FOP(O_GETSOCKNAME);
+ if (strEQ(d,"sockopt"))
+ FOP3(O_GSOCKOPT);
+ }
+ else if (*d == 'g') {
+ if (strEQ(d,"grent"))
+ FUN0(O_GGRENT);
+ if (strEQ(d,"grnam"))
+ FUN1(O_GGRNAM);
+ if (strEQ(d,"grgid"))
+ FUN1(O_GGRGID);
+ }
+ else if (*d == 'l') {
+ if (strEQ(d,"login"))
+ FUN0(O_GETLOGIN);
+ }
+ d -= 3;
+ }
+ break;
+ case 'h': case 'H':
+ SNARFWORD;
+ if (strEQ(d,"hex"))
+ UNI(O_HEX);
+ break;
+ case 'i': case 'I':
+ SNARFWORD;
+ if (strEQ(d,"if")) {
+ yylval.ival = curcmd->c_line;
+ OPERATOR(IF);
+ }
+ if (strEQ(d,"index"))
+ FUN2x(O_INDEX);
+ if (strEQ(d,"int"))
+ UNI(O_INT);
+ if (strEQ(d,"ioctl"))
+ FOP3(O_IOCTL);
+ break;
+ case 'j': case 'J':
+ SNARFWORD;
+ if (strEQ(d,"join"))
+ FL2(O_JOIN);
+ break;
+ case 'k': case 'K':
+ SNARFWORD;
+ if (strEQ(d,"keys"))
+ HFUN(O_KEYS);
+ if (strEQ(d,"kill"))
+ LOP(O_KILL);
+ break;
+ case 'l': case 'L':
+ SNARFWORD;
+ if (strEQ(d,"last"))
+ LOOPX(O_LAST);
+ if (strEQ(d,"local"))
+ OPERATOR(LOCAL);
+ if (strEQ(d,"length"))
+ UNI(O_LENGTH);
+ if (strEQ(d,"lt") || strEQ(d,"LT"))
+ ROP(O_SLT);
+ if (strEQ(d,"le") || strEQ(d,"LE"))
+ ROP(O_SLE);
+ if (strEQ(d,"localtime"))
+ UNI(O_LOCALTIME);
+ if (strEQ(d,"log"))
+ UNI(O_LOG);
+ if (strEQ(d,"link"))
+ FUN2(O_LINK);
+ if (strEQ(d,"listen"))
+ FOP2(O_LISTEN);
+ if (strEQ(d,"lstat"))
+ FOP(O_LSTAT);
+ break;
+ case 'm': case 'M':
+ if (s[1] == '\'') {
+ d = "m";
+ s++;
+ }
+ else {
+ SNARFWORD;
+ }
+ if (strEQ(d,"m")) {
+ s = scanpat(s-1);
+ if (yylval.arg)
+ TERM(PATTERN);
+ else
+ RETURN(1); /* force error */
+ }
+ switch (d[1]) {
+ case 'k':
+ if (strEQ(d,"mkdir"))
+ FUN2(O_MKDIR);
+ break;
+ case 's':
+ if (strEQ(d,"msgctl"))
+ FUN3(O_MSGCTL);
+ if (strEQ(d,"msgget"))
+ FUN2(O_MSGGET);
+ if (strEQ(d,"msgrcv"))
+ FUN5(O_MSGRCV);
+ if (strEQ(d,"msgsnd"))
+ FUN3(O_MSGSND);
+ break;
+ }
+ break;
+ case 'n': case 'N':
+ SNARFWORD;
+ if (strEQ(d,"next"))
+ LOOPX(O_NEXT);
+ if (strEQ(d,"ne") || strEQ(d,"NE"))
+ EOP(O_SNE);
+ break;
+ case 'o': case 'O':
+ SNARFWORD;
+ if (strEQ(d,"open"))
+ OPERATOR(OPEN);
+ if (strEQ(d,"ord"))
+ UNI(O_ORD);
+ if (strEQ(d,"oct"))
+ UNI(O_OCT);
+ if (strEQ(d,"opendir"))
+ FOP2(O_OPEN_DIR);
+ break;
+ case 'p': case 'P':
+ SNARFWORD;
+ if (strEQ(d,"print")) {
+ checkcomma(s,d,"filehandle");
+ LOP(O_PRINT);
+ }
+ if (strEQ(d,"printf")) {
+ checkcomma(s,d,"filehandle");
+ LOP(O_PRTF);
+ }
+ if (strEQ(d,"push")) {
+ yylval.ival = O_PUSH;
+ OPERATOR(PUSH);
+ }
+ if (strEQ(d,"pop"))
+ OPERATOR(POP);
+ if (strEQ(d,"pack"))
+ FL2(O_PACK);
+ if (strEQ(d,"package"))
+ OPERATOR(PACKAGE);
+ if (strEQ(d,"pipe"))
+ FOP22(O_PIPE_OP);
+ break;
+ case 'q': case 'Q':
+ SNARFWORD;
+ if (strEQ(d,"q")) {
+ s = scanstr(s-1, SCAN_DEF);
+ TERM(RSTRING);
+ }
+ if (strEQ(d,"qq")) {
+ s = scanstr(s-2, SCAN_DEF);
+ TERM(RSTRING);
+ }
+ if (strEQ(d,"qx")) {
+ s = scanstr(s-2, SCAN_DEF);
+ TERM(RSTRING);
+ }
+ break;
+ case 'r': case 'R':
+ SNARFWORD;
+ if (strEQ(d,"return"))
+ OLDLOP(O_RETURN);
+ if (strEQ(d,"require")) {
+ allstabs = TRUE; /* must initialize everything since */
+ UNI(O_REQUIRE); /* we don't know what will be used */
+ }
+ if (strEQ(d,"reset"))
+ UNI(O_RESET);
+ if (strEQ(d,"redo"))
+ LOOPX(O_REDO);
+ if (strEQ(d,"rename"))
+ FUN2(O_RENAME);
+ if (strEQ(d,"rand"))
+ UNI(O_RAND);
+ if (strEQ(d,"rmdir"))
+ UNI(O_RMDIR);
+ if (strEQ(d,"rindex"))
+ FUN2x(O_RINDEX);
+ if (strEQ(d,"read"))
+ FOP3(O_READ);
+ if (strEQ(d,"readdir"))
+ FOP(O_READDIR);
+ if (strEQ(d,"rewinddir"))
+ FOP(O_REWINDDIR);
+ if (strEQ(d,"recv"))
+ FOP4(O_RECV);
+ if (strEQ(d,"reverse"))
+ LOP(O_REVERSE);
+ if (strEQ(d,"readlink"))
+ UNI(O_READLINK);
+ break;
+ case 's': case 'S':
+ if (s[1] == '\'') {
+ d = "s";
+ s++;
+ }
+ else {
+ SNARFWORD;
+ }
+ if (strEQ(d,"s")) {
+ s = scansubst(s);
+ if (yylval.arg)
+ TERM(SUBST);
+ else
+ RETURN(1); /* force error */
+ }
+ switch (d[1]) {
+ case 'a':
+ case 'b':
+ break;
+ case 'c':
+ if (strEQ(d,"scalar"))
+ UNI(O_SCALAR);
+ break;
+ case 'd':
+ break;
+ case 'e':
+ if (strEQ(d,"select"))
+ OPERATOR(SSELECT);
+ if (strEQ(d,"seek"))
+ FOP3(O_SEEK);
+ if (strEQ(d,"semctl"))
+ FUN4(O_SEMCTL);
+ if (strEQ(d,"semget"))
+ FUN3(O_SEMGET);
+ if (strEQ(d,"semop"))
+ FUN2(O_SEMOP);
+ if (strEQ(d,"send"))
+ FOP3(O_SEND);
+ if (strEQ(d,"setpgrp"))
+ FUN2(O_SETPGRP);
+ if (strEQ(d,"setpriority"))
+ FUN3(O_SETPRIORITY);
+ if (strEQ(d,"sethostent"))
+ FUN1(O_SHOSTENT);
+ if (strEQ(d,"setnetent"))
+ FUN1(O_SNETENT);
+ if (strEQ(d,"setservent"))
+ FUN1(O_SSERVENT);
+ if (strEQ(d,"setprotoent"))
+ FUN1(O_SPROTOENT);
+ if (strEQ(d,"setpwent"))
+ FUN0(O_SPWENT);
+ if (strEQ(d,"setgrent"))
+ FUN0(O_SGRENT);
+ if (strEQ(d,"seekdir"))
+ FOP2(O_SEEKDIR);
+ if (strEQ(d,"setsockopt"))
+ FOP4(O_SSOCKOPT);
+ break;
+ case 'f':
+ case 'g':
+ break;
+ case 'h':
+ if (strEQ(d,"shift"))
+ TERM(SHIFT);
+ if (strEQ(d,"shmctl"))
+ FUN3(O_SHMCTL);
+ if (strEQ(d,"shmget"))
+ FUN3(O_SHMGET);
+ if (strEQ(d,"shmread"))
+ FUN4(O_SHMREAD);
+ if (strEQ(d,"shmwrite"))
+ FUN4(O_SHMWRITE);
+ if (strEQ(d,"shutdown"))
+ FOP2(O_SHUTDOWN);
+ break;
+ case 'i':
+ if (strEQ(d,"sin"))
+ UNI(O_SIN);
+ break;
+ case 'j':
+ case 'k':
+ break;
+ case 'l':
+ if (strEQ(d,"sleep"))
+ UNI(O_SLEEP);
+ break;
+ case 'm':
+ case 'n':
+ break;
+ case 'o':
+ if (strEQ(d,"socket"))
+ FOP4(O_SOCKET);
+ if (strEQ(d,"socketpair"))
+ FOP25(O_SOCKPAIR);
+ if (strEQ(d,"sort")) {
+ checkcomma(s,d,"subroutine name");
+ d = bufend;
+ while (s < d && isSPACE(*s)) s++;
+ if (*s == ';' || *s == ')') /* probably a close */
+ fatal("sort is now a reserved word");
+ if (isALPHA(*s) || *s == '_') {
+ /*SUPPRESS 530*/
+ for (d = s; isALNUM(*d); d++) ;
+ strncpy(tokenbuf,s,d-s);
+ tokenbuf[d-s] = '\0';
+ if (strNE(tokenbuf,"keys") &&
+ strNE(tokenbuf,"values") &&
+ strNE(tokenbuf,"split") &&
+ strNE(tokenbuf,"grep") &&
+ strNE(tokenbuf,"readdir") &&
+ strNE(tokenbuf,"unpack") &&
+ strNE(tokenbuf,"do") &&
+ strNE(tokenbuf,"eval") &&
+ (d >= bufend || isSPACE(*d)) )
+ *(--s) = '\\'; /* force next ident to WORD */
+ }
+ LOP(O_SORT);
+ }
+ break;
+ case 'p':
+ if (strEQ(d,"split"))
+ TERM(SPLIT);
+ if (strEQ(d,"sprintf"))
+ FL(O_SPRINTF);
+ if (strEQ(d,"splice")) {
+ yylval.ival = O_SPLICE;
+ OPERATOR(PUSH);
+ }
+ break;
+ case 'q':
+ if (strEQ(d,"sqrt"))
+ UNI(O_SQRT);
+ break;
+ case 'r':
+ if (strEQ(d,"srand"))
+ UNI(O_SRAND);
+ break;
+ case 's':
+ break;
+ case 't':
+ if (strEQ(d,"stat"))
+ FOP(O_STAT);
+ if (strEQ(d,"study")) {
+ sawstudy++;
+ LFUN(O_STUDY);
+ }
+ break;
+ case 'u':
+ if (strEQ(d,"substr"))
+ FUN2x(O_SUBSTR);
+ if (strEQ(d,"sub")) {
+ yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
+ savelong(&subline);
+ saveitem(subname);
+
+ subline = curcmd->c_line;
+ d = bufend;
+ while (s < d && isSPACE(*s))
+ s++;
+ if (isALPHA(*s) || *s == '_' || *s == '\'') {
+ str_sset(subname,curstname);
+ str_ncat(subname,"'",1);
+ for (d = s+1; isALNUM(*d) || *d == '\''; d++)
+ /*SUPPRESS 530*/
+ ;
+ if (d[-1] == '\'')
+ d--;
+ str_ncat(subname,s,d-s);
+ *(--s) = '\\'; /* force next ident to WORD */
+ }
+ else
+ str_set(subname,"?");
+ OPERATOR(SUB);
+ }
+ break;
+ case 'v':
+ case 'w':
+ case 'x':
+ break;
+ case 'y':
+ if (strEQ(d,"system")) {
+ set_csh();
+ LOP(O_SYSTEM);
+ }
+ if (strEQ(d,"symlink"))
+ FUN2(O_SYMLINK);
+ if (strEQ(d,"syscall"))
+ LOP(O_SYSCALL);
+ if (strEQ(d,"sysread"))
+ FOP3(O_SYSREAD);
+ if (strEQ(d,"syswrite"))
+ FOP3(O_SYSWRITE);
+ break;
+ case 'z':
+ break;
+ }
+ break;
+ case 't': case 'T':
+ SNARFWORD;
+ if (strEQ(d,"tr")) {
+ s = scantrans(s);
+ if (yylval.arg)
+ TERM(TRANS);
+ else
+ RETURN(1); /* force error */
+ }
+ if (strEQ(d,"tell"))
+ FOP(O_TELL);
+ if (strEQ(d,"telldir"))
+ FOP(O_TELLDIR);
+ if (strEQ(d,"time"))
+ FUN0(O_TIME);
+ if (strEQ(d,"times"))
+ FUN0(O_TMS);
+ if (strEQ(d,"truncate"))
+ FOP2(O_TRUNCATE);
+ break;
+ case 'u': case 'U':
+ SNARFWORD;
+ if (strEQ(d,"using"))
+ OPERATOR(USING);
+ if (strEQ(d,"until")) {
+ yylval.ival = curcmd->c_line;
+ OPERATOR(UNTIL);
+ }
+ if (strEQ(d,"unless")) {
+ yylval.ival = curcmd->c_line;
+ OPERATOR(UNLESS);
+ }
+ if (strEQ(d,"unlink"))
+ LOP(O_UNLINK);
+ if (strEQ(d,"undef"))
+ LFUN(O_UNDEF);
+ if (strEQ(d,"unpack"))
+ FUN2(O_UNPACK);
+ if (strEQ(d,"utime"))
+ LOP(O_UTIME);
+ if (strEQ(d,"umask"))
+ UNI(O_UMASK);
+ if (strEQ(d,"unshift")) {
+ yylval.ival = O_UNSHIFT;
+ OPERATOR(PUSH);
+ }
+ break;
+ case 'v': case 'V':
+ SNARFWORD;
+ if (strEQ(d,"values"))
+ HFUN(O_VALUES);
+ if (strEQ(d,"vec")) {
+ sawvec = TRUE;
+ FUN3(O_VEC);
+ }
+ break;
+ case 'w': case 'W':
+ SNARFWORD;
+ if (strEQ(d,"while")) {
+ yylval.ival = curcmd->c_line;
+ OPERATOR(WHILE);
+ }
+ if (strEQ(d,"warn"))
+ LOP(O_WARN);
+ if (strEQ(d,"wait"))
+ FUN0(O_WAIT);
+ if (strEQ(d,"waitpid"))
+ FUN2(O_WAITPID);
+ if (strEQ(d,"wantarray")) {
+ yylval.arg = op_new(1);
+ yylval.arg->arg_type = O_ITEM;
+ yylval.arg[1].arg_type = A_WANTARRAY;
+ TERM(RSTRING);
+ }
+ if (strEQ(d,"write"))
+ FOP(O_WRITE);
+ break;
+ case 'x': case 'X':
+ if (*s == 'x' && isDIGIT(s[1]) && !expectterm) {
+ s++;
+ MOP(O_REPEAT);
+ }
+ SNARFWORD;
+ if (strEQ(d,"x")) {
+ if (!expectterm)
+ MOP(O_REPEAT);
+ check_uni();
+ }
+ break;
+ case 'y': case 'Y':
+ if (s[1] == '\'') {
+ d = "y";
+ s++;
+ }
+ else {
+ SNARFWORD;
+ }
+ if (strEQ(d,"y")) {
+ s = scantrans(s);
+ TERM(TRANS);
+ }
+ break;
+ case 'z': case 'Z':
+ SNARFWORD;
+ break;
+ }
+ yylval.cval = savestr(d);
+ if (expectterm == 2) { /* special case: start of statement */
+ while (isSPACE(*s)) s++;
+ if (*s == ':') {
+ s++;
+ CLINE;
+ OPERATOR(LABEL);
+ }
+ TERM(WORD);
+ }
+ expectterm = FALSE;
+ if (oldoldbufptr && oldoldbufptr < bufptr) {
+ while (isSPACE(*oldoldbufptr))
+ oldoldbufptr++;
+ if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
+ expectterm = TRUE;
+ else if (*oldoldbufptr == 's' && strnEQ(oldoldbufptr,"sort",4))
+ expectterm = TRUE;
+ }
+ return (CLINE, bufptr = s, (int)WORD);
+}
+
+void
+checkcomma(s,name,what)
+register char *s;
+char *name;
+char *what;
+{
+ char *w;
+
+ if (dowarn && *s == ' ' && s[1] == '(') {
+ w = index(s,')');
+ if (w)
+ for (w++; *w && isSPACE(*w); w++) ;
+ if (!w || !*w || !index(";|}", *w)) /* an advisory hack only... */
+ warn("%s (...) interpreted as function",name);
+ }
+ while (s < bufend && isSPACE(*s))
+ s++;
+ if (*s == '(')
+ s++;
+ while (s < bufend && isSPACE(*s))
+ s++;
+ if (isALPHA(*s) || *s == '_') {
+ w = s++;
+ while (isALNUM(*s))
+ s++;
+ while (s < bufend && isSPACE(*s))
+ s++;
+ if (*s == ',') {
+ *s = '\0';
+ w = instr(
+ "tell eof times getlogin wait length shift umask getppid \
+ cos exp int log rand sin sqrt ord wantarray",
+ w);
+ *s = ',';
+ if (w)
+ return;
+ fatal("No comma allowed after %s", what);
+ }
+ }
+}
+
+char *
+scanident(s,send,dest)
+register char *s;
+register char *send;
+char *dest;
+{
+ register char *d;
+ int brackets = 0;
+
+ reparse = Nullch;
+ s++;
+ d = dest;
+ if (isDIGIT(*s)) {
+ while (isDIGIT(*s))
+ *d++ = *s++;
+ }
+ else {
+ while (isALNUM(*s) || *s == '\'')
+ *d++ = *s++;
+ }
+ while (d > dest+1 && d[-1] == '\'')
+ d--,s--;
+ *d = '\0';
+ d = dest;
+ if (!*d) {
+ *d = *s++;
+ if (*d == '{' /* } */ ) {
+ d = dest;
+ brackets++;
+ while (s < send && brackets) {
+ if (!reparse && (d == dest || (*s && isALNUM(*s) ))) {
+ *d++ = *s++;
+ continue;
+ }
+ else if (!reparse)
+ reparse = s;
+ switch (*s++) {
+ /* { */
+ case '}':
+ brackets--;
+ if (reparse && reparse == s - 1)
+ reparse = Nullch;
+ break;
+ case '{': /* } */
+ brackets++;
+ break;
+ }
+ }
+ *d = '\0';
+ d = dest;
+ }
+ else
+ d[1] = '\0';
+ }
+ if (*d == '^' && (isUPPER(*s) || index("[\\]^_?", *s))) {
+#ifdef DEBUGGING
+ if (*s == 'D')
+ debug |= 32768;
+#endif
+ *d = *s++ ^ 64;
+ }
+ return s;
+}
+
+void
+scanconst(spat,string,len)
+SPAT *spat;
+char *string;
+int len;
+{
+ register STR *tmpstr;
+ register char *t;
+ register char *d;
+ register char *e;
+ char *origstring = string;
+ static char *vert = "|";
+
+ if (ninstr(string, string+len, vert, vert+1))
+ return;
+ if (*string == '^')
+ string++, len--;
+ tmpstr = Str_new(86,len);
+ str_nset(tmpstr,string,len);
+ t = str_get(tmpstr);
+ e = t + len;
+ tmpstr->str_u.str_useful = 100;
+ for (d=t; d < e; ) {
+ switch (*d) {
+ case '{':
+ if (isDIGIT(d[1]))
+ e = d;
+ else
+ goto defchar;
+ break;
+ case '.': case '[': case '$': case '(': case ')': case '|': case '+':
+ case '^':
+ e = d;
+ break;
+ case '\\':
+ if (d[1] && index("wWbB0123456789sSdDlLuUExc",d[1])) {
+ e = d;
+ break;
+ }
+ Move(d+1,d,e-d,char);
+ e--;
+ switch(*d) {
+ case 'n':
+ *d = '\n';
+ break;
+ case 't':
+ *d = '\t';
+ break;
+ case 'f':
+ *d = '\f';
+ break;
+ case 'r':
+ *d = '\r';
+ break;
+ case 'e':
+ *d = '\033';
+ break;
+ case 'a':
+ *d = '\007';
+ break;
+ }
+ /* FALL THROUGH */
+ default:
+ defchar:
+ if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
+ e = d;
+ break;
+ }
+ d++;
+ }
+ }
+ if (d == t) {
+ str_free(tmpstr);
+ return;
+ }
+ *d = '\0';
+ tmpstr->str_cur = d - t;
+ if (d == t+len)
+ spat->spat_flags |= SPAT_ALL;
+ if (*origstring != '^')
+ spat->spat_flags |= SPAT_SCANFIRST;
+ spat->spat_short = tmpstr;
+ spat->spat_slen = d - t;
+}
+
+char *
+scanpat(s)
+register char *s;
+{
+ register SPAT *spat;
+ register char *d;
+ register char *e;
+ int len;
+ SPAT savespat;
+ STR *str = Str_new(93,0);
+ char delim;
+
+ Newz(801,spat,1,SPAT);
+ spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
+ curstash->tbl_spatroot = spat;
+
+ switch (*s++) {
+ case 'm':
+ s++;
+ break;
+ case '/':
+ break;
+ case '?':
+ spat->spat_flags |= SPAT_ONCE;
+ break;
+ default:
+ fatal("panic: scanpat");
+ }
+ s = str_append_till(str,s,bufend,s[-1],patleave);
+ if (s >= bufend) {
+ str_free(str);
+ yyerror("Search pattern not terminated");
+ yylval.arg = Nullarg;
+ return s;
+ }
+ delim = *s++;
+ while (*s == 'i' || *s == 'o' || *s == 'g') {
+ if (*s == 'i') {
+ s++;
+ sawi = TRUE;
+ spat->spat_flags |= SPAT_FOLD;
+ }
+ if (*s == 'o') {
+ s++;
+ spat->spat_flags |= SPAT_KEEP;
+ }
+ if (*s == 'g') {
+ s++;
+ spat->spat_flags |= SPAT_GLOBAL;
+ }
+ }
+ len = str->str_cur;
+ e = str->str_ptr + len;
+ if (delim == '\'')
+ d = e;
+ else
+ d = str->str_ptr;
+ for (; d < e; d++) {
+ if (*d == '\\')
+ d++;
+ else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
+ (*d == '@')) {
+ register ARG *arg;
+
+ spat->spat_runtime = arg = op_new(1);
+ arg->arg_type = O_ITEM;
+ arg[1].arg_type = A_DOUBLE;
+ arg[1].arg_ptr.arg_str = str_smake(str);
+ d = scanident(d,bufend,buf);
+ (void)stabent(buf,TRUE); /* make sure it's created */
+ for (; d < e; d++) {
+ if (*d == '\\')
+ d++;
+ else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') {
+ d = scanident(d,bufend,buf);
+ (void)stabent(buf,TRUE);
+ }
+ else if (*d == '@') {
+ d = scanident(d,bufend,buf);
+ if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
+ strEQ(buf,"SIG") || strEQ(buf,"INC"))
+ (void)stabent(buf,TRUE);
+ }
+ }
+ goto got_pat; /* skip compiling for now */
+ }
+ }
+ if (spat->spat_flags & SPAT_FOLD)
+ StructCopy(spat, &savespat, SPAT);
+ scanconst(spat,str->str_ptr,len);
+ if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
+ fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
+ spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
+ spat->spat_flags & SPAT_FOLD);
+ /* Note that this regexp can still be used if someone says
+ * something like /a/ && s//b/; so we can't delete it.
+ */
+ }
+ else {
+ if (spat->spat_flags & SPAT_FOLD)
+ StructCopy(&savespat, spat, SPAT);
+ if (spat->spat_short)
+ fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
+ spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
+ spat->spat_flags & SPAT_FOLD);
+ hoistmust(spat);
+ }
+ got_pat:
+ str_free(str);
+ yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
+ return s;
+}
+
+char *
+scansubst(start)
+char *start;
+{
+ register char *s = start;
+ register SPAT *spat;
+ register char *d;
+ register char *e;
+ int len;
+ STR *str = Str_new(93,0);
+ char term = *s;
+
+ if (term && (d = index("([{< )]}> )]}>",term)))
+ term = d[5];
+
+ Newz(802,spat,1,SPAT);
+ spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
+ curstash->tbl_spatroot = spat;
+
+ s = str_append_till(str,s+1,bufend,term,patleave);
+ if (s >= bufend) {
+ str_free(str);
+ yyerror("Substitution pattern not terminated");
+ yylval.arg = Nullarg;
+ return s;
+ }
+ len = str->str_cur;
+ e = str->str_ptr + len;
+ for (d = str->str_ptr; d < e; d++) {
+ if (*d == '\\')
+ d++;
+ else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') ||
+ *d == '@' ) {
+ register ARG *arg;
+
+ spat->spat_runtime = arg = op_new(1);
+ arg->arg_type = O_ITEM;
+ arg[1].arg_type = A_DOUBLE;
+ arg[1].arg_ptr.arg_str = str_smake(str);
+ d = scanident(d,e,buf);
+ (void)stabent(buf,TRUE); /* make sure it's created */
+ for (; *d; d++) {
+ if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
+ d = scanident(d,e,buf);
+ (void)stabent(buf,TRUE);
+ }
+ else if (*d == '@' && d[-1] != '\\') {
+ d = scanident(d,e,buf);
+ if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
+ strEQ(buf,"SIG") || strEQ(buf,"INC"))
+ (void)stabent(buf,TRUE);
+ }
+ }
+ goto get_repl; /* skip compiling for now */
+ }
+ }
+ scanconst(spat,str->str_ptr,len);
+get_repl:
+ if (term != *start)
+ s++;
+ s = scanstr(s, SCAN_REPL);
+ if (s >= bufend) {
+ str_free(str);
+ yyerror("Substitution replacement not terminated");
+ yylval.arg = Nullarg;
+ return s;
+ }
+ spat->spat_repl = yylval.arg;
+ if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
+ spat->spat_flags |= SPAT_CONST;
+ else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
+ STR *tmpstr;
+ register char *t;
+
+ spat->spat_flags |= SPAT_CONST;
+ tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
+ e = tmpstr->str_ptr + tmpstr->str_cur;
+ for (t = tmpstr->str_ptr; t < e; t++) {
+ if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
+ (t[1] == '{' /*}*/ && isDIGIT(t[2])) ))
+ spat->spat_flags &= ~SPAT_CONST;
+ }
+ }
+ while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
+ int es = 0;
+
+ if (*s == 'e') {
+ s++;
+ es++;
+ if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
+ spat->spat_repl[1].arg_type = A_SINGLE;
+ spat->spat_repl = make_op(
+ (!es && spat->spat_repl[1].arg_type == A_SINGLE
+ ? O_EVALONCE
+ : O_EVAL),
+ 2,
+ spat->spat_repl,
+ Nullarg,
+ Nullarg);
+ spat->spat_flags &= ~SPAT_CONST;
+ }
+ if (*s == 'g') {
+ s++;
+ spat->spat_flags |= SPAT_GLOBAL;
+ }
+ if (*s == 'i') {
+ s++;
+ sawi = TRUE;
+ spat->spat_flags |= SPAT_FOLD;
+ if (!(spat->spat_flags & SPAT_SCANFIRST)) {
+ str_free(spat->spat_short); /* anchored opt doesn't do */
+ spat->spat_short = Nullstr; /* case insensitive match */
+ spat->spat_slen = 0;
+ }
+ }
+ if (*s == 'o') {
+ s++;
+ spat->spat_flags |= SPAT_KEEP;
+ }
+ }
+ if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
+ fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
+ if (!spat->spat_runtime) {
+ spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
+ spat->spat_flags & SPAT_FOLD);
+ hoistmust(spat);
+ }
+ yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
+ str_free(str);
+ return s;
+}
+
+void
+hoistmust(spat)
+register SPAT *spat;
+{
+ if (!spat->spat_short && spat->spat_regexp->regstart &&
+ (!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH)
+ ) {
+ if (!(spat->spat_regexp->reganch & ROPT_ANCH))
+ spat->spat_flags |= SPAT_SCANFIRST;
+ else if (spat->spat_flags & SPAT_FOLD)
+ return;
+ spat->spat_short = str_smake(spat->spat_regexp->regstart);
+ }
+ else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */
+ if (spat->spat_short &&
+ str_eq(spat->spat_short,spat->spat_regexp->regmust))
+ {
+ if (spat->spat_flags & SPAT_SCANFIRST) {
+ str_free(spat->spat_short);
+ spat->spat_short = Nullstr;
+ }
+ else {
+ str_free(spat->spat_regexp->regmust);
+ spat->spat_regexp->regmust = Nullstr;
+ return;
+ }
+ }
+ if (!spat->spat_short || /* promote the better string */
+ ((spat->spat_flags & SPAT_SCANFIRST) &&
+ (spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
+ str_free(spat->spat_short); /* ok if null */
+ spat->spat_short = spat->spat_regexp->regmust;
+ spat->spat_regexp->regmust = Nullstr;
+ spat->spat_flags |= SPAT_SCANFIRST;
+ }
+ }
+}
+
+char *
+scantrans(start)
+char *start;
+{
+ register char *s = start;
+ ARG *arg =
+ l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
+ STR *tstr;
+ STR *rstr;
+ register char *t;
+ register char *r;
+ register short *tbl;
+ register int i;
+ register int j;
+ int tlen, rlen;
+ int squash;
+ int delete;
+ int complement;
+
+ New(803,tbl,256,short);
+ arg[2].arg_type = A_NULL;
+ arg[2].arg_ptr.arg_cval = (char*) tbl;
+
+ s = scanstr(s, SCAN_TR);
+ if (s >= bufend) {
+ yyerror("Translation pattern not terminated");
+ yylval.arg = Nullarg;
+ return s;
+ }
+ tstr = yylval.arg[1].arg_ptr.arg_str;
+ yylval.arg[1].arg_ptr.arg_str = Nullstr;
+ arg_free(yylval.arg);
+ t = tstr->str_ptr;
+ tlen = tstr->str_cur;
+
+ if (s[-1] == *start)
+ s--;
+
+ s = scanstr(s, SCAN_TR|SCAN_REPL);
+ if (s >= bufend) {
+ yyerror("Translation replacement not terminated");
+ yylval.arg = Nullarg;
+ return s;
+ }
+ rstr = yylval.arg[1].arg_ptr.arg_str;
+ yylval.arg[1].arg_ptr.arg_str = Nullstr;
+ arg_free(yylval.arg);
+ r = rstr->str_ptr;
+ rlen = rstr->str_cur;
+
+ complement = delete = squash = 0;
+ while (*s == 'c' || *s == 'd' || *s == 's') {
+ if (*s == 'c')
+ complement = 1;
+ else if (*s == 'd')
+ delete = 2;
+ else
+ squash = 1;
+ s++;
+ }
+ arg[2].arg_len = delete|squash;
+ yylval.arg = arg;
+ if (complement) {
+ Zero(tbl, 256, short);
+ for (i = 0; i < tlen; i++)
+ tbl[t[i] & 0377] = -1;
+ for (i = 0, j = 0; i < 256; i++) {
+ if (!tbl[i]) {
+ if (j >= rlen) {
+ if (delete)
+ tbl[i] = -2;
+ else if (rlen)
+ tbl[i] = r[j-1] & 0377;
+ else
+ tbl[i] = i;
+ }
+ else
+ tbl[i] = r[j++] & 0377;
+ }
+ }
+ }
+ else {
+ if (!rlen && !delete) {
+ r = t; rlen = tlen;
+ }
+ for (i = 0; i < 256; i++)
+ tbl[i] = -1;
+ for (i = 0, j = 0; i < tlen; i++,j++) {
+ if (j >= rlen) {
+ if (delete) {
+ if (tbl[t[i] & 0377] == -1)
+ tbl[t[i] & 0377] = -2;
+ continue;
+ }
+ --j;
+ }
+ if (tbl[t[i] & 0377] == -1)
+ tbl[t[i] & 0377] = r[j] & 0377;
+ }
+ }
+ str_free(tstr);
+ str_free(rstr);
+ return s;
+}
+
+char *
+scanstr(start, in_what)
+char *start;
+int in_what;
+{
+ register char *s = start;
+ register char term;
+ register char *d;
+ register ARG *arg;
+ register char *send;
+ register bool makesingle = FALSE;
+ register STAB *stab;
+ bool alwaysdollar = FALSE;
+ bool hereis = FALSE;
+ STR *herewas;
+ STR *str;
+ /* which backslash sequences to keep */
+ char *leave = (in_what & SCAN_TR)
+ ? "\\$@nrtfbeacx0123456789-"
+ : "\\$@nrtfbeacx0123456789[{]}lLuUE";
+ int len;
+
+ arg = op_new(1);
+ yylval.arg = arg;
+ arg->arg_type = O_ITEM;
+
+ switch (*s) {
+ default: /* a substitution replacement */
+ arg[1].arg_type = A_DOUBLE;
+ makesingle = TRUE; /* maybe disable runtime scanning */
+ term = *s;
+ if (term == '\'')
+ leave = Nullch;
+ goto snarf_it;
+ case '0':
+ {
+ unsigned long i;
+ int shift;
+
+ arg[1].arg_type = A_SINGLE;
+ if (s[1] == 'x') {
+ shift = 4;
+ s += 2;
+ }
+ else if (s[1] == '.')
+ goto decimal;
+ else
+ shift = 3;
+ i = 0;
+ for (;;) {
+ switch (*s) {
+ default:
+ goto out;
+ case '_':
+ s++;
+ break;
+ case '8': case '9':
+ if (shift != 4)
+ yyerror("Illegal octal digit");
+ /* FALL THROUGH */
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7':
+ i <<= shift;
+ i += *s++ & 15;
+ break;
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ if (shift != 4)
+ goto out;
+ i <<= 4;
+ i += (*s++ & 7) + 9;
+ break;
+ }
+ }
+ out:
+ str = Str_new(92,0);
+ str_numset(str,(double)i);
+ if (str->str_ptr) {
+ Safefree(str->str_ptr);
+ str->str_ptr = Nullch;
+ str->str_len = str->str_cur = 0;
+ }
+ arg[1].arg_ptr.arg_str = str;
+ }
+ break;
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9': case '.':
+ decimal:
+ arg[1].arg_type = A_SINGLE;
+ d = tokenbuf;
+ while (isDIGIT(*s) || *s == '_') {
+ if (*s == '_')
+ s++;
+ else
+ *d++ = *s++;
+ }
+ if (*s == '.' && s[1] != '.') {
+ *d++ = *s++;
+ while (isDIGIT(*s) || *s == '_') {
+ if (*s == '_')
+ s++;
+ else
+ *d++ = *s++;
+ }
+ }
+ if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
+ *d++ = *s++;
+ if (*s == '+' || *s == '-')
+ *d++ = *s++;
+ while (isDIGIT(*s))
+ *d++ = *s++;
+ }
+ *d = '\0';
+ str = Str_new(92,0);
+ str_numset(str,atof(tokenbuf));
+ if (str->str_ptr) {
+ Safefree(str->str_ptr);
+ str->str_ptr = Nullch;
+ str->str_len = str->str_cur = 0;
+ }
+ arg[1].arg_ptr.arg_str = str;
+ break;
+ case '<':
+ if (in_what & (SCAN_REPL|SCAN_TR))
+ goto do_double;
+ if (*++s == '<') {
+ hereis = TRUE;
+ d = tokenbuf;
+ if (!rsfp)
+ *d++ = '\n';
+ if (*++s && index("`'\"",*s)) {
+ term = *s++;
+ s = cpytill(d,s,bufend,term,&len);
+ if (s < bufend)
+ s++;
+ d += len;
+ }
+ else {
+ if (*s == '\\')
+ s++, term = '\'';
+ else
+ term = '"';
+ while (isALNUM(*s))
+ *d++ = *s++;
+ } /* assuming tokenbuf won't clobber */
+ *d++ = '\n';
+ *d = '\0';
+ len = d - tokenbuf;
+ d = "\n";
+ if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
+ herewas = str_make(s,bufend-s);
+ else
+ s--, herewas = str_make(s,d-s);
+ s += herewas->str_cur;
+ if (term == '\'')
+ goto do_single;
+ if (term == '`')
+ goto do_back;
+ goto do_double;
+ }
+ d = tokenbuf;
+ s = cpytill(d,s,bufend,'>',&len);
+ if (s < bufend)
+ s++;
+ else
+ fatal("Unterminated <> operator");
+
+ if (*d == '$') d++;
+ while (*d && (isALNUM(*d) || *d == '\''))
+ d++;
+ if (d - tokenbuf != len) {
+ s = start;
+ term = *s;
+ arg[1].arg_type = A_GLOB;
+ set_csh();
+ alwaysdollar = TRUE; /* treat $) and $| as variables */
+ goto snarf_it;
+ }
+ else {
+ d = tokenbuf;
+ if (!len)
+ (void)strcpy(d,"ARGV");
+ if (*d == '$') {
+ arg[1].arg_type = A_INDREAD;
+ arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
+ }
+ else {
+ arg[1].arg_type = A_READ;
+ arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
+ if (!stab_io(arg[1].arg_ptr.arg_stab))
+ stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
+ if (strEQ(d,"ARGV")) {
+ (void)aadd(arg[1].arg_ptr.arg_stab);
+ stab_io(arg[1].arg_ptr.arg_stab)->flags |=
+ IOF_ARGV|IOF_START;
+ }
+ }
+ }
+ break;
+
+ case 'q':
+ s++;
+ if (*s == 'q') {
+ s++;
+ goto do_double;
+ }
+ if (*s == 'x') {
+ s++;
+ goto do_back;
+ }
+ /* FALL THROUGH */
+ case '\'':
+ do_single:
+ term = *s;
+ arg[1].arg_type = A_SINGLE;
+ leave = Nullch;
+ goto snarf_it;
+
+ case '"':
+ do_double:
+ term = *s;
+ arg[1].arg_type = A_DOUBLE;
+ makesingle = TRUE; /* maybe disable runtime scanning */
+ alwaysdollar = TRUE; /* treat $) and $| as variables */
+ goto snarf_it;
+ case '`':
+ do_back:
+ term = *s;
+ arg[1].arg_type = A_BACKTICK;
+ set_csh();
+ alwaysdollar = TRUE; /* treat $) and $| as variables */
+ snarf_it:
+ {
+ STR *tmpstr;
+ STR *tmpstr2 = Nullstr;
+ char *tmps;
+ bool dorange = FALSE;
+
+ CLINE;
+ multi_start = curcmd->c_line;
+ if (hereis)
+ multi_open = multi_close = '<';
+ else {
+ multi_open = term;
+ if (term && (tmps = index("([{< )]}> )]}>",term)))
+ term = tmps[5];
+ multi_close = term;
+ }
+ tmpstr = Str_new(87,80);
+ if (hereis) {
+ term = *tokenbuf;
+ if (!rsfp) {
+ d = s;
+ while (s < bufend &&
+ (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
+ if (*s++ == '\n')
+ curcmd->c_line++;
+ }
+ if (s >= bufend) {
+ curcmd->c_line = multi_start;
+ fatal("EOF in string");
+ }
+ str_nset(tmpstr,d+1,s-d);
+ s += len - 1;
+ str_ncat(herewas,s,bufend-s);
+ str_replace(linestr,herewas);
+ oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
+ bufend = linestr->str_ptr + linestr->str_cur;
+ hereis = FALSE;
+ }
+ else
+ str_nset(tmpstr,"",0); /* avoid "uninitialized" warning */
+ }
+ else
+ s = str_append_till(tmpstr,s+1,bufend,term,leave);
+ while (s >= bufend) { /* multiple line string? */
+ if (!rsfp ||
+ !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
+ curcmd->c_line = multi_start;
+ fatal("EOF in string");
+ }
+ curcmd->c_line++;
+ if (perldb) {
+ STR *str = Str_new(88,0);
+
+ str_sset(str,linestr);
+ astore(stab_xarray(curcmd->c_filestab),
+ (int)curcmd->c_line,str);
+ }
+ bufend = linestr->str_ptr + linestr->str_cur;
+ if (hereis) {
+ if (*s == term && bcmp(s,tokenbuf,len) == 0) {
+ s = bufend - 1;
+ *s = ' ';
+ str_scat(linestr,herewas);
+ bufend = linestr->str_ptr + linestr->str_cur;
+ }
+ else {
+ s = bufend;
+ str_scat(tmpstr,linestr);
+ }
+ }
+ else
+ s = str_append_till(tmpstr,s,bufend,term,leave);
+ }
+ multi_end = curcmd->c_line;
+ s++;
+ if (tmpstr->str_cur + 5 < tmpstr->str_len) {
+ tmpstr->str_len = tmpstr->str_cur + 1;
+ Renew(tmpstr->str_ptr, tmpstr->str_len, char);
+ }
+ if (arg[1].arg_type == A_SINGLE) {
+ arg[1].arg_ptr.arg_str = tmpstr;
+ break;
+ }
+ tmps = s;
+ s = tmpstr->str_ptr;
+ send = s + tmpstr->str_cur;
+ while (s < send) { /* see if we can make SINGLE */
+ if (*s == '\\' && s[1] && isDIGIT(s[1]) && !isDIGIT(s[2]) &&
+ !alwaysdollar && s[1] != '0')
+ *s = '$'; /* grandfather \digit in subst */
+ if ((*s == '$' || *s == '@') && s+1 < send &&
+ (alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
+ makesingle = FALSE; /* force interpretation */
+ }
+ else if (*s == '\\' && s+1 < send) {
+ if (index("lLuUE",s[1]))
+ makesingle = FALSE;
+ s++;
+ }
+ s++;
+ }
+ s = d = tmpstr->str_ptr; /* assuming shrinkage only */
+ while (s < send || dorange) {
+ if (in_what & SCAN_TR) {
+ if (dorange) {
+ int i;
+ int max;
+ if (!tmpstr2) { /* oops, have to grow */
+ tmpstr2 = str_smake(tmpstr);
+ s = tmpstr2->str_ptr + (s - tmpstr->str_ptr);
+ send = tmpstr2->str_ptr + (send - tmpstr->str_ptr);
+ }
+ i = d - tmpstr->str_ptr;
+ STR_GROW(tmpstr, tmpstr->str_len + 256);
+ d = tmpstr->str_ptr + i;
+ d -= 2;
+ max = d[1] & 0377;
+ for (i = (*d & 0377); i <= max; i++)
+ *d++ = i;
+ dorange = FALSE;
+ continue;
+ }
+ else if (*s == '-' && s+1 < send && d != tmpstr->str_ptr) {
+ dorange = TRUE;
+ s++;
+ }
+ }
+ else {
+ if ((*s == '$' && s+1 < send &&
+ (alwaysdollar || /*(*/(s[1] != ')' && s[1] != '|')) ) ||
+ (*s == '@' && s+1 < send) ) {
+ if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
+ *d++ = *s++;
+ len = scanident(s,send,tokenbuf) - s;
+ if (*s == '$' || strEQ(tokenbuf,"ARGV")
+ || strEQ(tokenbuf,"ENV")
+ || strEQ(tokenbuf,"SIG")
+ || strEQ(tokenbuf,"INC") )
+ (void)stabent(tokenbuf,TRUE); /* add symbol */
+ while (len--)
+ *d++ = *s++;
+ continue;
+ }
+ }
+ if (*s == '\\' && s+1 < send) {
+ s++;
+ switch (*s) {
+ case '-':
+ if (in_what & SCAN_TR) {
+ *d++ = *s++;
+ continue;
+ }
+ /* FALL THROUGH */
+ default:
+ if (!makesingle && (!leave || (*s && index(leave,*s))))
+ *d++ = '\\';
+ *d++ = *s++;
+ continue;
+ case '0': case '1': case '2': case '3':
+ case '4': case '5': case '6': case '7':
+ *d++ = scanoct(s, 3, &len);
+ s += len;
+ continue;
+ case 'x':
+ *d++ = scanhex(++s, 2, &len);
+ s += len;
+ continue;
+ case 'c':
+ s++;
+ *d = *s++;
+ if (isLOWER(*d))
+ *d = toupper(*d);
+ *d++ ^= 64;
+ continue;
+ case 'b':
+ *d++ = '\b';
+ break;
+ case 'n':
+ *d++ = '\n';
+ break;
+ case 'r':
+ *d++ = '\r';
+ break;
+ case 'f':
+ *d++ = '\f';
+ break;
+ case 't':
+ *d++ = '\t';
+ break;
+ case 'e':
+ *d++ = '\033';
+ break;
+ case 'a':
+ *d++ = '\007';
+ break;
+ }
+ s++;
+ continue;
+ }
+ *d++ = *s++;
+ }
+ *d = '\0';
+
+ if (arg[1].arg_type == A_DOUBLE && makesingle)
+ arg[1].arg_type = A_SINGLE; /* now we can optimize on it */
+
+ tmpstr->str_cur = d - tmpstr->str_ptr;
+ if (arg[1].arg_type == A_GLOB) {
+ arg[1].arg_ptr.arg_stab = stab = genstab();
+ stab_io(stab) = stio_new();
+ str_sset(stab_val(stab), tmpstr);
+ }
+ else
+ arg[1].arg_ptr.arg_str = tmpstr;
+ s = tmps;
+ if (tmpstr2)
+ str_free(tmpstr2);
+ break;
+ }
+ }
+ if (hereis)
+ str_free(herewas);
+ return s;
+}
+
+FCMD *
+load_format()
+{
+ FCMD froot;
+ FCMD *flinebeg;
+ char *eol;
+ register FCMD *fprev = &froot;
+ register FCMD *fcmd;
+ register char *s;
+ register char *t;
+ register STR *str;
+ bool noblank;
+ bool repeater;
+
+ Zero(&froot, 1, FCMD);
+ s = bufptr;
+ while (s < bufend || (rsfp && (s = str_gets(linestr,rsfp, 0)) != Nullch)) {
+ curcmd->c_line++;
+ if (in_eval && !rsfp) {
+ eol = index(s,'\n');
+ if (!eol++)
+ eol = bufend;
+ }
+ else
+ eol = bufend = linestr->str_ptr + linestr->str_cur;
+ if (perldb) {
+ STR *tmpstr = Str_new(89,0);
+
+ str_nset(tmpstr, s, eol-s);
+ astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
+ }
+ if (*s == '.') {
+ /*SUPPRESS 530*/
+ for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
+ if (*t == '\n') {
+ bufptr = s;
+ return froot.f_next;
+ }
+ }
+ if (*s == '#') {
+ s = eol;
+ continue;
+ }
+ flinebeg = Nullfcmd;
+ noblank = FALSE;
+ repeater = FALSE;
+ while (s < eol) {
+ Newz(804,fcmd,1,FCMD);
+ fprev->f_next = fcmd;
+ fprev = fcmd;
+ for (t=s; t < eol && *t != '@' && *t != '^'; t++) {
+ if (*t == '~') {
+ noblank = TRUE;
+ *t = ' ';
+ if (t[1] == '~') {
+ repeater = TRUE;
+ t[1] = ' ';
+ }
+ }
+ }
+ fcmd->f_pre = nsavestr(s, t-s);
+ fcmd->f_presize = t-s;
+ s = t;
+ if (s >= eol) {
+ if (noblank)
+ fcmd->f_flags |= FC_NOBLANK;
+ if (repeater)
+ fcmd->f_flags |= FC_REPEAT;
+ break;
+ }
+ if (!flinebeg)
+ flinebeg = fcmd; /* start values here */
+ if (*s++ == '^')
+ fcmd->f_flags |= FC_CHOP; /* for doing text filling */
+ switch (*s) {
+ case '*':
+ fcmd->f_type = F_LINES;
+ *s = '\0';
+ break;
+ case '<':
+ fcmd->f_type = F_LEFT;
+ while (*s == '<')
+ s++;
+ break;
+ case '>':
+ fcmd->f_type = F_RIGHT;
+ while (*s == '>')
+ s++;
+ break;
+ case '|':
+ fcmd->f_type = F_CENTER;
+ while (*s == '|')
+ s++;
+ break;
+ case '#':
+ case '.':
+ /* Catch the special case @... and handle it as a string
+ field. */
+ if (*s == '.' && s[1] == '.') {
+ goto default_format;
+ }
+ fcmd->f_type = F_DECIMAL;
+ {
+ char *p;
+
+ /* Read a format in the form @####.####, where either group
+ of ### may be empty, or the final .### may be missing. */
+ while (*s == '#')
+ s++;
+ if (*s == '.') {
+ s++;
+ p = s;
+ while (*s == '#')
+ s++;
+ fcmd->f_decimals = s-p;
+ fcmd->f_flags |= FC_DP;
+ } else {
+ fcmd->f_decimals = 0;
+ }
+ }
+ break;
+ default:
+ default_format:
+ fcmd->f_type = F_LEFT;
+ break;
+ }
+ if (fcmd->f_flags & FC_CHOP && *s == '.') {
+ fcmd->f_flags |= FC_MORE;
+ while (*s == '.')
+ s++;
+ }
+ fcmd->f_size = s-t;
+ }
+ if (flinebeg) {
+ again:
+ if (s >= bufend &&
+ (!rsfp || (s = str_gets(linestr, rsfp, 0)) == Nullch) )
+ goto badform;
+ curcmd->c_line++;
+ if (in_eval && !rsfp) {
+ eol = index(s,'\n');
+ if (!eol++)
+ eol = bufend;
+ }
+ else
+ eol = bufend = linestr->str_ptr + linestr->str_cur;
+ if (perldb) {
+ STR *tmpstr = Str_new(90,0);
+
+ str_nset(tmpstr, s, eol-s);
+ astore(stab_xarray(curcmd->c_filestab),
+ (int)curcmd->c_line,tmpstr);
+ }
+ if (strnEQ(s,".\n",2)) {
+ bufptr = s;
+ yyerror("Missing values line");
+ return froot.f_next;
+ }
+ if (*s == '#') {
+ s = eol;
+ goto again;
+ }
+ str = flinebeg->f_unparsed = Str_new(91,eol - s);
+ str->str_u.str_hash = curstash;
+ str_nset(str,"(",1);
+ flinebeg->f_line = curcmd->c_line;
+ eol[-1] = '\0';
+ if (!flinebeg->f_next->f_type || index(s, ',')) {
+ eol[-1] = '\n';
+ str_ncat(str, s, eol - s - 1);
+ str_ncat(str,",$$);",5);
+ s = eol;
+ }
+ else {
+ eol[-1] = '\n';
+ while (s < eol && isSPACE(*s))
+ s++;
+ t = s;
+ while (s < eol) {
+ switch (*s) {
+ case ' ': case '\t': case '\n': case ';':
+ str_ncat(str, t, s - t);
+ str_ncat(str, "," ,1);
+ while (s < eol && (isSPACE(*s) || *s == ';'))
+ s++;
+ t = s;
+ break;
+ case '$':
+ str_ncat(str, t, s - t);
+ t = s;
+ s = scanident(s,eol,tokenbuf);
+ str_ncat(str, t, s - t);
+ t = s;
+ if (s < eol && *s && index("$'\"",*s))
+ str_ncat(str, ",", 1);
+ break;
+ case '"': case '\'':
+ str_ncat(str, t, s - t);
+ t = s;
+ s++;
+ while (s < eol && (*s != *t || s[-1] == '\\'))
+ s++;
+ if (s < eol)
+ s++;
+ str_ncat(str, t, s - t);
+ t = s;
+ if (s < eol && *s && index("$'\"",*s))
+ str_ncat(str, ",", 1);
+ break;
+ default:
+ yyerror("Please use commas to separate fields");
+ }
+ }
+ str_ncat(str,"$$);",4);
+ }
+ }
+ }
+ badform:
+ bufptr = str_get(linestr);
+ yyerror("Format not terminated");
+ return froot.f_next;
+}
+
+static void
+set_csh()
+{
+#ifdef CSH
+ if (!cshlen)
+ cshlen = strlen(cshname);
+#endif
+}
View Lorry Controller Status