-/* $Header: toke.c,v 3.0.1.7 90/03/27 16:32:37 lwall Locked $
+/* toke.c
*
- * Copyright (c) 1989, Larry Wall
+ * Copyright (c) 1991-1994, Larry Wall
*
- * You may distribute under the terms of the GNU General Public License
- * as specified in the README file that comes with the perl 3.0 kit.
+ * 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 3.0.1.7 90/03/27 16:32:37 lwall
- * patch16: MSDOS support
- * patch16: formats didn't work inside eval
- * patch16: final semicolon in program wasn't optional with -p or -n
- *
- * Revision 3.0.1.6 90/03/12 17:06:36 lwall
- * patch13: last semicolon of program is now optional, just for Randal
- * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
- *
- * Revision 3.0.1.5 90/02/28 18:47:06 lwall
- * patch9: return grandfathered to never be function call
- * patch9: non-existent perldb.pl now gives reasonable error message
- * patch9: perl can now start up other interpreters scripts
- * patch9: line numbers were bogus during certain portions of foreach evaluation
- * patch9: null hereis core dumped
- *
- * Revision 3.0.1.4 89/12/21 20:26:56 lwall
- * patch7: -d switch incompatible with -p or -n
- * patch7: " ''$foo'' " didn't parse right
- * patch7: grandfathered m'pat' and s'pat'repl' to not be package qualifiers
- *
- * Revision 3.0.1.3 89/11/17 15:43:15 lwall
- * patch5: IBM PC/RT compiler can't deal with UNI() and LOP() macros
- * patch5: } misadjusted expection of subsequent term or operator
- * patch5: y/abcde// didn't work
- *
- * Revision 3.0.1.2 89/11/11 05:04:42 lwall
- * patch2: fixed a CLINE macro conflict
- *
- * Revision 3.0.1.1 89/10/26 23:26:21 lwall
- * patch1: disambiguated word after "sort" better
- *
- * Revision 3.0 89/10/18 15:32:33 lwall
- * 3.0 baseline
- *
+ */
+
+/*
+ * "It all comes from here, the stench and the peril." --Frodo
*/
#include "EXTERN.h"
#include "perl.h"
-#include "perly.h"
-char *reparse; /* if non-null, scanreg found ${foo[$bar]} */
+static void check_uni _((void));
+static void force_next _((I32 type));
+static char *force_word _((char *start, int token, int check_keyword, int allow_pack, int allow_tick));
+static SV *q _((SV *sv));
+static char *scan_const _((char *start));
+static char *scan_formline _((char *s));
+static char *scan_heredoc _((char *s));
+static char *scan_ident _((char *s, char *send, char *dest, I32 ck_uni));
+static char *scan_inputsymbol _((char *start));
+static char *scan_pat _((char *start));
+static char *scan_str _((char *start));
+static char *scan_subst _((char *start));
+static char *scan_trans _((char *start));
+static char *scan_word _((char *s, char *dest, int allow_package, STRLEN *slp));
+static char *skipspace _((char *s));
+static void checkcomma _((char *s, char *name, char *what));
+static void force_ident _((char *s, int kind));
+static void incline _((char *s));
+static int intuit_method _((char *s, GV *gv));
+static int intuit_more _((char *s));
+static I32 lop _((I32 f, expectation x, char *s));
+static void missingterm _((char *s));
+static void no_op _((char *what, char *s));
+static void set_csh _((void));
+static I32 sublex_done _((void));
+static I32 sublex_start _((void));
+#ifdef CRIPPLED_CC
+static int uni _((I32 f, char *s));
+#endif
+static char * filter_gets _((SV *sv, FILE *fp));
+
+/* The following are arranged oddly so that the guard on the switch statement
+ * can get by with a single comparison (if the compiler is smart enough).
+ */
+
+#define LEX_NORMAL 9
+#define LEX_INTERPNORMAL 8
+#define LEX_INTERPCASEMOD 7
+#define LEX_INTERPSTART 6
+#define LEX_INTERPEND 5
+#define LEX_INTERPENDMAYBE 4
+#define LEX_INTERPCONCAT 3
+#define LEX_INTERPCONST 2
+#define LEX_FORMLINE 1
+#define LEX_KNOWNEXT 0
+
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
+#ifdef ff_next
+#undef ff_next
+#endif
+
+#include "keywords.h"
#ifdef CLINE
#undef CLINE
#endif
-#define CLINE (cmdline = (line < cmdline ? line : cmdline))
-
-#define META(c) ((c) | 128)
-
-#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 FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
-#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 LFUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)LFUNC4)
-#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)
+#define CLINE (copline = (curcop->cop_line < copline ? curcop->cop_line : copline))
+
+#define TOKEN(retval) return (bufptr = s,(int)retval)
+#define OPERATOR(retval) return (expect = XTERM,bufptr = s,(int)retval)
+#define AOPERATOR(retval) return ao((expect = XTERM,bufptr = s,(int)retval))
+#define PREBLOCK(retval) return (expect = XBLOCK,bufptr = s,(int)retval)
+#define PRETERMBLOCK(retval) return (expect = XTERMBLOCK,bufptr = s,(int)retval)
+#define PREREF(retval) return (expect = XREF,bufptr = s,(int)retval)
+#define TERM(retval) return (CLINE, expect = XOPERATOR,bufptr = s,(int)retval)
+#define LOOPX(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LOOPEX)
+#define FTST(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)UNIOP)
+#define FUN0(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC0)
+#define FUN1(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC1)
+#define BOop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)BITOROP))
+#define BAop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)BITANDOP))
+#define SHop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)SHIFTOP))
+#define PWop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)POWOP))
+#define PMop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)MATCHOP)
+#define Aop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)ADDOP))
+#define Mop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)MULOP))
+#define Eop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)EQOP)
+#define Rop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)RELOP)
/* 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, \
+#define UNI(f) return(yylval.ival = f, \
+ expect = XTERM, \
+ bufptr = s, \
+ last_uni = oldbufptr, \
+ last_lop_op = f, \
+ (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
+
+#define UNIBRACK(f) return(yylval.ival = f, \
+ 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.
- */
-#define LOP(f) return(*s == '(' || (s = skipspace(s), *s == '(') ? \
- (*s = META('('), bufptr = oldbufptr, '(') : \
- (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
/* grandfather return to old style */
-#define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
+#define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP)
-char *
+static int
+ao(toketype)
+int toketype;
+{
+ if (*bufptr == '=') {
+ bufptr++;
+ if (toketype == ANDAND)
+ yylval.ival = OP_ANDASSIGN;
+ else if (toketype == OROR)
+ yylval.ival = OP_ORASSIGN;
+ toketype = ASSIGNOP;
+ }
+ return toketype;
+}
+
+static void
+no_op(what, s)
+char *what;
+char *s;
+{
+ char tmpbuf[128];
+ char *oldbp = bufptr;
+ bool is_first = (oldbufptr == SvPVX(linestr));
+ bufptr = s;
+ sprintf(tmpbuf, "%s found where operator expected", what);
+ yywarn(tmpbuf);
+ if (is_first)
+ warn("\t(Missing semicolon on previous line?)\n");
+ else if (oldoldbufptr && isIDFIRST(*oldoldbufptr)) {
+ char *t;
+ for (t = oldoldbufptr; *t && (isALNUM(*t) || *t == ':'); t++) ;
+ if (t < bufptr && isSPACE(*t))
+ warn("\t(Do you need to predeclare %.*s?)\n",
+ t - oldoldbufptr, oldoldbufptr);
+
+ }
+ else
+ warn("\t(Missing operator before %.*s?)\n", s - oldbp, oldbp);
+ bufptr = oldbp;
+}
+
+static void
+missingterm(s)
+char *s;
+{
+ char tmpbuf[3];
+ char q;
+ if (s) {
+ char *nl = strrchr(s,'\n');
+ if (nl)
+ *nl = '\0';
+ }
+ else if (multi_close < 32 || multi_close == 127) {
+ *tmpbuf = '^';
+ tmpbuf[1] = multi_close ^ 64;
+ s = "\\n";
+ tmpbuf[2] = '\0';
+ s = tmpbuf;
+ }
+ else {
+ *tmpbuf = multi_close;
+ tmpbuf[1] = '\0';
+ s = tmpbuf;
+ }
+ q = strchr(s,'"') ? '\'' : '"';
+ croak("Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
+}
+
+void
+deprecate(s)
+char *s;
+{
+ if (dowarn)
+ warn("Use of %s is deprecated", s);
+}
+
+static void
+depcom()
+{
+ deprecate("comma-less variable list");
+}
+
+void
+lex_start(line)
+SV *line;
+{
+ char *s;
+ STRLEN len;
+
+ SAVEINT(lex_dojoin);
+ SAVEINT(lex_brackets);
+ SAVEINT(lex_fakebrack);
+ SAVEINT(lex_casemods);
+ SAVEINT(lex_starts);
+ SAVEINT(lex_state);
+ SAVESPTR(lex_inpat);
+ SAVEINT(lex_inwhat);
+ SAVEINT(curcop->cop_line);
+ SAVEPPTR(bufptr);
+ SAVEPPTR(bufend);
+ SAVEPPTR(oldbufptr);
+ SAVEPPTR(oldoldbufptr);
+ SAVESPTR(linestr);
+ SAVEPPTR(lex_brackstack);
+ SAVEPPTR(lex_casestack);
+ SAVESPTR(rsfp);
+
+ lex_state = LEX_NORMAL;
+ lex_defer = 0;
+ expect = XSTATE;
+ lex_brackets = 0;
+ lex_fakebrack = 0;
+ New(899, lex_brackstack, 120, char);
+ New(899, lex_casestack, 12, char);
+ SAVEFREEPV(lex_brackstack);
+ SAVEFREEPV(lex_casestack);
+ lex_casemods = 0;
+ *lex_casestack = '\0';
+ lex_dojoin = 0;
+ lex_starts = 0;
+ if (lex_stuff)
+ SvREFCNT_dec(lex_stuff);
+ lex_stuff = Nullsv;
+ if (lex_repl)
+ SvREFCNT_dec(lex_repl);
+ lex_repl = Nullsv;
+ lex_inpat = 0;
+ lex_inwhat = 0;
+ linestr = line;
+ if (SvREADONLY(linestr))
+ linestr = sv_2mortal(newSVsv(linestr));
+ s = SvPV(linestr, len);
+ if (len && s[len-1] != ';') {
+ if (!(SvFLAGS(linestr) & SVs_TEMP))
+ linestr = sv_2mortal(newSVsv(linestr));
+ sv_catpvn(linestr, "\n;", 2);
+ }
+ SvTEMP_off(linestr);
+ oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr);
+ bufend = bufptr + SvCUR(linestr);
+ SvREFCNT_dec(rs);
+ rs = newSVpv("\n", 1);
+ rsfp = 0;
+}
+
+void
+lex_end()
+{
+}
+
+static void
+incline(s)
+char *s;
+{
+ char *t;
+ char *n;
+ char ch;
+ int sawline = 0;
+
+ curcop->cop_line++;
+ if (*s++ != '#')
+ return;
+ while (*s == ' ' || *s == '\t') s++;
+ if (strnEQ(s, "line ", 5)) {
+ s += 5;
+ sawline = 1;
+ }
+ if (!isDIGIT(*s))
+ return;
+ n = s;
+ while (isDIGIT(*s))
+ s++;
+ while (*s == ' ' || *s == '\t')
+ s++;
+ if (*s == '"' && (t = strchr(s+1, '"')))
+ s++;
+ else {
+ if (!sawline)
+ return; /* false alarm */
+ for (t = s; !isSPACE(*t); t++) ;
+ }
+ ch = *t;
+ *t = '\0';
+ if (t - s > 0)
+ curcop->cop_filegv = gv_fetchfile(s);
+ else
+ curcop->cop_filegv = gv_fetchfile(origfilename);
+ *t = ch;
+ curcop->cop_line = atoi(n)-1;
+}
+
+static char *
skipspace(s)
register char *s;
{
- while (s < bufend && isascii(*s) && isspace(*s))
- s++;
- return s;
+ if (lex_formbrack && lex_brackets <= lex_formbrack) {
+ while (s < bufend && (*s == ' ' || *s == '\t'))
+ s++;
+ return s;
+ }
+ for (;;) {
+ while (s < bufend && isSPACE(*s))
+ s++;
+ if (s < bufend && *s == '#') {
+ while (s < bufend && *s != '\n')
+ s++;
+ if (s < bufend)
+ s++;
+ }
+ if (s < bufend || !rsfp || lex_state != LEX_NORMAL)
+ return s;
+ if ((s = filter_gets(linestr, rsfp)) == Nullch) {
+ if (minus_n || minus_p) {
+ sv_setpv(linestr,minus_p ? ";}continue{print" : "");
+ sv_catpv(linestr,";}");
+ minus_n = minus_p = 0;
+ }
+ else
+ sv_setpv(linestr,";");
+ oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr);
+ bufend = SvPVX(linestr) + SvCUR(linestr);
+ if (preprocess && !in_eval)
+ (void)my_pclose(rsfp);
+ else if ((FILE*)rsfp == stdin)
+ clearerr(stdin);
+ else
+ (void)fclose(rsfp);
+ rsfp = Nullfp;
+ return s;
+ }
+ oldoldbufptr = oldbufptr = bufptr = s;
+ bufend = bufptr + SvCUR(linestr);
+ incline(s);
+ if (perldb && curstash != debstash) {
+ SV *sv = NEWSV(85,0);
+
+ sv_upgrade(sv, SVt_PVMG);
+ sv_setsv(sv,linestr);
+ av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
+ }
+ }
+}
+
+static void
+check_uni() {
+ char *s;
+ char ch;
+ char *t;
+
+ if (oldoldbufptr != last_uni)
+ return;
+ while (isSPACE(*last_uni))
+ last_uni++;
+ for (s = last_uni; isALNUM(*s) || *s == '-'; s++) ;
+ if ((t = strchr(s, '(')) && t < bufptr)
+ return;
+ 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
+static int
uni(f,s)
-int f;
+I32 f;
char *s;
{
yylval.ival = f;
- expectterm = TRUE;
+ expect = XTERM;
bufptr = s;
+ last_uni = oldbufptr;
+ last_lop_op = f;
if (*s == '(')
return FUNC1;
s = skipspace(s);
return UNIOP;
}
-int
-lop(f,s)
-int f;
+#endif /* CRIPPLED_CC */
+
+#define LOP(f,x) return lop(f,x,s)
+
+static I32
+lop(f,x,s)
+I32 f;
+expectation x;
char *s;
{
- if (*s != '(')
- s = skipspace(s);
- if (*s == '(') {
- *s = META('(');
- bufptr = oldbufptr;
- return '(';
+ yylval.ival = f;
+ CLINE;
+ expect = x;
+ bufptr = s;
+ last_lop = oldbufptr;
+ last_lop_op = f;
+ if (nexttoke)
+ return LSTOP;
+ if (*s == '(')
+ return FUNC;
+ s = skipspace(s);
+ if (*s == '(')
+ return FUNC;
+ else
+ return LSTOP;
+}
+
+static void
+force_next(type)
+I32 type;
+{
+ nexttype[nexttoke] = type;
+ nexttoke++;
+ if (lex_state != LEX_KNOWNEXT) {
+ lex_defer = lex_state;
+ lex_expect = expect;
+ lex_state = LEX_KNOWNEXT;
}
- else {
- yylval.ival=f;
- expectterm = TRUE;
- bufptr = s;
- return LISTOP;
+}
+
+static char *
+force_word(start,token,check_keyword,allow_pack,allow_tick)
+register char *start;
+int token;
+int check_keyword;
+int allow_pack;
+int allow_tick;
+{
+ register char *s;
+ STRLEN len;
+
+ start = skipspace(start);
+ s = start;
+ if (isIDFIRST(*s) ||
+ (allow_pack && *s == ':') ||
+ (allow_tick && *s == '\'') )
+ {
+ s = scan_word(s, tokenbuf, allow_pack, &len);
+ if (check_keyword && keyword(tokenbuf, len))
+ return start;
+ if (token == METHOD) {
+ s = skipspace(s);
+ if (*s == '(')
+ expect = XTERM;
+ else {
+ expect = XOPERATOR;
+ force_next(')');
+ force_next('(');
+ }
+ }
+ nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(tokenbuf,0));
+ nextval[nexttoke].opval->op_private |= OPpCONST_BARE;
+ force_next(token);
}
+ return s;
}
-#endif /* CRIPPLED_CC */
+static void
+force_ident(s, kind)
+register char *s;
+int kind;
+{
+ if (s && *s) {
+ OP* op = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
+ nextval[nexttoke].opval = op;
+ force_next(WORD);
+ if (kind) {
+ op->op_private = OPpCONST_ENTERED;
+ gv_fetchpv(s, TRUE,
+ kind == '$' ? SVt_PV :
+ kind == '@' ? SVt_PVAV :
+ kind == '%' ? SVt_PVHV :
+ SVt_PVGV
+ );
+ }
+ }
+}
-yylex()
+static SV *
+q(sv)
+SV *sv;
{
- register char *s = bufptr;
+ register char *s;
+ register char *send;
register char *d;
- register int tmp;
- static bool in_format = FALSE;
- static bool firstline = TRUE;
- extern int yychar; /* last token */
+ STRLEN len;
- oldoldbufptr = oldbufptr;
- oldbufptr = s;
+ if (!SvLEN(sv))
+ return sv;
- 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
- switch (*s) {
- default:
- if ((*s & 127) == '(')
- *s++ = '(';
- else
- warn("Unrecognized character \\%03o ignored", *s++);
- goto retry;
- case 0:
- if (!rsfp)
- RETURN(0);
- if (s++ < bufend)
- goto retry; /* ignore stray nulls */
- if (firstline) {
- firstline = FALSE;
- if (minus_n || minus_p || perldb) {
- str_set(linestr,"");
- if (perldb)
- str_cat(linestr,
-"do 'perldb.pl' || die \"Can't find perldb.pl in @INC\"; print $@;");
- if (minus_n || minus_p) {
- str_cat(linestr,"line: while (<>) {");
- 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;
- TERM(FORMLIST);
- }
- line++;
- if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
- if (preprocess)
- (void)mypclose(rsfp);
- else if (rsfp != stdin)
- (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 */
+ s = SvPV_force(sv, len);
+ if (SvIVX(sv) == -1)
+ return sv;
+ send = s + len;
+ while (s < send && *s != '\\')
+ s++;
+ if (s == send)
+ return sv;
+ d = s;
+ while (s < send) {
+ if (*s == '\\') {
+ if (s + 1 < send && (s[1] == '\\'))
+ s++; /* all that, just for this */
}
- oldoldbufptr = oldbufptr = bufptr = s;
- if (perldb) {
- STR *str = Str_new(85,0);
+ *d++ = *s++;
+ }
+ *d = '\0';
+ SvCUR_set(sv, d - SvPVX(sv));
- str_sset(str,linestr);
- astore(lineary,(int)line,str);
- }
-#ifdef DEBUG
- if (firstline) {
- char *showinput();
- s = showinput();
+ return sv;
+}
+
+static I32
+sublex_start()
+{
+ register I32 op_type = yylval.ival;
+
+ if (op_type == OP_NULL) {
+ yylval.opval = lex_op;
+ lex_op = Nullop;
+ return THING;
+ }
+ if (op_type == OP_CONST || op_type == OP_READLINE) {
+ yylval.opval = (OP*)newSVOP(op_type, 0, q(lex_stuff));
+ lex_stuff = Nullsv;
+ return THING;
+ }
+
+ push_scope();
+ SAVEINT(lex_dojoin);
+ SAVEINT(lex_brackets);
+ SAVEINT(lex_fakebrack);
+ SAVEINT(lex_casemods);
+ SAVEINT(lex_starts);
+ SAVEINT(lex_state);
+ SAVESPTR(lex_inpat);
+ SAVEINT(lex_inwhat);
+ SAVEINT(curcop->cop_line);
+ SAVEPPTR(bufptr);
+ SAVEPPTR(oldbufptr);
+ SAVEPPTR(oldoldbufptr);
+ SAVESPTR(linestr);
+ SAVEPPTR(lex_brackstack);
+ SAVEPPTR(lex_casestack);
+
+ linestr = lex_stuff;
+ lex_stuff = Nullsv;
+
+ bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr);
+ bufend += SvCUR(linestr);
+ SAVEFREESV(linestr);
+
+ lex_dojoin = FALSE;
+ lex_brackets = 0;
+ lex_fakebrack = 0;
+ New(899, lex_brackstack, 120, char);
+ New(899, lex_casestack, 12, char);
+ SAVEFREEPV(lex_brackstack);
+ SAVEFREEPV(lex_casestack);
+ lex_casemods = 0;
+ *lex_casestack = '\0';
+ lex_starts = 0;
+ lex_state = LEX_INTERPCONCAT;
+ curcop->cop_line = multi_start;
+
+ lex_inwhat = op_type;
+ if (op_type == OP_MATCH || op_type == OP_SUBST)
+ lex_inpat = lex_op;
+ else
+ lex_inpat = 0;
+
+ expect = XTERM;
+ force_next('(');
+ if (lex_op) {
+ yylval.opval = lex_op;
+ lex_op = Nullop;
+ return PMFUNC;
+ }
+ else
+ return FUNC;
+}
+
+static I32
+sublex_done()
+{
+ if (!lex_starts++) {
+ expect = XOPERATOR;
+ yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv("",0));
+ return THING;
+ }
+
+ if (lex_casemods) { /* oops, we've got some unbalanced parens */
+ lex_state = LEX_INTERPCASEMOD;
+ return yylex();
+ }
+
+ /* Is there a right-hand side to take care of? */
+ if (lex_repl && (lex_inwhat == OP_SUBST || lex_inwhat == OP_TRANS)) {
+ linestr = lex_repl;
+ lex_inpat = 0;
+ bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr);
+ bufend += SvCUR(linestr);
+ SAVEFREESV(linestr);
+ lex_dojoin = FALSE;
+ lex_brackets = 0;
+ lex_fakebrack = 0;
+ lex_casemods = 0;
+ *lex_casestack = '\0';
+ lex_starts = 0;
+ if (SvCOMPILED(lex_repl)) {
+ lex_state = LEX_INTERPNORMAL;
+ lex_starts++;
}
-#endif
- bufend = linestr->str_ptr + linestr->str_cur;
- if (line == 1) {
- if (*s == '#' && s[1] == '!') {
- if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
- char **newargv;
- char *cmd;
+ else
+ lex_state = LEX_INTERPCONCAT;
+ lex_repl = Nullsv;
+ return ',';
+ }
+ else {
+ pop_scope();
+ bufend = SvPVX(linestr);
+ bufend += SvCUR(linestr);
+ expect = XOPERATOR;
+ return ')';
+ }
+}
- 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++;
+static char *
+scan_const(start)
+char *start;
+{
+ register char *send = bufend;
+ SV *sv = NEWSV(93, send - start);
+ register char *s = start;
+ register char *d = SvPVX(sv);
+ bool dorange = FALSE;
+ I32 len;
+ char *leave =
+ lex_inpat
+ ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]} \t\n\r\f\v#"
+ : (lex_inwhat & OP_TRANS)
+ ? ""
+ : "";
+
+ while (s < send || dorange) {
+ if (lex_inwhat == OP_TRANS) {
+ if (dorange) {
+ I32 i;
+ I32 max;
+ i = d - SvPVX(sv);
+ SvGROW(sv, SvLEN(sv) + 256);
+ d = SvPVX(sv) + i;
+ d -= 2;
+ max = (U8)d[1];
+ for (i = (U8)*d; i <= max; i++)
+ *d++ = i;
+ dorange = FALSE;
+ continue;
}
- }
- goto retry;
- case ' ': case '\t': case '\f':
- s++;
- goto retry;
- case '\n':
- case '#':
- if (preprocess && s == str_get(linestr) &&
- s[1] == ' ' && isdigit(s[2])) {
- line = atoi(s+2)-1;
- for (s += 2; isdigit(*s); s++) ;
- d = bufend;
- while (s < d && isspace(*s)) s++;
- if (filename)
- Safefree(filename);
- s[strlen(s)-1] = '\0'; /* wipe out newline */
- if (*s == '"') {
+ else if (*s == '-' && s+1 < send && s != start) {
+ dorange = TRUE;
s++;
- s[strlen(s)-1] = '\0'; /* wipe out trailing quote */
}
- if (*s)
- filename = savestr(s);
- else
- filename = savestr(origfilename);
- oldoldbufptr = oldbufptr = s = str_get(linestr);
}
- 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);
- }
- line++;
+ else if (*s == '(' && lex_inpat && s[1] == '?' && s[2] == '#') {
+ while (s < send && *s != ')')
+ *d++ = *s++;
}
- else {
- *s = '\0';
- bufend = s;
+ else if (*s == '#' && lex_inpat &&
+ ((PMOP*)lex_inpat)->op_pmflags & PMf_EXTENDED) {
+ while (s+1 < send && *s != '\n')
+ *d++ = *s++;
}
- goto retry;
- case '-':
- if (s[1] && isalpha(s[1]) && !isalpha(s[2])) {
+ else if (*s == '@' && s[1] && (isALNUM(s[1]) || strchr(":'{$", s[1])))
+ break;
+ else if (*s == '$') {
+ if (!lex_inpat) /* not a regexp, so $ must be var */
+ break;
+ if (s + 1 < send && !strchr(")| \n\t", s[1]))
+ break; /* in regexp, $ might be tail anchor */
+ }
+ if (*s == '\\' && s+1 < send) {
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);
+ if (*s && strchr(leave, *s)) {
+ *d++ = '\\';
+ *d++ = *s++;
+ continue;
+ }
+ if (lex_inwhat == OP_SUBST && !lex_inpat &&
+ isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
+ {
+ if (dowarn)
+ warn("\\%c better written as $%c", *s, *s);
+ *--s = '$';
+ break;
+ }
+ if (lex_inwhat != OP_TRANS && *s && strchr("lLuUEQ", *s)) {
+ --s;
+ break;
+ }
+ switch (*s) {
+ case '-':
+ if (lex_inwhat == OP_TRANS) {
+ *d++ = *s++;
+ continue;
+ }
+ /* FALL THROUGH */
default:
- s -= 2;
+ *d++ = *s++;
+ continue;
+ case '0': case '1': case '2': case '3':
+ case '4': case '5': case '6': case '7':
+ *d++ = scan_oct(s, 3, &len);
+ s += len;
+ continue;
+ case 'x':
+ *d++ = scan_hex(++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;
}
- }
- tmp = *s++;
- if (*s == tmp) {
s++;
- RETURN(DEC);
+ continue;
+ }
+ *d++ = *s++;
+ }
+ *d = '\0';
+ SvCUR_set(sv, d - SvPVX(sv));
+ SvPOK_on(sv);
+
+ if (SvCUR(sv) + 5 < SvLEN(sv)) {
+ SvLEN_set(sv, SvCUR(sv) + 1);
+ Renew(SvPVX(sv), SvLEN(sv), char);
+ }
+ if (s > bufptr)
+ yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+ else
+ SvREFCNT_dec(sv);
+ return s;
+}
+
+/* This is the one truly awful dwimmer necessary to conflate C and sed. */
+static int
+intuit_more(s)
+register char *s;
+{
+ if (lex_brackets)
+ return TRUE;
+ if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
+ return TRUE;
+ if (*s != '{' && *s != '[')
+ return FALSE;
+ if (!lex_inpat)
+ return TRUE;
+
+ /* In a pattern, so maybe we have {n,m}. */
+ if (*s == '{') {
+ s++;
+ if (!isDIGIT(*s))
+ return TRUE;
+ while (isDIGIT(*s))
+ s++;
+ if (*s == ',')
+ s++;
+ while (isDIGIT(*s))
+ s++;
+ if (*s == '}')
+ return FALSE;
+ return TRUE;
+
+ }
+
+ /* On the other hand, maybe we have a character class */
+
+ s++;
+ if (*s == ']' || *s == '^')
+ return FALSE;
+ else {
+ int weight = 2; /* let's weigh the evidence */
+ char seen[256];
+ unsigned char un_char = 0, last_un_char;
+ char *send = strchr(s,']');
+ char tmpbuf[512];
+
+ if (!send) /* has to be an expression */
+ return TRUE;
+
+ Zero(seen,256,char);
+ if (*s == '$')
+ weight -= 3;
+ else if (isDIGIT(*s)) {
+ if (s[1] != ']') {
+ if (isDIGIT(s[1]) && s[2] == ']')
+ weight -= 10;
+ }
+ else
+ weight -= 100;
+ }
+ for (; s < send; s++) {
+ last_un_char = un_char;
+ un_char = (unsigned char)*s;
+ switch (*s) {
+ case '@':
+ case '&':
+ case '$':
+ weight -= seen[un_char] * 10;
+ if (isALNUM(s[1])) {
+ scan_ident(s,send,tmpbuf,FALSE);
+ if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
+ weight -= 100;
+ else
+ weight -= 10;
+ }
+ else if (*s == '$' && s[1] &&
+ strchr("[#!%*<>()-=",s[1])) {
+ if (/*{*/ strchr("])} =",s[2]))
+ weight -= 10;
+ else
+ weight -= 1;
+ }
+ break;
+ case '\\':
+ un_char = 254;
+ if (s[1]) {
+ if (strchr("wds]",s[1]))
+ weight += 100;
+ else if (seen['\''] || seen['"'])
+ weight += 1;
+ else if (strchr("rnftbxcav",s[1]))
+ weight += 40;
+ else if (isDIGIT(s[1])) {
+ weight += 40;
+ while (s[1] && isDIGIT(s[1]))
+ s++;
+ }
+ }
+ else
+ weight += 100;
+ break;
+ case '-':
+ if (s[1] == '\\')
+ weight += 50;
+ if (strchr("aA01! ",last_un_char))
+ weight += 30;
+ if (strchr("zZ79~",s[1]))
+ weight += 30;
+ break;
+ default:
+ if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
+ isALPHA(*s) && s[1] && isALPHA(s[1])) {
+ char *d = tmpbuf;
+ while (isALPHA(*s))
+ *d++ = *s++;
+ *d = '\0';
+ if (keyword(tmpbuf, d - tmpbuf))
+ weight -= 150;
+ }
+ if (un_char == last_un_char + 1)
+ weight += 5;
+ weight -= seen[un_char];
+ break;
+ }
+ seen[un_char]++;
+ }
+ if (weight >= 0) /* probably a character class */
+ return FALSE;
+ }
+
+ return TRUE;
+}
+
+static int
+intuit_method(start,gv)
+char *start;
+GV *gv;
+{
+ char *s = start + (*start == '$');
+ char tmpbuf[1024];
+ STRLEN len;
+ GV* indirgv;
+
+ if (gv) {
+ if (GvIO(gv))
+ return 0;
+ if (!GvCV(gv))
+ gv = 0;
+ }
+ s = scan_word(s, tmpbuf, TRUE, &len);
+ if (*start == '$') {
+ if (gv || last_lop_op == OP_PRINT || isUPPER(*tokenbuf))
+ return 0;
+ s = skipspace(s);
+ bufptr = start;
+ expect = XREF;
+ return *s == '(' ? FUNCMETH : METHOD;
+ }
+ if (!keyword(tmpbuf, len)) {
+ indirgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVCV);
+ if (indirgv && GvCV(indirgv))
+ return 0;
+ /* filehandle or package name makes it a method */
+ if (!gv || GvIO(indirgv) || gv_stashpv(tmpbuf, FALSE)) {
+ s = skipspace(s);
+ nextval[nexttoke].opval =
+ (OP*)newSVOP(OP_CONST, 0,
+ newSVpv(tmpbuf,0));
+ nextval[nexttoke].opval->op_private =
+ OPpCONST_BARE;
+ expect = XTERM;
+ force_next(WORD);
+ bufptr = s;
+ return *s == '(' ? FUNCMETH : METHOD;
+ }
+ }
+ return 0;
+}
+
+static char*
+incl_perldb()
+{
+ if (perldb) {
+ char *pdb = getenv("PERL5DB");
+
+ if (pdb)
+ return pdb;
+ return "BEGIN { require 'perl5db.pl' }";
+ }
+ return "";
+}
+
+
+/* Encoded script support. filter_add() effectively inserts a
+ * 'pre-processing' function into the current source input stream.
+ * Note that the filter function only applies to the current source file
+ * (e.g., it will not affect files 'require'd or 'use'd by this one).
+ *
+ * The datasv parameter (which may be NULL) can be used to pass
+ * private data to this instance of the filter. The filter function
+ * can recover the SV using the FILTER_DATA macro and use it to
+ * store private buffers and state information.
+ *
+ * The supplied datasv parameter is upgraded to a PVIO type
+ * and the IoDIRP field is used to store the function pointer.
+ * Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
+ * private use must be set using malloc'd pointers.
+ */
+static int filter_debug = 0;
+
+SV *
+filter_add(funcp, datasv)
+ filter_t funcp;
+ SV *datasv;
+{
+ if (!funcp){ /* temporary handy debugging hack to be deleted */
+ filter_debug = atoi((char*)datasv);
+ return NULL;
+ }
+ if (!rsfp_filters)
+ rsfp_filters = newAV();
+ if (!datasv)
+ datasv = newSV(0);
+ if (!SvUPGRADE(datasv, SVt_PVIO))
+ die("Can't upgrade filter_add data to SVt_PVIO");
+ IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
+ if (filter_debug)
+ warn("filter_add func %lx (%s)", funcp, SvPV(datasv,na));
+ av_unshift(rsfp_filters, 1);
+ av_store(rsfp_filters, 0, datasv) ;
+ return(datasv);
+}
+
+
+/* Delete most recently added instance of this filter function. */
+void
+filter_del(funcp)
+ filter_t funcp;
+{
+ if (filter_debug)
+ warn("filter_del func %lx", funcp);
+ if (!rsfp_filters || AvFILL(rsfp_filters)<0)
+ return;
+ /* if filter is on top of stack (usual case) just pop it off */
+ if (IoDIRP(FILTER_DATA(0)) == (void*)funcp){
+ /* sv_free(av_pop(rsfp_filters)); */
+ sv_free(av_shift(rsfp_filters));
+
+ return;
+ }
+ /* we need to search for the correct entry and clear it */
+ die("filter_del can only delete in reverse order (currently)");
+}
+
+
+/* Invoke the n'th filter function for the current rsfp. */
+I32
+filter_read(idx, buf_sv, maxlen)
+ int idx;
+ SV *buf_sv;
+ int maxlen; /* 0 = read one text line */
+{
+ filter_t funcp;
+ SV *datasv = NULL;
+
+ if (!rsfp_filters)
+ return -1;
+ if (idx > AvFILL(rsfp_filters)){ /* Any more filters? */
+ /* Provide a default input filter to make life easy. */
+ /* Note that we append to the line. This is handy. */
+ if (filter_debug)
+ warn("filter_read %d: from rsfp\n", idx);
+ if (maxlen) {
+ /* Want a block */
+ int len ;
+ int old_len = SvCUR(buf_sv) ;
+
+ /* ensure buf_sv is large enough */
+ SvGROW(buf_sv, old_len + maxlen) ;
+ if ((len = fread(SvPVX(buf_sv) + old_len, 1, maxlen, rsfp)) <= 0){
+ if (ferror(rsfp))
+ return -1; /* error */
+ else
+ return 0 ; /* end of file */
+ }
+ SvCUR_set(buf_sv, old_len + len) ;
+ } else {
+ /* Want a line */
+ if (sv_gets(buf_sv, rsfp, SvCUR(buf_sv)) == NULL) {
+ if (ferror(rsfp))
+ return -1; /* error */
+ else
+ return 0 ; /* end of file */
+ }
+ }
+ return SvCUR(buf_sv);
+ }
+ /* Skip this filter slot if filter has been deleted */
+ if ( (datasv = FILTER_DATA(idx)) == &sv_undef){
+ if (filter_debug)
+ warn("filter_read %d: skipped (filter deleted)\n", idx);
+ return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
+ }
+ /* Get function pointer hidden within datasv */
+ funcp = (filter_t)IoDIRP(datasv);
+ if (filter_debug)
+ warn("filter_read %d: via function %lx (%s)\n",
+ idx, funcp, SvPV(datasv,na));
+ /* Call function. The function is expected to */
+ /* call "FILTER_READ(idx+1, buf_sv)" first. */
+ /* Return: <0:error, =0:eof, >0:not eof */
+ return (*funcp)(idx, buf_sv, maxlen);
+}
+
+static char *
+filter_gets(sv,fp)
+register SV *sv;
+register FILE *fp;
+{
+ if (rsfp_filters) {
+
+ SvCUR_set(sv, 0); /* start with empty line */
+ if (FILTER_READ(0, sv, 0) > 0)
+ return ( SvPVX(sv) ) ;
+ else
+ return Nullch ;
+ }
+ else
+ return (sv_gets(sv, fp, 0)) ;
+
+}
+
+
+#ifdef DEBUGGING
+ static char* exp_name[] =
+ { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "TERMBLOCK" };
+#endif
+
+extern int yychar; /* last token */
+
+int
+yylex()
+{
+ register char *s;
+ register char *d;
+ register I32 tmp;
+ STRLEN len;
+
+ switch (lex_state) {
+#ifdef COMMENTARY
+ case LEX_NORMAL: /* Some compilers will produce faster */
+ case LEX_INTERPNORMAL: /* code if we comment these out. */
+ break;
+#endif
+
+ case LEX_KNOWNEXT:
+ nexttoke--;
+ yylval = nextval[nexttoke];
+ if (!nexttoke) {
+ lex_state = lex_defer;
+ expect = lex_expect;
+ lex_defer = LEX_NORMAL;
+ }
+ return(nexttype[nexttoke]);
+
+ case LEX_INTERPCASEMOD:
+#ifdef DEBUGGING
+ if (bufptr != bufend && *bufptr != '\\')
+ croak("panic: INTERPCASEMOD");
+#endif
+ if (bufptr == bufend || bufptr[1] == 'E') {
+ char oldmod;
+ if (lex_casemods) {
+ oldmod = lex_casestack[--lex_casemods];
+ lex_casestack[lex_casemods] = '\0';
+ if (bufptr != bufend && strchr("LUQ", oldmod)) {
+ bufptr += 2;
+ lex_state = LEX_INTERPCONCAT;
+ }
+ return ')';
+ }
+ if (bufptr != bufend)
+ bufptr += 2;
+ lex_state = LEX_INTERPCONCAT;
+ return yylex();
+ }
+ else {
+ s = bufptr + 1;
+ if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
+ tmp = *s, *s = s[2], s[2] = tmp; /* misordered... */
+ if (strchr("LU", *s) &&
+ (strchr(lex_casestack, 'L') || strchr(lex_casestack, 'U')))
+ {
+ lex_casestack[--lex_casemods] = '\0';
+ return ')';
+ }
+ if (lex_casemods > 10) {
+ char* newlb = (char*)realloc(lex_casestack, lex_casemods + 2);
+ if (newlb != lex_casestack) {
+ SAVEFREEPV(newlb);
+ lex_casestack = newlb;
+ }
+ }
+ lex_casestack[lex_casemods++] = *s;
+ lex_casestack[lex_casemods] = '\0';
+ lex_state = LEX_INTERPCONCAT;
+ nextval[nexttoke].ival = 0;
+ force_next('(');
+ if (*s == 'l')
+ nextval[nexttoke].ival = OP_LCFIRST;
+ else if (*s == 'u')
+ nextval[nexttoke].ival = OP_UCFIRST;
+ else if (*s == 'L')
+ nextval[nexttoke].ival = OP_LC;
+ else if (*s == 'U')
+ nextval[nexttoke].ival = OP_UC;
+ else if (*s == 'Q')
+ nextval[nexttoke].ival = OP_QUOTEMETA;
+ else
+ croak("panic: yylex");
+ bufptr = s + 1;
+ force_next(FUNC);
+ if (lex_starts) {
+ s = bufptr;
+ lex_starts = 0;
+ Aop(OP_CONCAT);
+ }
+ else
+ return yylex();
+ }
+
+ case LEX_INTERPSTART:
+ if (bufptr == bufend)
+ return sublex_done();
+ expect = XTERM;
+ lex_dojoin = (*bufptr == '@');
+ lex_state = LEX_INTERPNORMAL;
+ if (lex_dojoin) {
+ nextval[nexttoke].ival = 0;
+ force_next(',');
+ force_ident("\"", '$');
+ nextval[nexttoke].ival = 0;
+ force_next('$');
+ nextval[nexttoke].ival = 0;
+ force_next('(');
+ nextval[nexttoke].ival = OP_JOIN; /* emulate join($", ...) */
+ force_next(FUNC);
+ }
+ if (lex_starts++) {
+ s = bufptr;
+ Aop(OP_CONCAT);
}
- if (expectterm)
- OPERATOR('-');
else
- AOP(O_SUBTRACT);
+ return yylex();
+ break;
+
+ case LEX_INTERPENDMAYBE:
+ if (intuit_more(bufptr)) {
+ lex_state = LEX_INTERPNORMAL; /* false alarm, more expr */
+ break;
+ }
+ /* FALL THROUGH */
+
+ case LEX_INTERPEND:
+ if (lex_dojoin) {
+ lex_dojoin = FALSE;
+ lex_state = LEX_INTERPCONCAT;
+ return ')';
+ }
+ /* FALLTHROUGH */
+ case LEX_INTERPCONCAT:
+#ifdef DEBUGGING
+ if (lex_brackets)
+ croak("panic: INTERPCONCAT");
+#endif
+ if (bufptr == bufend)
+ return sublex_done();
+
+ if (SvIVX(linestr) == '\'') {
+ SV *sv = newSVsv(linestr);
+ if (!lex_inpat)
+ sv = q(sv);
+ yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+ s = bufend;
+ }
+ else {
+ s = scan_const(bufptr);
+ if (*s == '\\')
+ lex_state = LEX_INTERPCASEMOD;
+ else
+ lex_state = LEX_INTERPSTART;
+ }
+
+ if (s != bufptr) {
+ nextval[nexttoke] = yylval;
+ expect = XTERM;
+ force_next(THING);
+ if (lex_starts++)
+ Aop(OP_CONCAT);
+ else {
+ bufptr = s;
+ return yylex();
+ }
+ }
+
+ return yylex();
+ case LEX_FORMLINE:
+ lex_state = LEX_NORMAL;
+ s = scan_formline(bufptr);
+ if (!lex_formbrack)
+ goto rightbracket;
+ OPERATOR(';');
+ }
+
+ s = bufptr;
+ oldoldbufptr = oldbufptr;
+ oldbufptr = s;
+ DEBUG_p( {
+ fprintf(stderr,"### Tokener expecting %s at %s\n", exp_name[expect], s);
+ } )
+
+ retry:
+ switch (*s) {
+ default:
+ 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) {
+ if (lex_brackets)
+ yyerror("Missing right bracket");
+ TOKEN(0);
+ }
+ if (s++ < bufend)
+ goto retry; /* ignore stray nulls */
+ last_uni = 0;
+ last_lop = 0;
+ if (!in_eval && !preambled) {
+ preambled = TRUE;
+ sv_setpv(linestr,incl_perldb());
+ if (SvCUR(linestr))
+ sv_catpv(linestr,";");
+ if (preambleav){
+ while(AvFILL(preambleav) >= 0) {
+ SV *tmpsv = av_shift(preambleav);
+ sv_catsv(linestr, tmpsv);
+ sv_catpv(linestr, ";");
+ sv_free(tmpsv);
+ }
+ sv_free((SV*)preambleav);
+ preambleav = NULL;
+ }
+ if (minus_n || minus_p) {
+ sv_catpv(linestr, "LINE: while (<>) {");
+ if (minus_l)
+ sv_catpv(linestr,"chomp;");
+ if (minus_a){
+ if (minus_F){
+ char tmpbuf1[50];
+ if ( splitstr[0] == '/' ||
+ splitstr[0] == '\'' ||
+ splitstr[0] == '"' )
+ sprintf( tmpbuf1, "@F=split(%s);", splitstr );
+ else
+ sprintf( tmpbuf1, "@F=split('%s');", splitstr );
+ sv_catpv(linestr,tmpbuf1);
+ }
+ else
+ sv_catpv(linestr,"@F=split(' ');");
+ }
+ }
+ sv_catpv(linestr, "\n");
+ oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+ bufend = SvPVX(linestr) + SvCUR(linestr);
+ if (perldb && curstash != debstash) {
+ SV *sv = NEWSV(85,0);
+
+ sv_upgrade(sv, SVt_PVMG);
+ sv_setsv(sv,linestr);
+ av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
+ }
+ goto retry;
+ }
+ do {
+ if ((s = filter_gets(linestr, rsfp)) == Nullch) {
+ fake_eof:
+ if (rsfp) {
+ if (preprocess && !in_eval)
+ (void)my_pclose(rsfp);
+ else if ((FILE*)rsfp == stdin)
+ clearerr(stdin);
+ else
+ (void)fclose(rsfp);
+ rsfp = Nullfp;
+ }
+ if (!in_eval && (minus_n || minus_p)) {
+ sv_setpv(linestr,minus_p ? ";}continue{print" : "");
+ sv_catpv(linestr,";}");
+ oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+ bufend = SvPVX(linestr) + SvCUR(linestr);
+ minus_n = minus_p = 0;
+ goto retry;
+ }
+ oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+ sv_setpv(linestr,"");
+ TOKEN(';'); /* not infinite loop because rsfp is NULL now */
+ }
+ if (doextract) {
+ if (*s == '#' && s[1] == '!' && instr(s,"perl"))
+ doextract = FALSE;
+
+ /* Incest with pod. */
+ if (*s == '=' && strnEQ(s, "=cut", 4)) {
+ sv_setpv(linestr, "");
+ oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+ bufend = SvPVX(linestr) + SvCUR(linestr);
+ doextract = FALSE;
+ }
+ }
+ incline(s);
+ } while (doextract);
+ oldoldbufptr = oldbufptr = bufptr = s;
+ if (perldb && curstash != debstash) {
+ SV *sv = NEWSV(85,0);
+
+ sv_upgrade(sv, SVt_PVMG);
+ sv_setsv(sv,linestr);
+ av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
+ }
+ bufend = SvPVX(linestr) + SvCUR(linestr);
+ if (curcop->cop_line == 1) {
+ while (s < bufend && isSPACE(*s))
+ s++;
+ if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
+ s++;
+ if (!in_eval && *s == '#' && s[1] == '!') {
+ d = instr(s,"perl -");
+ if (!d)
+ d = instr(s,"perl");
+ if (!d &&
+ !minus_c &&
+ !instr(s,"indir") &&
+ 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);
+ croak("Can't exec %s", cmd);
+ }
+ if (d) {
+ int oldpdb = perldb;
+ int oldn = minus_n;
+ int oldp = minus_p;
+
+ while (*d && !isSPACE(*d)) d++;
+ while (*d == ' ') d++;
+
+ if (*d++ == '-') {
+ while (d = moreswitches(d)) ;
+ if (perldb && !oldpdb ||
+ minus_n && !oldn ||
+ minus_p && !oldp)
+ {
+ sv_setpv(linestr, "");
+ oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+ bufend = SvPVX(linestr) + SvCUR(linestr);
+ preambled = FALSE;
+ if (perldb)
+ (void)gv_fetchfile(origfilename);
+ goto retry;
+ }
+ }
+ }
+ }
+ }
+ if (lex_formbrack && lex_brackets <= lex_formbrack) {
+ bufptr = s;
+ lex_state = LEX_FORMLINE;
+ return yylex();
+ }
+ goto retry;
+ case ' ': case '\t': case '\f': case '\r': case 013:
+ s++;
+ goto retry;
+ case '#':
+ case '\n':
+ if (lex_state != LEX_NORMAL || (in_eval && !rsfp)) {
+ d = bufend;
+ while (s < d && *s != '\n')
+ s++;
+ if (s < d)
+ s++;
+ incline(s);
+ if (lex_formbrack && lex_brackets <= lex_formbrack) {
+ bufptr = s;
+ lex_state = LEX_FORMLINE;
+ return yylex();
+ }
+ }
+ else {
+ *s = '\0';
+ bufend = s;
+ }
+ goto retry;
+ case '-':
+ if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
+ s++;
+ bufptr = s;
+ tmp = *s++;
+
+ while (s < bufend && (*s == ' ' || *s == '\t'))
+ s++;
+
+ if (strnEQ(s,"=>",2)) {
+ if (dowarn)
+ warn("Ambiguous use of -%c => resolved to \"-%c\" =>",
+ tmp, tmp);
+ s = force_word(bufptr,WORD,FALSE,FALSE,FALSE);
+ OPERATOR('-'); /* unary minus */
+ }
+ last_uni = oldbufptr;
+ last_lop_op = OP_FTEREAD; /* good enough */
+ switch (tmp) {
+ case 'r': FTST(OP_FTEREAD);
+ case 'w': FTST(OP_FTEWRITE);
+ case 'x': FTST(OP_FTEEXEC);
+ case 'o': FTST(OP_FTEOWNED);
+ case 'R': FTST(OP_FTRREAD);
+ case 'W': FTST(OP_FTRWRITE);
+ case 'X': FTST(OP_FTREXEC);
+ case 'O': FTST(OP_FTROWNED);
+ case 'e': FTST(OP_FTIS);
+ case 'z': FTST(OP_FTZERO);
+ case 's': FTST(OP_FTSIZE);
+ case 'f': FTST(OP_FTFILE);
+ case 'd': FTST(OP_FTDIR);
+ case 'l': FTST(OP_FTLINK);
+ case 'p': FTST(OP_FTPIPE);
+ case 'S': FTST(OP_FTSOCK);
+ case 'u': FTST(OP_FTSUID);
+ case 'g': FTST(OP_FTSGID);
+ case 'k': FTST(OP_FTSVTX);
+ case 'b': FTST(OP_FTBLK);
+ case 'c': FTST(OP_FTCHR);
+ case 't': FTST(OP_FTTTY);
+ case 'T': FTST(OP_FTTEXT);
+ case 'B': FTST(OP_FTBINARY);
+ case 'M': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTMTIME);
+ case 'A': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTATIME);
+ case 'C': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTCTIME);
+ default:
+ croak("Unrecognized file test: -%c", tmp);
+ break;
+ }
+ }
+ tmp = *s++;
+ if (*s == tmp) {
+ s++;
+ if (expect == XOPERATOR)
+ TERM(POSTDEC);
+ else
+ OPERATOR(PREDEC);
+ }
+ else if (*s == '>') {
+ s++;
+ s = skipspace(s);
+ if (isIDFIRST(*s)) {
+ s = force_word(s,METHOD,FALSE,TRUE,FALSE);
+ TOKEN(ARROW);
+ }
+ else if (*s == '$')
+ OPERATOR(ARROW);
+ else
+ TERM(ARROW);
+ }
+ if (expect == XOPERATOR)
+ Aop(OP_SUBTRACT);
+ else {
+ if (isSPACE(*s) || !isSPACE(*bufptr))
+ check_uni();
+ OPERATOR('-'); /* unary minus */
+ }
+
case '+':
tmp = *s++;
if (*s == tmp) {
s++;
- RETURN(INC);
+ if (expect == XOPERATOR)
+ TERM(POSTINC);
+ else
+ OPERATOR(PREINC);
}
- if (expectterm)
+ if (expect == XOPERATOR)
+ Aop(OP_ADD);
+ else {
+ if (isSPACE(*s) || !isSPACE(*bufptr))
+ check_uni();
OPERATOR('+');
- else
- AOP(O_ADD);
+ }
+
+ case '*':
+ if (expect != XOPERATOR) {
+ s = scan_ident(s, bufend, tokenbuf, TRUE);
+ expect = XOPERATOR;
+ force_ident(tokenbuf, '*');
+ if (!*tokenbuf)
+ PREREF('*');
+ TERM('*');
+ }
+ s++;
+ if (*s == '*') {
+ s++;
+ PWop(OP_POW);
+ }
+ Mop(OP_MULTIPLY);
+
+ case '%':
+ if (expect != XOPERATOR) {
+ s = scan_ident(s, bufend, tokenbuf + 1, TRUE);
+ if (tokenbuf[1]) {
+ expect = XOPERATOR;
+ tokenbuf[0] = '%';
+ if (in_my) {
+ if (strchr(tokenbuf,':'))
+ croak(no_myglob,tokenbuf);
+ nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+ nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
+ force_next(PRIVATEREF);
+ TERM('%');
+ }
+ if (!strchr(tokenbuf,':')) {
+ if (tmp = pad_findmy(tokenbuf)) {
+ nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+ nextval[nexttoke].opval->op_targ = tmp;
+ force_next(PRIVATEREF);
+ TERM('%');
+ }
+ }
+ force_ident(tokenbuf + 1, *tokenbuf);
+ }
+ else
+ PREREF('%');
+ TERM('%');
+ }
+ ++s;
+ Mop(OP_MODULO);
+
+ case '^':
+ s++;
+ BOop(OP_BIT_XOR);
+ case '[':
+ lex_brackets++;
+ /* FALL THROUGH */
+ case '~':
+ case ',':
+ tmp = *s++;
+ OPERATOR(tmp);
+ case ':':
+ if (s[1] == ':') {
+ len = 0;
+ goto just_a_word;
+ }
+ s++;
+ OPERATOR(':');
+ case '(':
+ s++;
+ if (last_lop == oldoldbufptr || last_uni == oldoldbufptr)
+ oldbufptr = oldoldbufptr; /* allow print(STDOUT 123) */
+ else
+ expect = XTERM;
+ TOKEN('(');
+ case ';':
+ if (curcop->cop_line < copline)
+ copline = curcop->cop_line;
+ tmp = *s++;
+ OPERATOR(tmp);
+ case ')':
+ tmp = *s++;
+ s = skipspace(s);
+ if (*s == '{')
+ PREBLOCK(tmp);
+ TERM(tmp);
+ case ']':
+ s++;
+ if (lex_brackets <= 0)
+ yyerror("Unmatched right bracket");
+ else
+ --lex_brackets;
+ if (lex_state == LEX_INTERPNORMAL) {
+ if (lex_brackets == 0) {
+ if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
+ lex_state = LEX_INTERPEND;
+ }
+ }
+ TERM(']');
+ case '{':
+ leftbracket:
+ s++;
+ if (lex_brackets > 100) {
+ char* newlb = (char*)realloc(lex_brackstack, lex_brackets + 1);
+ if (newlb != lex_brackstack) {
+ SAVEFREEPV(newlb);
+ lex_brackstack = newlb;
+ }
+ }
+ switch (expect) {
+ case XTERM:
+ if (lex_formbrack) {
+ s--;
+ PRETERMBLOCK(DO);
+ }
+ if (oldoldbufptr == last_lop)
+ lex_brackstack[lex_brackets++] = XTERM;
+ else
+ lex_brackstack[lex_brackets++] = XOPERATOR;
+ OPERATOR(HASHBRACK);
+ break;
+ case XOPERATOR:
+ while (s < bufend && (*s == ' ' || *s == '\t'))
+ s++;
+ if (s < bufend && isALPHA(*s)) {
+ d = scan_word(s, tokenbuf, FALSE, &len);
+ while (d < bufend && (*d == ' ' || *d == '\t'))
+ d++;
+ if (*d == '}') {
+ if (dowarn &&
+ (keyword(tokenbuf, len) ||
+ perl_get_cv(tokenbuf, FALSE) ))
+ warn("Ambiguous use of {%s} resolved to {\"%s\"}",
+ tokenbuf, tokenbuf);
+ s = force_word(s,WORD,FALSE,TRUE,FALSE);
+ }
+ }
+ /* FALL THROUGH */
+ case XBLOCK:
+ lex_brackstack[lex_brackets++] = XSTATE;
+ expect = XSTATE;
+ break;
+ case XTERMBLOCK:
+ lex_brackstack[lex_brackets++] = XOPERATOR;
+ expect = XSTATE;
+ break;
+ default: {
+ char *t;
+ if (oldoldbufptr == last_lop)
+ lex_brackstack[lex_brackets++] = XTERM;
+ else
+ lex_brackstack[lex_brackets++] = XOPERATOR;
+ s = skipspace(s);
+ if (*s == '}')
+ OPERATOR(HASHBRACK);
+ if (isALPHA(*s)) {
+ for (t = s; t < bufend && isALNUM(*t); t++) ;
+ }
+ else if (*s == '\'' || *s == '"') {
+ t = strchr(s+1,*s);
+ if (!t++)
+ t = s;
+ }
+ else
+ t = s;
+ while (t < bufend && isSPACE(*t))
+ t++;
+ if ((*t == ',' && !isLOWER(*s)) || (*t == '=' && t[1] == '>'))
+ OPERATOR(HASHBRACK);
+ if (expect == XREF)
+ expect = XTERM;
+ else {
+ lex_brackstack[lex_brackets-1] = XSTATE;
+ expect = XSTATE;
+ }
+ }
+ break;
+ }
+ yylval.ival = curcop->cop_line;
+ if (isSPACE(*s) || *s == '#')
+ copline = NOLINE; /* invalidate current command line number */
+ TOKEN('{');
+ case '}':
+ rightbracket:
+ s++;
+ if (lex_brackets <= 0)
+ yyerror("Unmatched right bracket");
+ else
+ expect = (expectation)lex_brackstack[--lex_brackets];
+ if (lex_brackets < lex_formbrack)
+ lex_formbrack = 0;
+ if (lex_state == LEX_INTERPNORMAL) {
+ if (lex_brackets == 0) {
+ if (lex_fakebrack) {
+ lex_state = LEX_INTERPEND;
+ bufptr = s;
+ return yylex(); /* ignore fake brackets */
+ }
+ if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
+ lex_state = LEX_INTERPEND;
+ }
+ }
+ if (lex_brackets < lex_fakebrack) {
+ bufptr = s;
+ lex_fakebrack = 0;
+ return yylex(); /* ignore fake brackets */
+ }
+ force_next('}');
+ TOKEN(';');
+ case '&':
+ s++;
+ tmp = *s++;
+ if (tmp == '&')
+ AOPERATOR(ANDAND);
+ s--;
+ if (expect == XOPERATOR) {
+ if (dowarn && isALPHA(*s) && bufptr == SvPVX(linestr)) {
+ curcop->cop_line--;
+ warn(warn_nosemi);
+ curcop->cop_line++;
+ }
+ BAop(OP_BIT_AND);
+ }
+
+ s = scan_ident(s-1, bufend, tokenbuf, TRUE);
+ if (*tokenbuf) {
+ expect = XOPERATOR;
+ force_ident(tokenbuf, '&');
+ }
+ else
+ PREREF('&');
+ yylval.ival = (OPpENTERSUB_AMPER<<8);
+ TERM('&');
+
+ case '|':
+ s++;
+ tmp = *s++;
+ if (tmp == '|')
+ AOPERATOR(OROR);
+ s--;
+ BOop(OP_BIT_OR);
+ case '=':
+ s++;
+ tmp = *s++;
+ if (tmp == '=')
+ Eop(OP_EQ);
+ if (tmp == '>')
+ OPERATOR(',');
+ if (tmp == '~')
+ PMop(OP_MATCH);
+ if (dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
+ warn("Reversed %c= operator",tmp);
+ s--;
+ if (expect == XSTATE && isALPHA(tmp) &&
+ (s == SvPVX(linestr)+1 || s[-2] == '\n') )
+ {
+ s = bufend;
+ doextract = TRUE;
+ goto retry;
+ }
+ if (lex_brackets < lex_formbrack) {
+ char *t;
+ for (t = s; *t == ' ' || *t == '\t'; t++) ;
+ if (*t == '\n' || *t == '#') {
+ s--;
+ expect = XBLOCK;
+ goto leftbracket;
+ }
+ }
+ yylval.ival = 0;
+ OPERATOR(ASSIGNOP);
+ case '!':
+ s++;
+ tmp = *s++;
+ if (tmp == '=')
+ Eop(OP_NE);
+ if (tmp == '~')
+ PMop(OP_NOT);
+ s--;
+ OPERATOR('!');
+ case '<':
+ if (expect != XOPERATOR) {
+ if (s[1] != '<' && !strchr(s,'>'))
+ check_uni();
+ if (s[1] == '<')
+ s = scan_heredoc(s);
+ else
+ s = scan_inputsymbol(s);
+ TERM(sublex_start());
+ }
+ s++;
+ tmp = *s++;
+ if (tmp == '<')
+ SHop(OP_LEFT_SHIFT);
+ if (tmp == '=') {
+ tmp = *s++;
+ if (tmp == '>')
+ Eop(OP_NCMP);
+ s--;
+ Rop(OP_LE);
+ }
+ s--;
+ Rop(OP_LT);
+ case '>':
+ s++;
+ tmp = *s++;
+ if (tmp == '>')
+ SHop(OP_RIGHT_SHIFT);
+ if (tmp == '=')
+ Rop(OP_GE);
+ s--;
+ Rop(OP_GT);
+
+ case '$':
+ if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$:", s[2]))) {
+ s = scan_ident(s+1, bufend, tokenbuf+1, FALSE);
+ if (expect == XOPERATOR) {
+ if (lex_formbrack && lex_brackets == lex_formbrack) {
+ expect = XTERM;
+ depcom();
+ return ','; /* grandfather non-comma-format format */
+ }
+ else
+ no_op("Array length",s);
+ }
+ else if (!tokenbuf[1])
+ PREREF(DOLSHARP);
+ if (!strchr(tokenbuf+1,':')) {
+ tokenbuf[0] = '@';
+ if (tmp = pad_findmy(tokenbuf)) {
+ nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+ nextval[nexttoke].opval->op_targ = tmp;
+ expect = XOPERATOR;
+ force_next(PRIVATEREF);
+ TOKEN(DOLSHARP);
+ }
+ }
+ expect = XOPERATOR;
+ force_ident(tokenbuf+1, *tokenbuf);
+ TOKEN(DOLSHARP);
+ }
+ s = scan_ident(s, bufend, tokenbuf+1, FALSE);
+ if (expect == XOPERATOR) {
+ if (lex_formbrack && lex_brackets == lex_formbrack) {
+ expect = XTERM;
+ depcom();
+ return ','; /* grandfather non-comma-format format */
+ }
+ else
+ no_op("Scalar",s);
+ }
+ if (tokenbuf[1]) {
+ expectation oldexpect = expect;
+
+ /* This kludge not intended to be bulletproof. */
+ if (tokenbuf[1] == '[' && !tokenbuf[2]) {
+ yylval.opval = newSVOP(OP_CONST, 0,
+ newSViv((IV)compiling.cop_arybase));
+ yylval.opval->op_private = OPpCONST_ARYBASE;
+ TERM(THING);
+ }
+ tokenbuf[0] = '$';
+ if (dowarn) {
+ char *t;
+ if (*s == '[' && oldexpect != XREF) {
+ for (t = s+1; isSPACE(*t) || isALNUM(*t) || *t == '$'; t++) ;
+ if (*t++ == ',') {
+ bufptr = skipspace(bufptr);
+ while (t < bufend && *t != ']') t++;
+ warn("Multidimensional syntax %.*s not supported",
+ t-bufptr+1, bufptr);
+ }
+ }
+ if (*s == '{' && strEQ(tokenbuf, "$SIG") &&
+ (t = strchr(s,'}')) && (t = strchr(t,'='))) {
+ char tmpbuf[1024];
+ STRLEN len;
+ for (t++; isSPACE(*t); t++) ;
+ if (isIDFIRST(*t)) {
+ t = scan_word(t, tmpbuf, TRUE, &len);
+ if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
+ warn("You need to quote \"%s\"", tmpbuf);
+ }
+ }
+ }
+ expect = XOPERATOR;
+ if (lex_state == LEX_NORMAL && isSPACE(*s)) {
+ bool islop = (last_lop == oldoldbufptr);
+ s = skipspace(s);
+ if (!islop || last_lop_op == OP_GREPSTART)
+ expect = XOPERATOR;
+ else if (strchr("$@\"'`q", *s))
+ expect = XTERM; /* e.g. print $fh "foo" */
+ else if (strchr("&*<%", *s) && isIDFIRST(s[1]))
+ expect = XTERM; /* e.g. print $fh &sub */
+ else if (isDIGIT(*s))
+ expect = XTERM; /* e.g. print $fh 3 */
+ else if (*s == '.' && isDIGIT(s[1]))
+ expect = XTERM; /* e.g. print $fh .3 */
+ else if (strchr("/?-+", *s) && !isSPACE(s[1]))
+ expect = XTERM; /* e.g. print $fh -1 */
+ else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]))
+ expect = XTERM; /* print $fh <<"EOF" */
+ }
+ if (in_my) {
+ if (strchr(tokenbuf,':'))
+ croak(no_myglob,tokenbuf);
+ nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+ nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
+ force_next(PRIVATEREF);
+ }
+ else if (!strchr(tokenbuf,':')) {
+ if (oldexpect != XREF || oldoldbufptr == last_lop) {
+ if (intuit_more(s)) {
+ if (*s == '[')
+ tokenbuf[0] = '@';
+ else if (*s == '{')
+ tokenbuf[0] = '%';
+ }
+ }
+ if (tmp = pad_findmy(tokenbuf)) {
+ if (!tokenbuf[2] && *tokenbuf =='$' &&
+ tokenbuf[1] <= 'b' && tokenbuf[1] >= 'a')
+ {
+ for (d = in_eval ? oldoldbufptr : SvPVX(linestr);
+ d < bufend && *d != '\n';
+ d++)
+ {
+ if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
+ croak("Can't use \"my %s\" in sort comparison",
+ tokenbuf);
+ }
+ }
+ }
+ nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+ nextval[nexttoke].opval->op_targ = tmp;
+ force_next(PRIVATEREF);
+ }
+ else
+ force_ident(tokenbuf+1, *tokenbuf);
+ }
+ else
+ force_ident(tokenbuf+1, *tokenbuf);
+ }
+ else {
+ if (s == bufend)
+ yyerror("Final $ should be \\$ or $name");
+ PREREF('$');
+ }
+ TOKEN('$');
+
+ case '@':
+ s = scan_ident(s, bufend, tokenbuf+1, FALSE);
+ if (expect == XOPERATOR)
+ no_op("Array",s);
+ if (tokenbuf[1]) {
+ GV* gv;
+
+ tokenbuf[0] = '@';
+ expect = XOPERATOR;
+ if (in_my) {
+ if (strchr(tokenbuf,':'))
+ croak(no_myglob,tokenbuf);
+ nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+ nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
+ force_next(PRIVATEREF);
+ TERM('@');
+ }
+ else if (!strchr(tokenbuf,':')) {
+ if (intuit_more(s)) {
+ if (*s == '{')
+ tokenbuf[0] = '%';
+ }
+ if (tmp = pad_findmy(tokenbuf)) {
+ nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+ nextval[nexttoke].opval->op_targ = tmp;
+ force_next(PRIVATEREF);
+ TERM('@');
+ }
+ }
+
+ /* Force them to make up their mind on "@foo". */
+ if (lex_state != LEX_NORMAL && !lex_brackets &&
+ ( !(gv = gv_fetchpv(tokenbuf+1, FALSE, SVt_PVAV)) ||
+ (*tokenbuf == '@'
+ ? !GvAV(gv)
+ : !GvHV(gv) )))
+ {
+ char tmpbuf[1024];
+ sprintf(tmpbuf, "Literal @%s now requires backslash",tokenbuf+1);
+ yyerror(tmpbuf);
+ }
+
+ /* Warn about @ where they meant $. */
+ if (dowarn) {
+ if (*s == '[' || *s == '{') {
+ char *t = s + 1;
+ while (*t && (isALNUM(*t) || strchr(" \t$#+-'\"", *t)))
+ t++;
+ if (*t == '}' || *t == ']') {
+ t++;
+ bufptr = skipspace(bufptr);
+ warn("Scalar value %.*s better written as $%.*s",
+ t-bufptr, bufptr, t-bufptr-1, bufptr+1);
+ }
+ }
+ }
+ force_ident(tokenbuf+1, *tokenbuf);
+ }
+ else {
+ if (s == bufend)
+ yyerror("Final @ should be \\@ or @name");
+ PREREF('@');
+ }
+ TERM('@');
+
+ case '/': /* may either be division or pattern */
+ case '?': /* may either be conditional or pattern */
+ if (expect != XOPERATOR) {
+ check_uni();
+ s = scan_pat(s);
+ TERM(sublex_start());
+ }
+ tmp = *s++;
+ if (tmp == '/')
+ Mop(OP_DIVIDE);
+ OPERATOR(tmp);
+
+ case '.':
+ if (lex_formbrack && lex_brackets == lex_formbrack && s[1] == '\n' &&
+ (s == SvPVX(linestr) || s[-1] == '\n') ) {
+ lex_formbrack = 0;
+ expect = XSTATE;
+ goto rightbracket;
+ }
+ if (expect == XOPERATOR || !isDIGIT(s[1])) {
+ tmp = *s++;
+ if (*s == tmp) {
+ s++;
+ if (*s == tmp) {
+ s++;
+ yylval.ival = OPf_SPECIAL;
+ }
+ else
+ yylval.ival = 0;
+ OPERATOR(DOTDOT);
+ }
+ if (expect != XOPERATOR)
+ check_uni();
+ Aop(OP_CONCAT);
+ }
+ /* FALL THROUGH */
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ s = scan_num(s);
+ if (expect == XOPERATOR)
+ no_op("Number",s);
+ TERM(THING);
+
+ case '\'':
+ s = scan_str(s);
+ if (expect == XOPERATOR) {
+ if (lex_formbrack && lex_brackets == lex_formbrack) {
+ expect = XTERM;
+ depcom();
+ return ','; /* grandfather non-comma-format format */
+ }
+ else
+ no_op("String",s);
+ }
+ if (!s)
+ missingterm((char*)0);
+ yylval.ival = OP_CONST;
+ TERM(sublex_start());
+
+ case '"':
+ s = scan_str(s);
+ if (expect == XOPERATOR) {
+ if (lex_formbrack && lex_brackets == lex_formbrack) {
+ expect = XTERM;
+ depcom();
+ return ','; /* grandfather non-comma-format format */
+ }
+ else
+ no_op("String",s);
+ }
+ if (!s)
+ missingterm((char*)0);
+ yylval.ival = OP_CONST;
+ for (d = SvPV(lex_stuff, len); len; len--, d++) {
+ if (*d == '$' || *d == '@' || *d == '\\') {
+ yylval.ival = OP_STRINGIFY;
+ break;
+ }
+ }
+ TERM(sublex_start());
+
+ case '`':
+ s = scan_str(s);
+ if (expect == XOPERATOR)
+ no_op("Backticks",s);
+ if (!s)
+ missingterm((char*)0);
+ yylval.ival = OP_BACKTICK;
+ set_csh();
+ TERM(sublex_start());
+
+ case '\\':
+ s++;
+ if (dowarn && lex_inwhat && isDIGIT(*s))
+ warn("Can't use \\%c to mean $%c in expression", *s, *s);
+ if (expect == XOPERATOR)
+ no_op("Backslash",s);
+ OPERATOR(REFGEN);
+
+ case 'x':
+ if (isDIGIT(s[1]) && expect == XOPERATOR) {
+ s++;
+ Mop(OP_REPEAT);
+ }
+ goto keylookup;
+
+ case '_':
+ case 'a': case 'A':
+ case 'b': case 'B':
+ case 'c': case 'C':
+ case 'd': case 'D':
+ case 'e': case 'E':
+ case 'f': case 'F':
+ case 'g': case 'G':
+ case 'h': case 'H':
+ case 'i': case 'I':
+ case 'j': case 'J':
+ case 'k': case 'K':
+ case 'l': case 'L':
+ case 'm': case 'M':
+ case 'n': case 'N':
+ case 'o': case 'O':
+ case 'p': case 'P':
+ case 'q': case 'Q':
+ case 'r': case 'R':
+ case 's': case 'S':
+ case 't': case 'T':
+ case 'u': case 'U':
+ case 'v': case 'V':
+ case 'w': case 'W':
+ case 'X':
+ case 'y': case 'Y':
+ case 'z': case 'Z':
+
+ keylookup:
+ bufptr = s;
+ s = scan_word(s, tokenbuf, FALSE, &len);
+
+ if (*s == ':' && s[1] == ':' && strNE(tokenbuf, "CORE"))
+ goto just_a_word;
+
+ tmp = keyword(tokenbuf, len);
+
+ /* Is this a word before a => operator? */
+ d = s;
+ while (d < bufend && (*d == ' ' || *d == '\t'))
+ d++; /* no comments skipped here, or s### is misparsed */
+ if (strnEQ(d,"=>",2)) {
+ CLINE;
+ if (dowarn && (tmp || perl_get_cv(tokenbuf, FALSE)))
+ warn("Ambiguous use of %s => resolved to \"%s\" =>",
+ tokenbuf, tokenbuf);
+ yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
+ yylval.opval->op_private = OPpCONST_BARE;
+ TERM(WORD);
+ }
+
+ if (tmp < 0) { /* second-class keyword? */
+ GV* gv;
+ if (expect != XOPERATOR &&
+ (*s != ':' || s[1] != ':') &&
+ (gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV)) &&
+ (GvFLAGS(gv) & GVf_IMPORTED) &&
+ GvCV(gv))
+ {
+ tmp = 0;
+ }
+ else
+ tmp = -tmp;
+ }
+
+ reserved_word:
+ switch (tmp) {
+
+ default: /* not a keyword */
+ just_a_word: {
+ GV *gv;
+ char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]);
+
+ /* Get the rest if it looks like a package qualifier */
+
+ if (*s == '\'' || *s == ':' && s[1] == ':') {
+ s = scan_word(s, tokenbuf + len, TRUE, &len);
+ if (!len)
+ croak("Bad name after %s::", tokenbuf);
+ }
+
+ /* Do special processing at start of statement. */
+
+ if (expect == XSTATE) {
+ while (isSPACE(*s)) s++;
+ if (*s == ':') { /* It's a label. */
+ yylval.pval = savepv(tokenbuf);
+ s++;
+ CLINE;
+ TOKEN(LABEL);
+ }
+ }
+ else if (expect == XOPERATOR) {
+ if (bufptr == SvPVX(linestr)) {
+ curcop->cop_line--;
+ warn(warn_nosemi);
+ curcop->cop_line++;
+ }
+ else
+ no_op("Bare word",s);
+ }
+
+ /* Look for a subroutine with this name in current package. */
+
+ gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV);
+
+ /* Presume this is going to be a bareword of some sort. */
+
+ CLINE;
+ yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
+ yylval.opval->op_private = OPpCONST_BARE;
+
+ /* See if it's the indirect object for a list operator. */
+
+ if (oldoldbufptr &&
+ oldoldbufptr < bufptr &&
+ (oldoldbufptr == last_lop || oldoldbufptr == last_uni) &&
+ /* NO SKIPSPACE BEFORE HERE! */
+ (expect == XREF ||
+ (opargs[last_lop_op] >> OASHIFT & 7) == OA_FILEREF) )
+ {
+ bool immediate_paren = *s == '(';
+
+ /* (Now we can afford to cross potential line boundary.) */
+ s = skipspace(s);
+
+ /* Two barewords in a row may indicate method call. */
+
+ if ((isALPHA(*s) || *s == '$') && (tmp=intuit_method(s,gv)))
+ return tmp;
+
+ /* If not a declared subroutine, it's an indirect object. */
+ /* (But it's an indir obj regardless for sort.) */
+
+ if ((last_lop_op == OP_SORT ||
+ (!immediate_paren && (!gv || !GvCV(gv))) ) &&
+ (last_lop_op != OP_MAPSTART && last_lop_op != OP_GREPSTART)){
+ expect = (last_lop == oldoldbufptr) ? XTERM : XOPERATOR;
+ goto bareword;
+ }
+ }
+
+ /* If followed by a paren, it's certainly a subroutine. */
+
+ expect = XOPERATOR;
+ s = skipspace(s);
+ if (*s == '(') {
+ CLINE;
+ nextval[nexttoke].opval = yylval.opval;
+ expect = XOPERATOR;
+ force_next(WORD);
+ yylval.ival = 0;
+ TOKEN('&');
+ }
+
+ /* If followed by var or block, call it a method (unless sub) */
+
+ if ((*s == '$' || *s == '{') && (!gv || !GvCV(gv))) {
+ last_lop = oldbufptr;
+ last_lop_op = OP_METHOD;
+ PREBLOCK(METHOD);
+ }
+
+ /* If followed by a bareword, see if it looks like indir obj. */
+
+ if ((isALPHA(*s) || *s == '$') && (tmp = intuit_method(s,gv)))
+ return tmp;
+
+ /* Not a method, so call it a subroutine (if defined) */
+
+ if (gv && GvCV(gv)) {
+ CV* cv = GvCV(gv);
+ nextval[nexttoke].opval = yylval.opval;
+ if (*s == '(') {
+ expect = XTERM;
+ force_next(WORD);
+ yylval.ival = 0;
+ TOKEN('&');
+ }
+ if (lastchar == '-')
+ warn("Ambiguous use of -%s resolved as -&%s()",
+ tokenbuf, tokenbuf);
+ last_lop = oldbufptr;
+ last_lop_op = OP_ENTERSUB;
+ /* Is there a prototype? */
+ if (SvPOK(cv)) {
+ STRLEN len;
+ char *proto = SvPV((SV*)cv, len);
+ if (!len)
+ TERM(FUNC0SUB);
+ if (strEQ(proto, "$"))
+ OPERATOR(UNIOPSUB);
+ if (*proto == '&' && *s == '{') {
+ sv_setpv(subname,"__ANON__");
+ PREBLOCK(LSTOPSUB);
+ }
+ }
+ expect = XTERM;
+ force_next(WORD);
+ TOKEN(NOAMP);
+ }
+
+ if (hints & HINT_STRICT_SUBS &&
+ lastchar != '-' &&
+ strnNE(s,"->",2) &&
+ last_lop_op != OP_ACCEPT &&
+ last_lop_op != OP_PIPE_OP &&
+ last_lop_op != OP_SOCKPAIR)
+ {
+ warn(
+ "Bareword \"%s\" not allowed while \"strict subs\" in use",
+ tokenbuf);
+ ++error_count;
+ }
+
+ /* Call it a bare word */
+
+ bareword:
+ if (dowarn) {
+ if (lastchar != '-') {
+ for (d = tokenbuf; *d && isLOWER(*d); d++) ;
+ if (!*d)
+ warn(warn_reserved, tokenbuf);
+ }
+ }
+ if (lastchar && strchr("*%&", lastchar)) {
+ warn("Operator or semicolon missing before %c%s",
+ lastchar, tokenbuf);
+ warn("Ambiguous use of %c resolved as operator %c",
+ lastchar, lastchar);
+ }
+ TOKEN(WORD);
+ }
+
+ case KEY___LINE__:
+ case KEY___FILE__: {
+ if (tokenbuf[2] == 'L')
+ (void)sprintf(tokenbuf,"%ld",(long)curcop->cop_line);
+ else
+ strcpy(tokenbuf, SvPVX(GvSV(curcop->cop_filegv)));
+ yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
+ TERM(THING);
+ }
+
+ case KEY___DATA__:
+ case KEY___END__: {
+ GV *gv;
+
+ /*SUPPRESS 560*/
+ if (!in_eval || tokenbuf[2] == 'D') {
+ char dname[256];
+ char *pname = "main";
+ if (tokenbuf[2] == 'D')
+ pname = HvNAME(curstash ? curstash : defstash);
+ sprintf(dname,"%s::DATA", pname);
+ gv = gv_fetchpv(dname,TRUE, SVt_PVIO);
+ SvMULTI_on(gv);
+ if (!GvIO(gv))
+ GvIOp(gv) = newIO();
+ IoIFP(GvIOp(gv)) = rsfp;
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+ {
+ int fd = fileno(rsfp);
+ fcntl(fd,F_SETFD,fd >= 3);
+ }
+#endif
+ if (preprocess)
+ IoTYPE(GvIOp(gv)) = '|';
+ else if ((FILE*)rsfp == stdin)
+ IoTYPE(GvIOp(gv)) = '-';
+ else
+ IoTYPE(GvIOp(gv)) = '<';
+ rsfp = Nullfp;
+ }
+ goto fake_eof;
+ }
+
+ case KEY_AUTOLOAD:
+ case KEY_DESTROY:
+ case KEY_BEGIN:
+ case KEY_END:
+ if (expect == XSTATE) {
+ s = bufptr;
+ goto really_sub;
+ }
+ goto just_a_word;
+
+ case KEY_CORE:
+ if (*s == ':' && s[1] == ':') {
+ s += 2;
+ d = s;
+ s = scan_word(s, tokenbuf, FALSE, &len);
+ tmp = keyword(tokenbuf, len);
+ if (tmp < 0)
+ tmp = -tmp;
+ goto reserved_word;
+ }
+ goto just_a_word;
+
+ case KEY_abs:
+ UNI(OP_ABS);
+
+ case KEY_alarm:
+ UNI(OP_ALARM);
+
+ case KEY_accept:
+ LOP(OP_ACCEPT,XTERM);
+
+ case KEY_and:
+ OPERATOR(ANDOP);
+
+ case KEY_atan2:
+ LOP(OP_ATAN2,XTERM);
+
+ case KEY_bind:
+ LOP(OP_BIND,XTERM);
+
+ case KEY_binmode:
+ UNI(OP_BINMODE);
+
+ case KEY_bless:
+ LOP(OP_BLESS,XTERM);
+
+ case KEY_chop:
+ UNI(OP_CHOP);
+
+ case KEY_continue:
+ PREBLOCK(CONTINUE);
+
+ case KEY_chdir:
+ (void)gv_fetchpv("ENV",TRUE, SVt_PVHV); /* may use HOME */
+ UNI(OP_CHDIR);
+
+ case KEY_close:
+ UNI(OP_CLOSE);
+
+ case KEY_closedir:
+ UNI(OP_CLOSEDIR);
+
+ case KEY_cmp:
+ Eop(OP_SCMP);
+
+ case KEY_caller:
+ UNI(OP_CALLER);
+
+ case KEY_crypt:
+#ifdef FCRYPT
+ if (!cryptseen++)
+ init_des();
+#endif
+ LOP(OP_CRYPT,XTERM);
+
+ case KEY_chmod:
+ if (dowarn) {
+ for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ;
+ if (*d != '0' && isDIGIT(*d))
+ yywarn("chmod: mode argument is missing initial 0");
+ }
+ LOP(OP_CHMOD,XTERM);
+
+ case KEY_chown:
+ LOP(OP_CHOWN,XTERM);
+
+ case KEY_connect:
+ LOP(OP_CONNECT,XTERM);
+
+ case KEY_chr:
+ UNI(OP_CHR);
+
+ case KEY_cos:
+ UNI(OP_COS);
+
+ case KEY_chroot:
+ UNI(OP_CHROOT);
+
+ case KEY_do:
+ s = skipspace(s);
+ if (*s == '{')
+ PRETERMBLOCK(DO);
+ if (*s != '\'')
+ s = force_word(s,WORD,FALSE,TRUE,FALSE);
+ OPERATOR(DO);
+
+ case KEY_die:
+ hints |= HINT_BLOCK_SCOPE;
+ LOP(OP_DIE,XTERM);
+
+ case KEY_defined:
+ UNI(OP_DEFINED);
+
+ case KEY_delete:
+ UNI(OP_DELETE);
+
+ case KEY_dbmopen:
+ gv_fetchpv("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV);
+ LOP(OP_DBMOPEN,XTERM);
+
+ case KEY_dbmclose:
+ UNI(OP_DBMCLOSE);
+
+ case KEY_dump:
+ s = force_word(s,WORD,TRUE,FALSE,FALSE);
+ LOOPX(OP_DUMP);
+
+ case KEY_else:
+ PREBLOCK(ELSE);
+
+ case KEY_elsif:
+ yylval.ival = curcop->cop_line;
+ OPERATOR(ELSIF);
+
+ case KEY_eq:
+ Eop(OP_SEQ);
+
+ case KEY_exists:
+ UNI(OP_EXISTS);
+
+ case KEY_exit:
+ UNI(OP_EXIT);
+
+ case KEY_eval:
+ s = skipspace(s);
+ expect = (*s == '{') ? XTERMBLOCK : XTERM;
+ UNIBRACK(OP_ENTEREVAL);
+
+ case KEY_eof:
+ UNI(OP_EOF);
+
+ case KEY_exp:
+ UNI(OP_EXP);
+
+ case KEY_each:
+ UNI(OP_EACH);
+
+ case KEY_exec:
+ set_csh();
+ LOP(OP_EXEC,XREF);
+
+ case KEY_endhostent:
+ FUN0(OP_EHOSTENT);
+
+ case KEY_endnetent:
+ FUN0(OP_ENETENT);
+
+ case KEY_endservent:
+ FUN0(OP_ESERVENT);
+
+ case KEY_endprotoent:
+ FUN0(OP_EPROTOENT);
+
+ case KEY_endpwent:
+ FUN0(OP_EPWENT);
+
+ case KEY_endgrent:
+ FUN0(OP_EGRENT);
+
+ case KEY_for:
+ case KEY_foreach:
+ yylval.ival = curcop->cop_line;
+ while (s < bufend && isSPACE(*s))
+ s++;
+ if (isIDFIRST(*s))
+ croak("Missing $ on loop variable");
+ OPERATOR(FOR);
+
+ case KEY_formline:
+ LOP(OP_FORMLINE,XTERM);
+
+ case KEY_fork:
+ FUN0(OP_FORK);
+
+ case KEY_fcntl:
+ LOP(OP_FCNTL,XTERM);
+
+ case KEY_fileno:
+ UNI(OP_FILENO);
+
+ case KEY_flock:
+ LOP(OP_FLOCK,XTERM);
+
+ case KEY_gt:
+ Rop(OP_SGT);
+
+ case KEY_ge:
+ Rop(OP_SGE);
+
+ case KEY_grep:
+ LOP(OP_GREPSTART, *s == '(' ? XTERM : XREF);
+
+ case KEY_goto:
+ s = force_word(s,WORD,TRUE,FALSE,FALSE);
+ LOOPX(OP_GOTO);
+
+ case KEY_gmtime:
+ UNI(OP_GMTIME);
+
+ case KEY_getc:
+ UNI(OP_GETC);
+
+ case KEY_getppid:
+ FUN0(OP_GETPPID);
+
+ case KEY_getpgrp:
+ UNI(OP_GETPGRP);
+
+ case KEY_getpriority:
+ LOP(OP_GETPRIORITY,XTERM);
+
+ case KEY_getprotobyname:
+ UNI(OP_GPBYNAME);
+
+ case KEY_getprotobynumber:
+ LOP(OP_GPBYNUMBER,XTERM);
+
+ case KEY_getprotoent:
+ FUN0(OP_GPROTOENT);
+
+ case KEY_getpwent:
+ FUN0(OP_GPWENT);
+
+ case KEY_getpwnam:
+ FUN1(OP_GPWNAM);
+
+ case KEY_getpwuid:
+ FUN1(OP_GPWUID);
+
+ case KEY_getpeername:
+ UNI(OP_GETPEERNAME);
+
+ case KEY_gethostbyname:
+ UNI(OP_GHBYNAME);
+
+ case KEY_gethostbyaddr:
+ LOP(OP_GHBYADDR,XTERM);
+
+ case KEY_gethostent:
+ FUN0(OP_GHOSTENT);
+
+ case KEY_getnetbyname:
+ UNI(OP_GNBYNAME);
+
+ case KEY_getnetbyaddr:
+ LOP(OP_GNBYADDR,XTERM);
+
+ case KEY_getnetent:
+ FUN0(OP_GNETENT);
+
+ case KEY_getservbyname:
+ LOP(OP_GSBYNAME,XTERM);
+
+ case KEY_getservbyport:
+ LOP(OP_GSBYPORT,XTERM);
+
+ case KEY_getservent:
+ FUN0(OP_GSERVENT);
+
+ case KEY_getsockname:
+ UNI(OP_GETSOCKNAME);
+
+ case KEY_getsockopt:
+ LOP(OP_GSOCKOPT,XTERM);
+
+ case KEY_getgrent:
+ FUN0(OP_GGRENT);
+
+ case KEY_getgrnam:
+ FUN1(OP_GGRNAM);
+
+ case KEY_getgrgid:
+ FUN1(OP_GGRGID);
+
+ case KEY_getlogin:
+ FUN0(OP_GETLOGIN);
+
+ case KEY_glob:
+ set_csh();
+ LOP(OP_GLOB,XTERM);
+
+ case KEY_hex:
+ UNI(OP_HEX);
+
+ case KEY_if:
+ yylval.ival = curcop->cop_line;
+ OPERATOR(IF);
+
+ case KEY_index:
+ LOP(OP_INDEX,XTERM);
+
+ case KEY_int:
+ UNI(OP_INT);
+
+ case KEY_ioctl:
+ LOP(OP_IOCTL,XTERM);
+
+ case KEY_join:
+ LOP(OP_JOIN,XTERM);
+
+ case KEY_keys:
+ UNI(OP_KEYS);
+
+ case KEY_kill:
+ LOP(OP_KILL,XTERM);
+
+ case KEY_last:
+ s = force_word(s,WORD,TRUE,FALSE,FALSE);
+ LOOPX(OP_LAST);
+
+ case KEY_lc:
+ UNI(OP_LC);
+
+ case KEY_lcfirst:
+ UNI(OP_LCFIRST);
+
+ case KEY_local:
+ yylval.ival = 0;
+ OPERATOR(LOCAL);
+
+ case KEY_length:
+ UNI(OP_LENGTH);
+
+ case KEY_lt:
+ Rop(OP_SLT);
+
+ case KEY_le:
+ Rop(OP_SLE);
+
+ case KEY_localtime:
+ UNI(OP_LOCALTIME);
+
+ case KEY_log:
+ UNI(OP_LOG);
+
+ case KEY_link:
+ LOP(OP_LINK,XTERM);
+
+ case KEY_listen:
+ LOP(OP_LISTEN,XTERM);
+
+ case KEY_lstat:
+ UNI(OP_LSTAT);
+
+ case KEY_m:
+ s = scan_pat(s);
+ TERM(sublex_start());
+
+ case KEY_map:
+ LOP(OP_MAPSTART,XREF);
+
+ case KEY_mkdir:
+ LOP(OP_MKDIR,XTERM);
+
+ case KEY_msgctl:
+ LOP(OP_MSGCTL,XTERM);
+
+ case KEY_msgget:
+ LOP(OP_MSGGET,XTERM);
+
+ case KEY_msgrcv:
+ LOP(OP_MSGRCV,XTERM);
+
+ case KEY_msgsnd:
+ LOP(OP_MSGSND,XTERM);
+
+ case KEY_my:
+ in_my = TRUE;
+ yylval.ival = 1;
+ OPERATOR(LOCAL);
+
+ case KEY_next:
+ s = force_word(s,WORD,TRUE,FALSE,FALSE);
+ LOOPX(OP_NEXT);
+
+ case KEY_ne:
+ Eop(OP_SNE);
+
+ case KEY_no:
+ if (expect != XSTATE)
+ yyerror("\"no\" not allowed in expression");
+ s = force_word(s,WORD,FALSE,TRUE,FALSE);
+ yylval.ival = 0;
+ OPERATOR(USE);
+
+ case KEY_not:
+ OPERATOR(NOTOP);
+
+ case KEY_open:
+ s = skipspace(s);
+ if (isIDFIRST(*s)) {
+ char *t;
+ for (d = s; isALNUM(*d); d++) ;
+ t = skipspace(d);
+ if (strchr("|&*+-=!?:.", *t))
+ warn("Precedence problem: open %.*s should be open(%.*s)",
+ d-s,s, d-s,s);
+ }
+ LOP(OP_OPEN,XTERM);
+
+ case KEY_or:
+ yylval.ival = OP_OR;
+ OPERATOR(OROP);
+
+ case KEY_ord:
+ UNI(OP_ORD);
+
+ case KEY_oct:
+ UNI(OP_OCT);
+
+ case KEY_opendir:
+ LOP(OP_OPEN_DIR,XTERM);
+
+ case KEY_print:
+ checkcomma(s,tokenbuf,"filehandle");
+ LOP(OP_PRINT,XREF);
+
+ case KEY_printf:
+ checkcomma(s,tokenbuf,"filehandle");
+ LOP(OP_PRTF,XREF);
+
+ case KEY_prototype:
+ UNI(OP_PROTOTYPE);
+
+ case KEY_push:
+ LOP(OP_PUSH,XTERM);
+
+ case KEY_pop:
+ UNI(OP_POP);
+
+ case KEY_pos:
+ UNI(OP_POS);
+
+ case KEY_pack:
+ LOP(OP_PACK,XTERM);
+
+ case KEY_package:
+ s = force_word(s,WORD,FALSE,TRUE,FALSE);
+ OPERATOR(PACKAGE);
+
+ case KEY_pipe:
+ LOP(OP_PIPE_OP,XTERM);
+
+ case KEY_q:
+ s = scan_str(s);
+ if (!s)
+ missingterm((char*)0);
+ yylval.ival = OP_CONST;
+ TERM(sublex_start());
+
+ case KEY_quotemeta:
+ UNI(OP_QUOTEMETA);
+
+ case KEY_qw:
+ s = scan_str(s);
+ if (!s)
+ missingterm((char*)0);
+ force_next(')');
+ nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff));
+ lex_stuff = Nullsv;
+ force_next(THING);
+ force_next(',');
+ nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1));
+ force_next(THING);
+ force_next('(');
+ yylval.ival = OP_SPLIT;
+ CLINE;
+ expect = XTERM;
+ bufptr = s;
+ last_lop = oldbufptr;
+ last_lop_op = OP_SPLIT;
+ return FUNC;
+
+ case KEY_qq:
+ s = scan_str(s);
+ if (!s)
+ missingterm((char*)0);
+ yylval.ival = OP_STRINGIFY;
+ if (SvIVX(lex_stuff) == '\'')
+ SvIVX(lex_stuff) = 0; /* qq'$foo' should intepolate */
+ TERM(sublex_start());
+
+ case KEY_qx:
+ s = scan_str(s);
+ if (!s)
+ missingterm((char*)0);
+ yylval.ival = OP_BACKTICK;
+ set_csh();
+ TERM(sublex_start());
+
+ case KEY_return:
+ OLDLOP(OP_RETURN);
+
+ case KEY_require:
+ *tokenbuf = '\0';
+ s = force_word(s,WORD,TRUE,TRUE,FALSE);
+ if (isIDFIRST(*tokenbuf))
+ gv_stashpv(tokenbuf, TRUE);
+ else if (*s == '<')
+ yyerror("<> should be quotes");
+ UNI(OP_REQUIRE);
+
+ case KEY_reset:
+ UNI(OP_RESET);
+
+ case KEY_redo:
+ s = force_word(s,WORD,TRUE,FALSE,FALSE);
+ LOOPX(OP_REDO);
+
+ case KEY_rename:
+ LOP(OP_RENAME,XTERM);
+
+ case KEY_rand:
+ UNI(OP_RAND);
+
+ case KEY_rmdir:
+ UNI(OP_RMDIR);
+
+ case KEY_rindex:
+ LOP(OP_RINDEX,XTERM);
+
+ case KEY_read:
+ LOP(OP_READ,XTERM);
+
+ case KEY_readdir:
+ UNI(OP_READDIR);
+
+ case KEY_readline:
+ set_csh();
+ UNI(OP_READLINE);
+
+ case KEY_readpipe:
+ set_csh();
+ UNI(OP_BACKTICK);
+
+ case KEY_rewinddir:
+ UNI(OP_REWINDDIR);
+
+ case KEY_recv:
+ LOP(OP_RECV,XTERM);
+
+ case KEY_reverse:
+ LOP(OP_REVERSE,XTERM);
+
+ case KEY_readlink:
+ UNI(OP_READLINK);
+
+ case KEY_ref:
+ UNI(OP_REF);
+
+ case KEY_s:
+ s = scan_subst(s);
+ if (yylval.opval)
+ TERM(sublex_start());
+ else
+ TOKEN(1); /* force error */
+
+ case KEY_chomp:
+ UNI(OP_CHOMP);
+
+ case KEY_scalar:
+ UNI(OP_SCALAR);
+
+ case KEY_select:
+ LOP(OP_SELECT,XTERM);
+
+ case KEY_seek:
+ LOP(OP_SEEK,XTERM);
+
+ case KEY_semctl:
+ LOP(OP_SEMCTL,XTERM);
+
+ case KEY_semget:
+ LOP(OP_SEMGET,XTERM);
+
+ case KEY_semop:
+ LOP(OP_SEMOP,XTERM);
- case '*':
- if (expectterm) {
- s = scanreg(s,bufend,tokenbuf);
- yylval.stabval = stabent(tokenbuf,TRUE);
- TERM(STAR);
- }
- tmp = *s++;
- if (*s == tmp) {
- s++;
- OPERATOR(POW);
- }
- MOP(O_MULTIPLY);
- case '%':
- if (expectterm) {
- s = scanreg(s,bufend,tokenbuf);
- yylval.stabval = stabent(tokenbuf,TRUE);
- TERM(HSH);
- }
- s++;
- MOP(O_MODULO);
+ case KEY_send:
+ LOP(OP_SEND,XTERM);
- case '^':
- case '~':
- case '(':
- case ',':
- case ':':
- case '[':
- tmp = *s++;
- OPERATOR(tmp);
- case '{':
- tmp = *s++;
- if (isspace(*s) || *s == '#')
- cmdline = NOLINE; /* invalidate current command line number */
- OPERATOR(tmp);
- case ';':
- if (line < cmdline)
- cmdline = line;
- tmp = *s++;
- OPERATOR(tmp);
- case ')':
- case ']':
- tmp = *s++;
- TERM(tmp);
- case '}':
- tmp = *s++;
- RETURN(tmp);
- 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 */
- 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) {
- s = scanstr(s);
- TERM(RSTRING);
- }
- s++;
- tmp = *s++;
- if (tmp == '<')
- OPERATOR(LS);
- if (tmp == '=')
- 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 (isascii(*s) && \
- (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')) \
- *d++ = *s++; \
- while (d[-1] == '\'') \
- d--,s--; \
- *d = '\0'; \
- d = tokenbuf;
+ case KEY_setpgrp:
+ LOP(OP_SETPGRP,XTERM);
- case '$':
- if (s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) {
- s++;
- s = scanreg(s,bufend,tokenbuf);
- yylval.stabval = aadd(stabent(tokenbuf,TRUE));
- TERM(ARYLEN);
- }
- d = s;
- s = scanreg(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);
- TERM(REG);
+ case KEY_setpriority:
+ LOP(OP_SETPRIORITY,XTERM);
- case '@':
- d = s;
- s = scanreg(s,bufend,tokenbuf);
- if (reparse)
- goto do_reparse;
- yylval.stabval = stabent(tokenbuf,TRUE);
- TERM(ARY);
+ case KEY_sethostent:
+ FUN1(OP_SHOSTENT);
- case '/': /* may either be division or pattern */
- case '?': /* may either be conditional or pattern */
- if (expectterm) {
- s = scanpat(s);
- TERM(PATTERN);
- }
- tmp = *s++;
- if (tmp == '/')
- MOP(O_DIVIDE);
- OPERATOR(tmp);
+ case KEY_setnetent:
+ FUN1(OP_SNETENT);
- case '.':
- if (!expectterm || !isdigit(s[1])) {
- tmp = *s++;
- if (*s == tmp) {
- s++;
- OPERATOR(DOTDOT);
+ case KEY_setservent:
+ FUN1(OP_SSERVENT);
+
+ case KEY_setprotoent:
+ FUN1(OP_SPROTOENT);
+
+ case KEY_setpwent:
+ FUN0(OP_SPWENT);
+
+ case KEY_setgrent:
+ FUN0(OP_SGRENT);
+
+ case KEY_seekdir:
+ LOP(OP_SEEKDIR,XTERM);
+
+ case KEY_setsockopt:
+ LOP(OP_SSOCKOPT,XTERM);
+
+ case KEY_shift:
+ UNI(OP_SHIFT);
+
+ case KEY_shmctl:
+ LOP(OP_SHMCTL,XTERM);
+
+ case KEY_shmget:
+ LOP(OP_SHMGET,XTERM);
+
+ case KEY_shmread:
+ LOP(OP_SHMREAD,XTERM);
+
+ case KEY_shmwrite:
+ LOP(OP_SHMWRITE,XTERM);
+
+ case KEY_shutdown:
+ LOP(OP_SHUTDOWN,XTERM);
+
+ case KEY_sin:
+ UNI(OP_SIN);
+
+ case KEY_sleep:
+ UNI(OP_SLEEP);
+
+ case KEY_socket:
+ LOP(OP_SOCKET,XTERM);
+
+ case KEY_socketpair:
+ LOP(OP_SOCKPAIR,XTERM);
+
+ case KEY_sort:
+ checkcomma(s,tokenbuf,"subroutine name");
+ s = skipspace(s);
+ if (*s == ';' || *s == ')') /* probably a close */
+ croak("sort is now a reserved word");
+ expect = XTERM;
+ s = force_word(s,WORD,TRUE,TRUE,TRUE);
+ LOP(OP_SORT,XREF);
+
+ case KEY_split:
+ LOP(OP_SPLIT,XTERM);
+
+ case KEY_sprintf:
+ LOP(OP_SPRINTF,XTERM);
+
+ case KEY_splice:
+ LOP(OP_SPLICE,XTERM);
+
+ case KEY_sqrt:
+ UNI(OP_SQRT);
+
+ case KEY_srand:
+ UNI(OP_SRAND);
+
+ case KEY_stat:
+ UNI(OP_STAT);
+
+ case KEY_study:
+ sawstudy++;
+ UNI(OP_STUDY);
+
+ case KEY_substr:
+ LOP(OP_SUBSTR,XTERM);
+
+ case KEY_format:
+ case KEY_sub:
+ really_sub:
+ s = skipspace(s);
+
+ if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
+ char tmpbuf[128];
+ expect = XBLOCK;
+ d = scan_word(s, tmpbuf, TRUE, &len);
+ if (strchr(tmpbuf, ':'))
+ sv_setpv(subname, tmpbuf);
+ else {
+ sv_setsv(subname,curstname);
+ sv_catpvn(subname,"::",2);
+ sv_catpvn(subname,tmpbuf,len);
+ }
+ s = force_word(s,WORD,FALSE,TRUE,TRUE);
+ s = skipspace(s);
+ }
+ else {
+ expect = XTERMBLOCK;
+ sv_setpv(subname,"?");
+ }
+
+ if (tmp == KEY_format) {
+ s = skipspace(s);
+ if (*s == '=')
+ lex_formbrack = lex_brackets + 1;
+ OPERATOR(FORMAT);
+ }
+
+ /* Look for a prototype */
+ if (*s == '(') {
+ s = scan_str(s);
+ if (!s) {
+ if (lex_stuff)
+ SvREFCNT_dec(lex_stuff);
+ lex_stuff = Nullsv;
+ croak("Prototype not terminated");
+ }
+ nexttoke++;
+ nextval[1] = nextval[0];
+ nexttype[1] = nexttype[0];
+ nextval[0].opval = (OP*)newSVOP(OP_CONST, 0, lex_stuff);
+ nexttype[0] = THING;
+ if (nexttoke == 1) {
+ lex_defer = lex_state;
+ lex_expect = expect;
+ lex_state = LEX_KNOWNEXT;
+ }
+ lex_stuff = Nullsv;
+ }
+
+ if (*SvPV(subname,na) == '?') {
+ sv_setpv(subname,"__ANON__");
+ TOKEN(ANONSUB);
+ }
+ PREBLOCK(SUB);
+
+ case KEY_system:
+ set_csh();
+ LOP(OP_SYSTEM,XREF);
+
+ case KEY_symlink:
+ LOP(OP_SYMLINK,XTERM);
+
+ case KEY_syscall:
+ LOP(OP_SYSCALL,XTERM);
+
+ case KEY_sysopen:
+ LOP(OP_SYSOPEN,XTERM);
+
+ case KEY_sysread:
+ LOP(OP_SYSREAD,XTERM);
+
+ case KEY_syswrite:
+ LOP(OP_SYSWRITE,XTERM);
+
+ case KEY_tr:
+ s = scan_trans(s);
+ TERM(sublex_start());
+
+ case KEY_tell:
+ UNI(OP_TELL);
+
+ case KEY_telldir:
+ UNI(OP_TELLDIR);
+
+ case KEY_tie:
+ LOP(OP_TIE,XTERM);
+
+ case KEY_tied:
+ UNI(OP_TIED);
+
+ case KEY_time:
+ FUN0(OP_TIME);
+
+ case KEY_times:
+ FUN0(OP_TMS);
+
+ case KEY_truncate:
+ LOP(OP_TRUNCATE,XTERM);
+
+ case KEY_uc:
+ UNI(OP_UC);
+
+ case KEY_ucfirst:
+ UNI(OP_UCFIRST);
+
+ case KEY_untie:
+ UNI(OP_UNTIE);
+
+ case KEY_until:
+ yylval.ival = curcop->cop_line;
+ OPERATOR(UNTIL);
+
+ case KEY_unless:
+ yylval.ival = curcop->cop_line;
+ OPERATOR(UNLESS);
+
+ case KEY_unlink:
+ LOP(OP_UNLINK,XTERM);
+
+ case KEY_undef:
+ UNI(OP_UNDEF);
+
+ case KEY_unpack:
+ LOP(OP_UNPACK,XTERM);
+
+ case KEY_utime:
+ LOP(OP_UTIME,XTERM);
+
+ case KEY_umask:
+ if (dowarn) {
+ for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ;
+ if (*d != '0' && isDIGIT(*d))
+ yywarn("umask: argument is missing initial 0");
}
- AOP(O_CONCAT);
+ UNI(OP_UMASK);
+
+ case KEY_unshift:
+ LOP(OP_UNSHIFT,XTERM);
+
+ case KEY_use:
+ if (expect != XSTATE)
+ yyerror("\"use\" not allowed in expression");
+ s = force_word(s,WORD,FALSE,TRUE,FALSE);
+ yylval.ival = 1;
+ OPERATOR(USE);
+
+ case KEY_values:
+ UNI(OP_VALUES);
+
+ case KEY_vec:
+ sawvec = TRUE;
+ LOP(OP_VEC,XTERM);
+
+ case KEY_while:
+ yylval.ival = curcop->cop_line;
+ OPERATOR(WHILE);
+
+ case KEY_warn:
+ hints |= HINT_BLOCK_SCOPE;
+ LOP(OP_WARN,XTERM);
+
+ case KEY_wait:
+ FUN0(OP_WAIT);
+
+ case KEY_waitpid:
+ LOP(OP_WAITPID,XTERM);
+
+ case KEY_wantarray:
+ FUN0(OP_WANTARRAY);
+
+ case KEY_write:
+ gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */
+ UNI(OP_ENTERWRITE);
+
+ case KEY_x:
+ if (expect == XOPERATOR)
+ Mop(OP_REPEAT);
+ check_uni();
+ goto just_a_word;
+
+ case KEY_xor:
+ yylval.ival = OP_XOR;
+ OPERATOR(OROP);
+
+ case KEY_y:
+ s = scan_trans(s);
+ TERM(sublex_start());
}
- /* 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);
- TERM(RSTRING);
+ }
+}
- case '\\': /* some magic to force next word to be a WORD */
- s++; /* used by do and sub to force a separate namespace */
- /* FALL THROUGH */
+I32
+keyword(d, len)
+register char *d;
+I32 len;
+{
+ switch (*d) {
case '_':
- SNARFWORD;
+ if (d[1] == '_') {
+ if (strEQ(d,"__LINE__")) return -KEY___LINE__;
+ if (strEQ(d,"__FILE__")) return -KEY___FILE__;
+ if (strEQ(d,"__DATA__")) return KEY___DATA__;
+ if (strEQ(d,"__END__")) return KEY___END__;
+ }
break;
- case 'a': case 'A':
- SNARFWORD;
- if (strEQ(d,"accept"))
- FOP22(O_ACCEPT);
- if (strEQ(d,"atan2"))
- FUN2(O_ATAN2);
+ case 'A':
+ if (strEQ(d,"AUTOLOAD")) return KEY_AUTOLOAD;
break;
- case 'b': case 'B':
- SNARFWORD;
- if (strEQ(d,"bind"))
- FOP2(O_BIND);
- if (strEQ(d,"binmode"))
- FOP(O_BINMODE);
+ case 'a':
+ switch (len) {
+ case 3:
+ if (strEQ(d,"and")) return -KEY_and;
+ if (strEQ(d,"abs")) return -KEY_abs;
+ break;
+ case 5:
+ if (strEQ(d,"alarm")) return -KEY_alarm;
+ if (strEQ(d,"atan2")) return -KEY_atan2;
+ break;
+ case 6:
+ if (strEQ(d,"accept")) return -KEY_accept;
+ break;
+ }
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,"crypt")) {
-#ifdef FCRYPT
- 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);
+ case 'B':
+ if (strEQ(d,"BEGIN")) return KEY_BEGIN;
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);
+ case 'b':
+ if (strEQ(d,"bless")) return -KEY_bless;
+ if (strEQ(d,"bind")) return -KEY_bind;
+ if (strEQ(d,"binmode")) return -KEY_binmode;
+ break;
+ case 'C':
+ if (strEQ(d,"CORE")) return -KEY_CORE;
+ break;
+ case 'c':
+ switch (len) {
+ case 3:
+ if (strEQ(d,"cmp")) return -KEY_cmp;
+ if (strEQ(d,"chr")) return -KEY_chr;
+ if (strEQ(d,"cos")) return -KEY_cos;
+ break;
+ case 4:
+ if (strEQ(d,"chop")) return KEY_chop;
+ break;
+ case 5:
+ if (strEQ(d,"close")) return -KEY_close;
+ if (strEQ(d,"chdir")) return -KEY_chdir;
+ if (strEQ(d,"chomp")) return KEY_chomp;
+ if (strEQ(d,"chmod")) return -KEY_chmod;
+ if (strEQ(d,"chown")) return -KEY_chown;
+ if (strEQ(d,"crypt")) return -KEY_crypt;
+ break;
+ case 6:
+ if (strEQ(d,"chroot")) return -KEY_chroot;
+ if (strEQ(d,"caller")) return -KEY_caller;
+ break;
+ case 7:
+ if (strEQ(d,"connect")) return -KEY_connect;
+ break;
+ case 8:
+ if (strEQ(d,"closedir")) return -KEY_closedir;
+ if (strEQ(d,"continue")) return -KEY_continue;
+ break;
}
- 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 = line;
- OPERATOR(ELSIF);
+ case 'D':
+ if (strEQ(d,"DESTROY")) return KEY_DESTROY;
+ break;
+ case 'd':
+ switch (len) {
+ case 2:
+ if (strEQ(d,"do")) return KEY_do;
+ break;
+ case 3:
+ if (strEQ(d,"die")) return -KEY_die;
+ break;
+ case 4:
+ if (strEQ(d,"dump")) return -KEY_dump;
+ break;
+ case 6:
+ if (strEQ(d,"delete")) return KEY_delete;
+ break;
+ case 7:
+ if (strEQ(d,"defined")) return KEY_defined;
+ if (strEQ(d,"dbmopen")) return -KEY_dbmopen;
+ break;
+ case 8:
+ if (strEQ(d,"dbmclose")) return -KEY_dbmclose;
+ break;
}
- 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);
- }
- 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 = line;
- OPERATOR(FOR);
+ case 'E':
+ if (strEQ(d,"EQ")) { deprecate(d); return -KEY_eq;}
+ if (strEQ(d,"END")) return KEY_END;
+ break;
+ case 'e':
+ switch (len) {
+ case 2:
+ if (strEQ(d,"eq")) return -KEY_eq;
+ break;
+ case 3:
+ if (strEQ(d,"eof")) return -KEY_eof;
+ if (strEQ(d,"exp")) return -KEY_exp;
+ break;
+ case 4:
+ if (strEQ(d,"else")) return KEY_else;
+ if (strEQ(d,"exit")) return -KEY_exit;
+ if (strEQ(d,"eval")) return KEY_eval;
+ if (strEQ(d,"exec")) return -KEY_exec;
+ if (strEQ(d,"each")) return KEY_each;
+ break;
+ case 5:
+ if (strEQ(d,"elsif")) return KEY_elsif;
+ break;
+ case 6:
+ if (strEQ(d,"exists")) return KEY_exists;
+ if (strEQ(d,"elseif")) warn("elseif should be elsif");
+ break;
+ case 8:
+ if (strEQ(d,"endgrent")) return -KEY_endgrent;
+ if (strEQ(d,"endpwent")) return -KEY_endpwent;
+ break;
+ case 9:
+ if (strEQ(d,"endnetent")) return -KEY_endnetent;
+ break;
+ case 10:
+ if (strEQ(d,"endhostent")) return -KEY_endhostent;
+ if (strEQ(d,"endservent")) return -KEY_endservent;
+ break;
+ case 11:
+ if (strEQ(d,"endprotoent")) return -KEY_endprotoent;
+ break;
}
- 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);
+ case 'f':
+ switch (len) {
+ case 3:
+ if (strEQ(d,"for")) return KEY_for;
+ break;
+ case 4:
+ if (strEQ(d,"fork")) return -KEY_fork;
+ break;
+ case 5:
+ if (strEQ(d,"fcntl")) return -KEY_fcntl;
+ if (strEQ(d,"flock")) return -KEY_flock;
+ break;
+ case 6:
+ if (strEQ(d,"format")) return KEY_format;
+ if (strEQ(d,"fileno")) return -KEY_fileno;
+ break;
+ case 7:
+ if (strEQ(d,"foreach")) return KEY_foreach;
+ break;
+ case 8:
+ if (strEQ(d,"formline")) return -KEY_formline;
+ break;
+ }
+ break;
+ case 'G':
+ if (len == 2) {
+ if (strEQ(d,"GT")) { deprecate(d); return -KEY_gt;}
+ if (strEQ(d,"GE")) { deprecate(d); return -KEY_ge;}
+ }
+ break;
+ case 'g':
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);
+ switch (len) {
+ case 7:
+ if (strEQ(d,"ppid")) return -KEY_getppid;
+ if (strEQ(d,"pgrp")) return -KEY_getpgrp;
+ break;
+ case 8:
+ if (strEQ(d,"pwent")) return -KEY_getpwent;
+ if (strEQ(d,"pwnam")) return -KEY_getpwnam;
+ if (strEQ(d,"pwuid")) return -KEY_getpwuid;
+ break;
+ case 11:
+ if (strEQ(d,"peername")) return -KEY_getpeername;
+ if (strEQ(d,"protoent")) return -KEY_getprotoent;
+ if (strEQ(d,"priority")) return -KEY_getpriority;
+ break;
+ case 14:
+ if (strEQ(d,"protobyname")) return -KEY_getprotobyname;
+ break;
+ case 16:
+ if (strEQ(d,"protobynumber"))return -KEY_getprotobynumber;
+ break;
+ }
}
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);
+ if (strEQ(d,"hostbyname")) return -KEY_gethostbyname;
+ if (strEQ(d,"hostbyaddr")) return -KEY_gethostbyaddr;
+ if (strEQ(d,"hostent")) return -KEY_gethostent;
}
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);
+ if (strEQ(d,"netbyname")) return -KEY_getnetbyname;
+ if (strEQ(d,"netbyaddr")) return -KEY_getnetbyaddr;
+ if (strEQ(d,"netent")) return -KEY_getnetent;
}
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);
+ if (strEQ(d,"servbyname")) return -KEY_getservbyname;
+ if (strEQ(d,"servbyport")) return -KEY_getservbyport;
+ if (strEQ(d,"servent")) return -KEY_getservent;
+ if (strEQ(d,"sockname")) return -KEY_getsockname;
+ if (strEQ(d,"sockopt")) return -KEY_getsockopt;
}
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);
+ if (strEQ(d,"grent")) return -KEY_getgrent;
+ if (strEQ(d,"grnam")) return -KEY_getgrnam;
+ if (strEQ(d,"grgid")) return -KEY_getgrgid;
}
else if (*d == 'l') {
- if (strEQ(d,"login"))
- FUN0(O_GETLOGIN);
+ if (strEQ(d,"login")) return -KEY_getlogin;
}
- d -= 3;
+ else if (strEQ(d,"c")) return -KEY_getc;
+ break;
}
- 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 = line;
- OPERATOR(IF);
+ switch (len) {
+ case 2:
+ if (strEQ(d,"gt")) return -KEY_gt;
+ if (strEQ(d,"ge")) return -KEY_ge;
+ break;
+ case 4:
+ if (strEQ(d,"grep")) return KEY_grep;
+ if (strEQ(d,"goto")) return KEY_goto;
+ if (strEQ(d,"glob")) return -KEY_glob;
+ break;
+ case 6:
+ if (strEQ(d,"gmtime")) return -KEY_gmtime;
+ break;
}
- if (strEQ(d,"index"))
- FUN2(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);
+ case 'h':
+ if (strEQ(d,"hex")) return -KEY_hex;
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);
+ case 'i':
+ switch (len) {
+ case 2:
+ if (strEQ(d,"if")) return KEY_if;
+ break;
+ case 3:
+ if (strEQ(d,"int")) return -KEY_int;
+ break;
+ case 5:
+ if (strEQ(d,"index")) return -KEY_index;
+ if (strEQ(d,"ioctl")) return -KEY_ioctl;
+ break;
+ }
break;
- case 'm': case 'M':
- if (s[1] == '\'') {
- d = "m";
- s++;
+ case 'j':
+ if (strEQ(d,"join")) return -KEY_join;
+ break;
+ case 'k':
+ if (len == 4) {
+ if (strEQ(d,"keys")) return KEY_keys;
+ if (strEQ(d,"kill")) return -KEY_kill;
}
- else {
- SNARFWORD;
+ break;
+ case 'L':
+ if (len == 2) {
+ if (strEQ(d,"LT")) { deprecate(d); return -KEY_lt;}
+ if (strEQ(d,"LE")) { deprecate(d); return -KEY_le;}
}
- if (strEQ(d,"m")) {
- s = scanpat(s-1);
- if (yylval.arg)
- TERM(PATTERN);
- else
- RETURN(1); /* force error */
+ break;
+ case 'l':
+ switch (len) {
+ case 2:
+ if (strEQ(d,"lt")) return -KEY_lt;
+ if (strEQ(d,"le")) return -KEY_le;
+ if (strEQ(d,"lc")) return -KEY_lc;
+ break;
+ case 3:
+ if (strEQ(d,"log")) return -KEY_log;
+ break;
+ case 4:
+ if (strEQ(d,"last")) return KEY_last;
+ if (strEQ(d,"link")) return -KEY_link;
+ break;
+ case 5:
+ if (strEQ(d,"local")) return KEY_local;
+ if (strEQ(d,"lstat")) return -KEY_lstat;
+ break;
+ case 6:
+ if (strEQ(d,"length")) return -KEY_length;
+ if (strEQ(d,"listen")) return -KEY_listen;
+ break;
+ case 7:
+ if (strEQ(d,"lcfirst")) return -KEY_lcfirst;
+ break;
+ case 9:
+ if (strEQ(d,"localtime")) return -KEY_localtime;
+ break;
}
- if (strEQ(d,"mkdir"))
- FUN2(O_MKDIR);
break;
- case 'n': case 'N':
- SNARFWORD;
- if (strEQ(d,"next"))
- LOOPX(O_NEXT);
- if (strEQ(d,"ne") || strEQ(d,"NE"))
- EOP(O_SNE);
+ case 'm':
+ switch (len) {
+ case 1: return KEY_m;
+ case 2:
+ if (strEQ(d,"my")) return KEY_my;
+ break;
+ case 3:
+ if (strEQ(d,"map")) return KEY_map;
+ break;
+ case 5:
+ if (strEQ(d,"mkdir")) return -KEY_mkdir;
+ break;
+ case 6:
+ if (strEQ(d,"msgctl")) return -KEY_msgctl;
+ if (strEQ(d,"msgget")) return -KEY_msgget;
+ if (strEQ(d,"msgrcv")) return -KEY_msgrcv;
+ if (strEQ(d,"msgsnd")) return -KEY_msgsnd;
+ break;
+ }
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_OPENDIR);
+ case 'N':
+ if (strEQ(d,"NE")) { deprecate(d); return -KEY_ne;}
break;
- case 'p': case 'P':
- SNARFWORD;
- if (strEQ(d,"print")) {
- checkcomma(s,"filehandle");
- LOP(O_PRINT);
- }
- if (strEQ(d,"printf")) {
- checkcomma(s,"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);
+ case 'n':
+ if (strEQ(d,"next")) return KEY_next;
+ if (strEQ(d,"ne")) return -KEY_ne;
+ if (strEQ(d,"not")) return -KEY_not;
+ if (strEQ(d,"no")) return KEY_no;
break;
- case 'q': case 'Q':
- SNARFWORD;
- if (strEQ(d,"q")) {
- s = scanstr(s-1);
- TERM(RSTRING);
- }
- if (strEQ(d,"qq")) {
- s = scanstr(s-2);
- TERM(RSTRING);
+ case 'o':
+ switch (len) {
+ case 2:
+ if (strEQ(d,"or")) return -KEY_or;
+ break;
+ case 3:
+ if (strEQ(d,"ord")) return -KEY_ord;
+ if (strEQ(d,"oct")) return -KEY_oct;
+ break;
+ case 4:
+ if (strEQ(d,"open")) return -KEY_open;
+ break;
+ case 7:
+ if (strEQ(d,"opendir")) return -KEY_opendir;
+ break;
}
break;
- case 'r': case 'R':
- SNARFWORD;
- if (strEQ(d,"return"))
- OLDLOP(O_RETURN);
- 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"))
- FUN2(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++;
+ case 'p':
+ switch (len) {
+ case 3:
+ if (strEQ(d,"pop")) return KEY_pop;
+ if (strEQ(d,"pos")) return KEY_pos;
+ break;
+ case 4:
+ if (strEQ(d,"push")) return KEY_push;
+ if (strEQ(d,"pack")) return -KEY_pack;
+ if (strEQ(d,"pipe")) return -KEY_pipe;
+ break;
+ case 5:
+ if (strEQ(d,"print")) return KEY_print;
+ break;
+ case 6:
+ if (strEQ(d,"printf")) return KEY_printf;
+ break;
+ case 7:
+ if (strEQ(d,"package")) return KEY_package;
+ break;
+ case 9:
+ if (strEQ(d,"prototype")) return KEY_prototype;
}
- else {
- SNARFWORD;
+ break;
+ case 'q':
+ if (len <= 2) {
+ if (strEQ(d,"q")) return KEY_q;
+ if (strEQ(d,"qq")) return KEY_qq;
+ if (strEQ(d,"qw")) return KEY_qw;
+ if (strEQ(d,"qx")) return KEY_qx;
}
- if (strEQ(d,"s")) {
- s = scansubst(s);
- if (yylval.arg)
- TERM(SUBST);
- else
- RETURN(1); /* force error */
+ else if (strEQ(d,"quotemeta")) return -KEY_quotemeta;
+ break;
+ case 'r':
+ switch (len) {
+ case 3:
+ if (strEQ(d,"ref")) return -KEY_ref;
+ break;
+ case 4:
+ if (strEQ(d,"read")) return -KEY_read;
+ if (strEQ(d,"rand")) return -KEY_rand;
+ if (strEQ(d,"recv")) return -KEY_recv;
+ if (strEQ(d,"redo")) return KEY_redo;
+ break;
+ case 5:
+ if (strEQ(d,"rmdir")) return -KEY_rmdir;
+ if (strEQ(d,"reset")) return -KEY_reset;
+ break;
+ case 6:
+ if (strEQ(d,"return")) return KEY_return;
+ if (strEQ(d,"rename")) return -KEY_rename;
+ if (strEQ(d,"rindex")) return -KEY_rindex;
+ break;
+ case 7:
+ if (strEQ(d,"require")) return -KEY_require;
+ if (strEQ(d,"reverse")) return -KEY_reverse;
+ if (strEQ(d,"readdir")) return -KEY_readdir;
+ break;
+ case 8:
+ if (strEQ(d,"readlink")) return -KEY_readlink;
+ if (strEQ(d,"readline")) return -KEY_readline;
+ if (strEQ(d,"readpipe")) return -KEY_readpipe;
+ break;
+ case 9:
+ if (strEQ(d,"rewinddir")) return -KEY_rewinddir;
+ break;
}
+ break;
+ case 's':
switch (d[1]) {
- case 'a':
- case 'b':
+ case 0: return KEY_s;
case 'c':
- case 'd':
+ if (strEQ(d,"scalar")) return KEY_scalar;
break;
case 'e':
- if (strEQ(d,"select"))
- OPERATOR(SELECT);
- if (strEQ(d,"seek"))
- FOP3(O_SEEK);
- 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':
+ switch (len) {
+ case 4:
+ if (strEQ(d,"seek")) return -KEY_seek;
+ if (strEQ(d,"send")) return -KEY_send;
+ break;
+ case 5:
+ if (strEQ(d,"semop")) return -KEY_semop;
+ break;
+ case 6:
+ if (strEQ(d,"select")) return -KEY_select;
+ if (strEQ(d,"semctl")) return -KEY_semctl;
+ if (strEQ(d,"semget")) return -KEY_semget;
+ break;
+ case 7:
+ if (strEQ(d,"setpgrp")) return -KEY_setpgrp;
+ if (strEQ(d,"seekdir")) return -KEY_seekdir;
+ break;
+ case 8:
+ if (strEQ(d,"setpwent")) return -KEY_setpwent;
+ if (strEQ(d,"setgrent")) return -KEY_setgrent;
+ break;
+ case 9:
+ if (strEQ(d,"setnetent")) return -KEY_setnetent;
+ break;
+ case 10:
+ if (strEQ(d,"setsockopt")) return -KEY_setsockopt;
+ if (strEQ(d,"sethostent")) return -KEY_sethostent;
+ if (strEQ(d,"setservent")) return -KEY_setservent;
+ break;
+ case 11:
+ if (strEQ(d,"setpriority")) return -KEY_setpriority;
+ if (strEQ(d,"setprotoent")) return -KEY_setprotoent;
+ break;
+ }
break;
case 'h':
- if (strEQ(d,"shift"))
- TERM(SHIFT);
- if (strEQ(d,"shutdown"))
- FOP2(O_SHUTDOWN);
+ switch (len) {
+ case 5:
+ if (strEQ(d,"shift")) return KEY_shift;
+ break;
+ case 6:
+ if (strEQ(d,"shmctl")) return -KEY_shmctl;
+ if (strEQ(d,"shmget")) return -KEY_shmget;
+ break;
+ case 7:
+ if (strEQ(d,"shmread")) return -KEY_shmread;
+ break;
+ case 8:
+ if (strEQ(d,"shmwrite")) return -KEY_shmwrite;
+ if (strEQ(d,"shutdown")) return -KEY_shutdown;
+ break;
+ }
break;
case 'i':
- if (strEQ(d,"sin"))
- UNI(O_SIN);
- break;
- case 'j':
- case 'k':
+ if (strEQ(d,"sin")) return -KEY_sin;
break;
case 'l':
- if (strEQ(d,"sleep"))
- UNI(O_SLEEP);
- break;
- case 'm':
- case 'n':
+ if (strEQ(d,"sleep")) return -KEY_sleep;
break;
case 'o':
- if (strEQ(d,"socket"))
- FOP4(O_SOCKET);
- if (strEQ(d,"socketpair"))
- FOP25(O_SOCKETPAIR);
- if (strEQ(d,"sort")) {
- checkcomma(s,"subroutine name");
- d = bufend;
- while (s < d && isascii(*s) && isspace(*s)) s++;
- if (*s == ';' || *s == ')') /* probably a close */
- fatal("sort is now a reserved word");
- if (isascii(*s) && (isalpha(*s) || *s == '_')) {
- for (d = s; isalpha(*d) || isdigit(*d) || *d == '_'; d++) ;
- strncpy(tokenbuf,s,d-s);
- if (strNE(tokenbuf,"keys") &&
- strNE(tokenbuf,"values") &&
- strNE(tokenbuf,"split") &&
- strNE(tokenbuf,"grep") &&
- strNE(tokenbuf,"readdir") &&
- strNE(tokenbuf,"unpack") &&
- strNE(tokenbuf,"do") &&
- (d >= bufend || isspace(*d)) )
- *(--s) = '\\'; /* force next ident to WORD */
- }
- LOP(O_SORT);
- }
+ if (strEQ(d,"sort")) return KEY_sort;
+ if (strEQ(d,"socket")) return -KEY_socket;
+ if (strEQ(d,"socketpair")) return -KEY_socketpair;
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);
- }
+ if (strEQ(d,"split")) return KEY_split;
+ if (strEQ(d,"sprintf")) return -KEY_sprintf;
+ if (strEQ(d,"splice")) return KEY_splice;
break;
case 'q':
- if (strEQ(d,"sqrt"))
- UNI(O_SQRT);
+ if (strEQ(d,"sqrt")) return -KEY_sqrt;
break;
case 'r':
- if (strEQ(d,"srand"))
- UNI(O_SRAND);
- break;
- case 's':
+ if (strEQ(d,"srand")) return -KEY_srand;
break;
case 't':
- if (strEQ(d,"stat"))
- FOP(O_STAT);
- if (strEQ(d,"study")) {
- sawstudy++;
- LFUN(O_STUDY);
- }
+ if (strEQ(d,"stat")) return -KEY_stat;
+ if (strEQ(d,"study")) return KEY_study;
break;
case 'u':
- if (strEQ(d,"substr"))
- FUN3(O_SUBSTR);
- if (strEQ(d,"sub")) {
- subline = line;
- d = bufend;
- while (s < d && isspace(*s))
- s++;
- if (isalpha(*s) || *s == '_' || *s == '\'') {
- if (perldb) {
- str_sset(subname,curstname);
- str_ncat(subname,"'",1);
- for (d = s+1;
- isalpha(*d) || isdigit(*d) || *d == '_' || *d == '\'';
- d++);
- if (d[-1] == '\'')
- d--;
- str_ncat(subname,s,d-s);
- }
- *(--s) = '\\'; /* force next ident to WORD */
- }
- else if (perldb)
- str_set(subname,"?");
- OPERATOR(SUB);
- }
- break;
- case 'v':
- case 'w':
- case 'x':
+ if (strEQ(d,"substr")) return -KEY_substr;
+ if (strEQ(d,"sub")) return KEY_sub;
break;
case 'y':
- if (strEQ(d,"system")) {
- set_csh();
- LOP(O_SYSTEM);
+ switch (len) {
+ case 6:
+ if (strEQ(d,"system")) return -KEY_system;
+ break;
+ case 7:
+ if (strEQ(d,"sysopen")) return -KEY_sysopen;
+ if (strEQ(d,"sysread")) return -KEY_sysread;
+ if (strEQ(d,"symlink")) return -KEY_symlink;
+ if (strEQ(d,"syscall")) return -KEY_syscall;
+ break;
+ case 8:
+ if (strEQ(d,"syswrite")) return -KEY_syswrite;
+ break;
}
- if (strEQ(d,"symlink"))
- FUN2(O_SYMLINK);
- if (strEQ(d,"syscall"))
- LOP(O_SYSCALL);
- 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);
- break;
- case 'u': case 'U':
- SNARFWORD;
- if (strEQ(d,"using"))
- OPERATOR(USING);
- if (strEQ(d,"until")) {
- yylval.ival = line;
- OPERATOR(UNTIL);
- }
- if (strEQ(d,"unless")) {
- yylval.ival = 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);
+ case 't':
+ switch (len) {
+ case 2:
+ if (strEQ(d,"tr")) return KEY_tr;
+ break;
+ case 3:
+ if (strEQ(d,"tie")) return KEY_tie;
+ break;
+ case 4:
+ if (strEQ(d,"tell")) return -KEY_tell;
+ if (strEQ(d,"tied")) return KEY_tied;
+ if (strEQ(d,"time")) return -KEY_time;
+ break;
+ case 5:
+ if (strEQ(d,"times")) return -KEY_times;
+ break;
+ case 7:
+ if (strEQ(d,"telldir")) return -KEY_telldir;
+ break;
+ case 8:
+ if (strEQ(d,"truncate")) return -KEY_truncate;
+ break;
}
break;
- case 'v': case 'V':
- SNARFWORD;
- if (strEQ(d,"values"))
- HFUN(O_VALUES);
- if (strEQ(d,"vec")) {
- sawvec = TRUE;
- FUN3(O_VEC);
+ case 'u':
+ switch (len) {
+ case 2:
+ if (strEQ(d,"uc")) return -KEY_uc;
+ break;
+ case 3:
+ if (strEQ(d,"use")) return KEY_use;
+ break;
+ case 5:
+ if (strEQ(d,"undef")) return KEY_undef;
+ if (strEQ(d,"until")) return KEY_until;
+ if (strEQ(d,"untie")) return KEY_untie;
+ if (strEQ(d,"utime")) return -KEY_utime;
+ if (strEQ(d,"umask")) return -KEY_umask;
+ break;
+ case 6:
+ if (strEQ(d,"unless")) return KEY_unless;
+ if (strEQ(d,"unpack")) return -KEY_unpack;
+ if (strEQ(d,"unlink")) return -KEY_unlink;
+ break;
+ case 7:
+ if (strEQ(d,"unshift")) return KEY_unshift;
+ if (strEQ(d,"ucfirst")) return -KEY_ucfirst;
+ break;
}
break;
- case 'w': case 'W':
- SNARFWORD;
- if (strEQ(d,"while")) {
- yylval.ival = line;
- OPERATOR(WHILE);
+ case 'v':
+ if (strEQ(d,"values")) return -KEY_values;
+ if (strEQ(d,"vec")) return -KEY_vec;
+ break;
+ case 'w':
+ switch (len) {
+ case 4:
+ if (strEQ(d,"warn")) return -KEY_warn;
+ if (strEQ(d,"wait")) return -KEY_wait;
+ break;
+ case 5:
+ if (strEQ(d,"while")) return KEY_while;
+ if (strEQ(d,"write")) return -KEY_write;
+ break;
+ case 7:
+ if (strEQ(d,"waitpid")) return -KEY_waitpid;
+ break;
+ case 9:
+ if (strEQ(d,"wantarray")) return -KEY_wantarray;
+ break;
}
- if (strEQ(d,"warn"))
- LOP(O_WARN);
- if (strEQ(d,"wait"))
- FUN0(O_WAIT);
- 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':
- SNARFWORD;
- if (!expectterm && strEQ(d,"x"))
- MOP(O_REPEAT);
+ case 'x':
+ if (len == 1) return -KEY_x;
+ if (strEQ(d,"xor")) return -KEY_xor;
break;
- case 'y': case 'Y':
- if (s[1] == '\'') {
- d = "y";
- s++;
- }
- else {
- SNARFWORD;
- }
- if (strEQ(d,"y")) {
- s = scantrans(s);
- TERM(TRANS);
- }
+ case 'y':
+ if (len == 1) return KEY_y;
break;
- case 'z': case 'Z':
- SNARFWORD;
+ case 'z':
break;
}
- yylval.cval = savestr(d);
- 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);
+ return 0;
}
-int
-checkcomma(s,what)
+static void
+checkcomma(s,name,what)
register char *s;
+char *name;
char *what;
{
- if (*s == '(')
+ char *w;
+
+ if (dowarn && *s == ' ' && s[1] == '(') { /* XXX gotta be a better way */
+ int level = 1;
+ for (w = s+2; *w && level; w++) {
+ if (*w == '(')
+ ++level;
+ else if (*w == ')')
+ --level;
+ }
+ if (*w)
+ for (; *w && isSPACE(*w); w++) ;
+ if (!*w || !strchr(";|})]oa!=", *w)) /* an advisory hack only... */
+ warn("%s (...) interpreted as function",name);
+ }
+ while (s < bufend && isSPACE(*s))
s++;
- while (s < bufend && isascii(*s) && isspace(*s))
+ if (*s == '(')
s++;
- if (isascii(*s) && (isalpha(*s) || *s == '_')) {
+ while (s < bufend && isSPACE(*s))
s++;
- while (isalpha(*s) || isdigit(*s) || *s == '_')
+ if (isIDFIRST(*s)) {
+ w = s++;
+ while (isALNUM(*s))
s++;
- while (s < bufend && isspace(*s))
+ while (s < bufend && isSPACE(*s))
s++;
- if (*s == ',')
- fatal("No comma allowed after %s", what);
+ if (*s == ',') {
+ int kw;
+ *s = '\0';
+ kw = keyword(w, s - w) || perl_get_cv(w, FALSE) != 0;
+ *s = ',';
+ if (kw)
+ return;
+ croak("No comma allowed after %s", what);
+ }
}
}
-char *
-scanreg(s,send,dest)
+static char *
+scan_word(s, dest, allow_package, slp)
+register char *s;
+char *dest;
+int allow_package;
+STRLEN *slp;
+{
+ register char *d = dest;
+ for (;;) {
+ if (isALNUM(*s))
+ *d++ = *s++;
+ else if (*s == '\'' && allow_package && isIDFIRST(s[1])) {
+ *d++ = ':';
+ *d++ = ':';
+ s++;
+ }
+ else if (*s == ':' && s[1] == ':' && allow_package && isIDFIRST(s[2])) {
+ *d++ = *s++;
+ *d++ = *s++;
+ }
+ else {
+ *d = '\0';
+ *slp = d - dest;
+ return s;
+ }
+ }
+}
+
+static char *
+scan_ident(s,send,dest,ck_uni)
register char *s;
register char *send;
char *dest;
+I32 ck_uni;
{
register char *d;
- int brackets = 0;
+ char *bracket = 0;
+ char funny = *s++;
- reparse = Nullch;
- s++;
+ if (lex_brackets == 0)
+ lex_fakebrack = 0;
+ if (isSPACE(*s))
+ s = skipspace(s);
d = dest;
- if (isdigit(*s)) {
- while (isdigit(*s))
+ if (isDIGIT(*s)) {
+ while (isDIGIT(*s))
*d++ = *s++;
}
else {
- while (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')
- *d++ = *s++;
+ for (;;) {
+ if (isALNUM(*s))
+ *d++ = *s++;
+ else if (*s == '\'' && isIDFIRST(s[1])) {
+ *d++ = ':';
+ *d++ = ':';
+ s++;
+ }
+ else if (*s == ':' && s[1] == ':') {
+ *d++ = *s++;
+ *d++ = *s++;
+ }
+ else
+ break;
+ }
}
- while (d > dest+1 && d[-1] == '\'')
- d--,s--;
*d = '\0';
d = dest;
- if (!*d) {
+ if (*d) {
+ if (lex_state != LEX_NORMAL)
+ lex_state = LEX_INTERPENDMAYBE;
+ return s;
+ }
+ if (*s == '$' && s[1] &&
+ (isALPHA(s[1]) || strchr("$_{", s[1]) || strnEQ(s+1,"::",2)) )
+ return s;
+ if (*s == '{') {
+ bracket = s;
+ s++;
+ }
+ else if (ck_uni)
+ check_uni();
+ if (s < send)
*d = *s++;
- if (*d == '{' /* } */ ) {
- d = dest;
- brackets++;
- while (s < send && brackets) {
- if (!reparse && (d == dest || (*s && isascii(*s) &&
- (isalpha(*s) || isdigit(*s) || *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[1] = '\0';
+ if (*d == '^' && *s && (isUPPER(*s) || strchr("[\\]^_?", *s))) {
+ *d = *s++ ^ 64;
+ }
+ if (bracket) {
+ if (isSPACE(s[-1])) {
+ while (s < send && (*s == ' ' || *s == '\t')) s++;
+ *d = *s;
+ }
+ if (isALPHA(*d) || *d == '_') {
+ d++;
+ while (isALNUM(*s) || *s == ':')
+ *d++ = *s++;
+ *d = '\0';
+ while (s < send && (*s == ' ' || *s == '\t')) s++;
+ if ((*s == '[' || *s == '{')) {
+ if (dowarn && keyword(dest, d - dest)) {
+ char *brack = *s == '[' ? "[...]" : "{...}";
+ warn("Ambiguous use of %c{%s%s} resolved to %c%s%s",
+ funny, dest, brack, funny, dest, brack);
}
+ lex_fakebrack = lex_brackets+1;
+ bracket++;
+ lex_brackstack[lex_brackets++] = XOPERATOR;
+ return s;
}
- *d = '\0';
- d = dest;
}
- else
- d[1] = '\0';
+ if (*s == '}') {
+ s++;
+ if (lex_state == LEX_INTERPNORMAL && !lex_brackets)
+ lex_state = LEX_INTERPEND;
+ if (funny == '#')
+ funny = '@';
+ if (dowarn &&
+ (keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
+ warn("Ambiguous use of %c{%s} resolved to %c%s",
+ funny, dest, funny, dest);
+ }
+ else {
+ s = bracket; /* let the parser handle it */
+ *dest = '\0';
+ }
}
- if (*d == '^' && !isspace(*s))
- *d = *s++ & 31;
+ else if (lex_state == LEX_INTERPNORMAL && !lex_brackets && !intuit_more(s))
+ lex_state = LEX_INTERPEND;
return s;
}
-STR *
-scanconst(string,len)
-char *string;
-int len;
+void pmflag(pmfl,ch)
+U16* pmfl;
+int ch;
{
- register STR *retstr;
- register char *t;
- register char *d;
- register char *e;
-
- if (index(string,'|')) {
- return Nullstr;
- }
- retstr = Str_new(86,len);
- str_nset(retstr,string,len);
- t = str_get(retstr);
- e = t + len;
- retstr->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 '+':
- e = d;
- break;
- case '\\':
- if (d[1] && index("wWbB0123456789sSdD",d[1])) {
- e = d;
- break;
- }
- (void)bcopy(d+1,d,e-d);
- e--;
- switch(*d) {
- case 'n':
- *d = '\n';
- break;
- case 't':
- *d = '\t';
- break;
- case 'f':
- *d = '\f';
- break;
- case 'r':
- *d = '\r';
- break;
- }
- /* FALL THROUGH */
- default:
- defchar:
- if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
- e = d;
- break;
- }
- d++;
- }
+ if (ch == 'i') {
+ sawi = TRUE;
+ *pmfl |= PMf_FOLD;
}
- if (d == t) {
- str_free(retstr);
- return Nullstr;
+ else if (ch == 'g')
+ *pmfl |= PMf_GLOBAL;
+ else if (ch == 'o')
+ *pmfl |= PMf_KEEP;
+ else if (ch == 'm')
+ *pmfl |= PMf_MULTILINE;
+ else if (ch == 's')
+ *pmfl |= PMf_SINGLELINE;
+ else if (ch == 'x')
+ *pmfl |= PMf_EXTENDED;
+}
+
+static char *
+scan_pat(start)
+char *start;
+{
+ PMOP *pm;
+ char *s;
+
+ s = scan_str(start);
+ if (!s) {
+ if (lex_stuff)
+ SvREFCNT_dec(lex_stuff);
+ lex_stuff = Nullsv;
+ croak("Search pattern not terminated");
}
- *d = '\0';
- retstr->str_cur = d - t;
- return retstr;
+ pm = (PMOP*)newPMOP(OP_MATCH, 0);
+ if (multi_open == '?')
+ pm->op_pmflags |= PMf_ONCE;
+
+ while (*s && strchr("iogmsx", *s))
+ pmflag(&pm->op_pmflags,*s++);
+
+ pm->op_pmpermflags = pm->op_pmflags;
+ lex_op = (OP*)pm;
+ yylval.ival = OP_MATCH;
+ return s;
}
-char *
-scanpat(s)
-register char *s;
+static char *
+scan_subst(start)
+char *start;
{
- register SPAT *spat;
- register char *d;
- register char *e;
- int len;
- SPAT savespat;
+ register char *s;
+ register PMOP *pm;
+ I32 es = 0;
- Newz(801,spat,1,SPAT);
- spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
- curstash->tbl_spatroot = spat;
+ yylval.ival = OP_NULL;
- switch (*s++) {
- case 'm':
- s++;
- break;
- case '/':
- break;
- case '?':
- spat->spat_flags |= SPAT_ONCE;
- break;
- default:
- fatal("panic: scanpat");
+ s = scan_str(start);
+
+ if (!s) {
+ if (lex_stuff)
+ SvREFCNT_dec(lex_stuff);
+ lex_stuff = Nullsv;
+ croak("Substitution pattern not terminated");
}
- s = cpytill(tokenbuf,s,bufend,s[-1],&len);
- if (s >= bufend) {
- yyerror("Search pattern not terminated");
- yylval.arg = Nullarg;
- return s;
+
+ if (s[-1] == multi_open)
+ s--;
+
+ s = scan_str(s);
+ if (!s) {
+ if (lex_stuff)
+ SvREFCNT_dec(lex_stuff);
+ lex_stuff = Nullsv;
+ if (lex_repl)
+ SvREFCNT_dec(lex_repl);
+ lex_repl = Nullsv;
+ croak("Substitution replacement not terminated");
}
- s++;
- while (*s == 'i' || *s == 'o') {
- if (*s == 'i') {
+
+ pm = (PMOP*)newPMOP(OP_SUBST, 0);
+ while (*s && strchr("iogmsex", *s)) {
+ if (*s == 'e') {
s++;
- sawi = TRUE;
- spat->spat_flags |= SPAT_FOLD;
+ es++;
}
- if (*s == 'o') {
- s++;
- spat->spat_flags |= SPAT_KEEP;
- }
- }
- e = tokenbuf + len;
- for (d=tokenbuf; d < e; d++) {
- if ((*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') ||
- (*d == '@' && d[-1] != '\\')) {
- 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_make(tokenbuf,len);
- arg[1].arg_ptr.arg_str->str_u.str_hash = curstash;
- d = scanreg(d,bufend,buf);
- (void)stabent(buf,TRUE); /* make sure it's created */
- for (; d < e; d++) {
- if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
- d = scanreg(d,bufend,buf);
- (void)stabent(buf,TRUE);
- }
- else if (*d == '@' && d[-1] != '\\') {
- d = scanreg(d,bufend,buf);
- if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
- strEQ(buf,"SIG") || strEQ(buf,"INC"))
- (void)stabent(buf,TRUE);
- }
+ else
+ pmflag(&pm->op_pmflags,*s++);
+ }
+
+ if (es) {
+ SV *repl;
+ pm->op_pmflags |= PMf_EVAL;
+ repl = newSVpv("",0);
+ while (es-- > 0)
+ sv_catpv(repl, es ? "eval " : "do ");
+ sv_catpvn(repl, "{ ", 2);
+ sv_catsv(repl, lex_repl);
+ sv_catpvn(repl, " };", 2);
+ SvCOMPILED_on(repl);
+ SvREFCNT_dec(lex_repl);
+ lex_repl = repl;
+ }
+
+ pm->op_pmpermflags = pm->op_pmflags;
+ lex_op = (OP*)pm;
+ yylval.ival = OP_SUBST;
+ return s;
+}
+
+void
+hoistmust(pm)
+register PMOP *pm;
+{
+ if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
+ (!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH)
+ ) {
+ if (!(pm->op_pmregexp->reganch & ROPT_ANCH))
+ pm->op_pmflags |= PMf_SCANFIRST;
+ else if (pm->op_pmflags & PMf_FOLD)
+ return;
+ pm->op_pmshort = SvREFCNT_inc(pm->op_pmregexp->regstart);
+ pm->op_pmslen = SvCUR(pm->op_pmshort);
+ }
+ else if (pm->op_pmregexp->regmust) {/* is there a better short-circuit? */
+ if (pm->op_pmshort &&
+ sv_eq(pm->op_pmshort,pm->op_pmregexp->regmust))
+ {
+ if (pm->op_pmflags & PMf_SCANFIRST) {
+ SvREFCNT_dec(pm->op_pmshort);
+ pm->op_pmshort = Nullsv;
+ }
+ else {
+ SvREFCNT_dec(pm->op_pmregexp->regmust);
+ pm->op_pmregexp->regmust = Nullsv;
+ return;
}
- goto got_pat; /* skip compiling for now */
}
- }
- if (spat->spat_flags & SPAT_FOLD)
-#ifdef STRUCTCOPY
- savespat = *spat;
-#else
- (void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT));
-#endif
- if (*tokenbuf == '^') {
- spat->spat_short = scanconst(tokenbuf+1,len-1);
- if (spat->spat_short) {
- spat->spat_slen = spat->spat_short->str_cur;
- if (spat->spat_slen == len - 1)
- spat->spat_flags |= SPAT_ALL;
+ if (!pm->op_pmshort || /* promote the better string */
+ ((pm->op_pmflags & PMf_SCANFIRST) &&
+ (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)) )){
+ SvREFCNT_dec(pm->op_pmshort); /* ok if null */
+ pm->op_pmshort = pm->op_pmregexp->regmust;
+ pm->op_pmslen = SvCUR(pm->op_pmshort);
+ pm->op_pmregexp->regmust = Nullsv;
+ pm->op_pmflags |= PMf_SCANFIRST;
}
}
- else {
- spat->spat_flags |= SPAT_SCANFIRST;
- spat->spat_short = scanconst(tokenbuf,len);
- if (spat->spat_short) {
- spat->spat_slen = spat->spat_short->str_cur;
- if (spat->spat_slen == len)
- spat->spat_flags |= SPAT_ALL;
- }
- }
- if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
- fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
- spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len,
- spat->spat_flags & SPAT_FOLD,1);
- /* Note that this regexp can still be used if someone says
- * something like /a/ && s//b/; so we can't delete it.
- */
+}
+
+static char *
+scan_trans(start)
+char *start;
+{
+ register char* s;
+ OP *op;
+ short *tbl;
+ I32 squash;
+ I32 delete;
+ I32 complement;
+
+ yylval.ival = OP_NULL;
+
+ s = scan_str(start);
+ if (!s) {
+ if (lex_stuff)
+ SvREFCNT_dec(lex_stuff);
+ lex_stuff = Nullsv;
+ croak("Translation pattern not terminated");
+ }
+ if (s[-1] == multi_open)
+ s--;
+
+ s = scan_str(s);
+ if (!s) {
+ if (lex_stuff)
+ SvREFCNT_dec(lex_stuff);
+ lex_stuff = Nullsv;
+ if (lex_repl)
+ SvREFCNT_dec(lex_repl);
+ lex_repl = Nullsv;
+ croak("Translation replacement not terminated");
+ }
+
+ New(803,tbl,256,short);
+ op = newPVOP(OP_TRANS, 0, (char*)tbl);
+
+ complement = delete = squash = 0;
+ while (*s == 'c' || *s == 'd' || *s == 's') {
+ if (*s == 'c')
+ complement = OPpTRANS_COMPLEMENT;
+ else if (*s == 'd')
+ delete = OPpTRANS_DELETE;
+ else
+ squash = OPpTRANS_SQUASH;
+ s++;
}
- else {
- if (spat->spat_flags & SPAT_FOLD)
-#ifdef STRUCTCOPY
- *spat = savespat;
-#else
- (void)bcopy((char *)&savespat, (char *)spat, sizeof(SPAT));
-#endif
- if (spat->spat_short)
- fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
- spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len,
- spat->spat_flags & SPAT_FOLD,1);
- hoistmust(spat);
- }
- got_pat:
- yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
+ op->op_private = delete|squash|complement;
+
+ lex_op = op;
+ yylval.ival = OP_TRANS;
return s;
}
-char *
-scansubst(s)
+static char *
+scan_heredoc(s)
register char *s;
{
- register SPAT *spat;
+ SV *herewas;
+ I32 op_type = OP_SCALAR;
+ I32 len;
+ SV *tmpstr;
+ char term;
register char *d;
- register char *e;
- int len;
-
- Newz(802,spat,1,SPAT);
- spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
- curstash->tbl_spatroot = spat;
+ char *peek;
- s = cpytill(tokenbuf,s+1,bufend,*s,&len);
- if (s >= bufend) {
- yyerror("Substitution pattern not terminated");
- yylval.arg = Nullarg;
- return s;
- }
- e = tokenbuf + len;
- for (d=tokenbuf; d < e; d++) {
- if ((*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') ||
- (*d == '@' && d[-1] != '\\')) {
- 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_make(tokenbuf,len);
- arg[1].arg_ptr.arg_str->str_u.str_hash = curstash;
- d = scanreg(d,bufend,buf);
- (void)stabent(buf,TRUE); /* make sure it's created */
- for (; *d; d++) {
- if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
- d = scanreg(d,bufend,buf);
- (void)stabent(buf,TRUE);
- }
- else if (*d == '@' && d[-1] != '\\') {
- d = scanreg(d,bufend,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 */
- }
- }
- if (*tokenbuf == '^') {
- spat->spat_short = scanconst(tokenbuf+1,len-1);
- if (spat->spat_short)
- spat->spat_slen = spat->spat_short->str_cur;
+ s += 2;
+ d = tokenbuf;
+ if (!rsfp)
+ *d++ = '\n';
+ for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
+ if (*peek && strchr("`'\"",*peek)) {
+ s = peek;
+ term = *s++;
+ s = cpytill(d,s,bufend,term,&len);
+ if (s < bufend)
+ s++;
+ d += len;
}
else {
- spat->spat_flags |= SPAT_SCANFIRST;
- spat->spat_short = scanconst(tokenbuf,len);
- if (spat->spat_short)
- spat->spat_slen = spat->spat_short->str_cur;
- }
- d = nsavestr(tokenbuf,len);
-get_repl:
- s = scanstr(s);
- if (s >= bufend) {
- yyerror("Substitution replacement not terminated");
- yylval.arg = Nullarg;
- return s;
+ if (*s == '\\')
+ s++, term = '\'';
+ else
+ term = '"';
+ if (!isALNUM(*s))
+ deprecate("bare << to mean <<\"\"");
+ 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 = newSVpv(s,bufend-s);
+ else
+ s--, herewas = newSVpv(s,d-s);
+ s += SvCUR(herewas);
+
+ tmpstr = NEWSV(87,80);
+ sv_upgrade(tmpstr, SVt_PVIV);
+ if (term == '\'') {
+ op_type = OP_CONST;
+ SvIVX(tmpstr) = -1;
+ }
+ else if (term == '`') {
+ op_type = OP_BACKTICK;
+ SvIVX(tmpstr) = '\\';
}
- spat->spat_repl = yylval.arg;
- spat->spat_flags |= SPAT_ONCE;
- 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;
+ CLINE;
+ multi_start = curcop->cop_line;
+ multi_open = multi_close = '<';
+ term = *tokenbuf;
+ if (!rsfp) {
+ d = s;
+ while (s < bufend &&
+ (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
+ if (*s++ == '\n')
+ curcop->cop_line++;
+ }
+ if (s >= bufend) {
+ curcop->cop_line = multi_start;
+ missingterm(tokenbuf);
}
+ sv_setpvn(tmpstr,d+1,s-d);
+ s += len - 1;
+ sv_catpvn(herewas,s,bufend-s);
+ sv_setsv(linestr,herewas);
+ oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr);
+ bufend = SvPVX(linestr) + SvCUR(linestr);
}
- while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
- if (*s == 'e') {
- s++;
- if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
- spat->spat_repl[1].arg_type = A_SINGLE;
- spat->spat_repl = fixeval(make_op(O_EVAL,2,
- spat->spat_repl,
- Nullarg,
- Nullarg));
- spat->spat_flags &= ~SPAT_CONST;
- }
- if (*s == 'g') {
- s++;
- spat->spat_flags &= ~SPAT_ONCE;
+ else
+ sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */
+ while (s >= bufend) { /* multiple line string? */
+ if (!rsfp ||
+ !(oldoldbufptr = oldbufptr = s = filter_gets(linestr, rsfp))) {
+ curcop->cop_line = multi_start;
+ missingterm(tokenbuf);
}
- 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;
- }
+ curcop->cop_line++;
+ if (perldb && curstash != debstash) {
+ SV *sv = NEWSV(88,0);
+
+ sv_upgrade(sv, SVt_PVMG);
+ sv_setsv(sv,linestr);
+ av_store(GvAV(curcop->cop_filegv),
+ (I32)curcop->cop_line,sv);
}
- if (*s == 'o') {
- s++;
- spat->spat_flags |= SPAT_KEEP;
+ bufend = SvPVX(linestr) + SvCUR(linestr);
+ if (*s == term && bcmp(s,tokenbuf,len) == 0) {
+ s = bufend - 1;
+ *s = ' ';
+ sv_catsv(linestr,herewas);
+ bufend = SvPVX(linestr) + SvCUR(linestr);
+ }
+ else {
+ s = bufend;
+ sv_catsv(tmpstr,linestr);
}
}
- 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(d,d+len,spat->spat_flags & SPAT_FOLD,1);
- hoistmust(spat);
- Safefree(d);
+ multi_end = curcop->cop_line;
+ s++;
+ if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
+ SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
+ Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
}
- yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
+ SvREFCNT_dec(herewas);
+ lex_stuff = tmpstr;
+ yylval.ival = op_type;
return s;
}
-hoistmust(spat)
-register SPAT *spat;
+static char *
+scan_inputsymbol(start)
+char *start;
{
- 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;
+ register char *s = start;
+ register char *d;
+ I32 len;
+
+ d = tokenbuf;
+ s = cpytill(d, s+1, bufend, '>', &len);
+ if (s < bufend)
+ s++;
+ else
+ croak("Unterminated <> operator");
+
+ if (*d == '$' && d[1]) d++;
+ while (*d && (isALNUM(*d) || *d == '\'' || *d == ':'))
+ d++;
+ if (d - tokenbuf != len) {
+ yylval.ival = OP_GLOB;
+ set_csh();
+ s = scan_str(start);
+ if (!s)
+ croak("Glob not terminated");
+ return s;
+ }
+ else {
+ d = tokenbuf;
+ if (!len)
+ (void)strcpy(d,"ARGV");
+ if (*d == '$') {
+ I32 tmp;
+ if (tmp = pad_findmy(d)) {
+ OP *op = newOP(OP_PADSV, 0);
+ op->op_targ = tmp;
+ lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, op));
}
else {
- str_free(spat->spat_regexp->regmust);
- spat->spat_regexp->regmust = Nullstr;
- return;
+ GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
+ lex_op = (OP*)newUNOP(OP_READLINE, 0,
+ newUNOP(OP_RV2GV, 0,
+ newUNOP(OP_RV2SV, 0,
+ newGVOP(OP_GV, 0, gv))));
}
+ yylval.ival = OP_NULL;
}
- 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;
+ else {
+ GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO);
+ lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
+ yylval.ival = OP_NULL;
}
}
+ return s;
}
-char *
-expand_charset(s,len,retlen)
-register char *s;
-int len;
-int *retlen;
+static char *
+scan_str(start)
+char *start;
{
- char t[512];
- register char *d = t;
- register int i;
- register char *send = s + len;
+ SV *sv;
+ char *tmps;
+ register char *s = start;
+ register char term;
+ register char *to;
+ I32 brackets = 1;
- while (s < send) {
- if (s[1] == '-' && s+2 < send) {
- for (i = s[0]; i <= s[2]; i++)
- *d++ = i;
- s += 3;
+ if (isSPACE(*s))
+ s = skipspace(s);
+ CLINE;
+ term = *s;
+ multi_start = curcop->cop_line;
+ multi_open = term;
+ if (term && (tmps = strchr("([{< )]}> )]}>",term)))
+ term = tmps[5];
+ multi_close = term;
+
+ sv = NEWSV(87,80);
+ sv_upgrade(sv, SVt_PVIV);
+ SvIVX(sv) = term;
+ (void)SvPOK_only(sv); /* validate pointer */
+ s++;
+ for (;;) {
+ SvGROW(sv, SvCUR(sv) + (bufend - s) + 1);
+ to = SvPVX(sv)+SvCUR(sv);
+ if (multi_open == multi_close) {
+ for (; s < bufend; s++,to++) {
+ if (*s == '\n' && !rsfp)
+ curcop->cop_line++;
+ if (*s == '\\' && s+1 < bufend && term != '\\') {
+ if (s[1] == term)
+ s++;
+ else
+ *to++ = *s++;
+ }
+ else if (*s == term)
+ break;
+ *to = *s;
+ }
}
- else
- *d++ = *s++;
- }
- *d = '\0';
- *retlen = d - t;
- return nsavestr(t,d-t);
-}
+ else {
+ for (; s < bufend; s++,to++) {
+ if (*s == '\n' && !rsfp)
+ curcop->cop_line++;
+ if (*s == '\\' && s+1 < bufend && term != '\\') {
+ if (s[1] == term)
+ s++;
+ else
+ *to++ = *s++;
+ }
+ else if (*s == term && --brackets <= 0)
+ break;
+ else if (*s == multi_open)
+ brackets++;
+ *to = *s;
+ }
+ }
+ *to = '\0';
+ SvCUR_set(sv, to - SvPVX(sv));
-char *
-scantrans(s)
-register char *s;
-{
- ARG *arg =
- l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
- register char *t;
- register char *r;
- register char *tbl;
- register int i;
- register int j;
- int tlen, rlen;
-
- Newz(803,tbl,256,char);
- arg[2].arg_type = A_NULL;
- arg[2].arg_ptr.arg_cval = tbl;
- s = scanstr(s);
- if (s >= bufend) {
- yyerror("Translation pattern not terminated");
- yylval.arg = Nullarg;
- return s;
+ if (s < bufend) break; /* string ends on this line? */
+
+ if (!rsfp ||
+ !(oldoldbufptr = oldbufptr = s = filter_gets(linestr, rsfp))) {
+ sv_free(sv);
+ curcop->cop_line = multi_start;
+ return Nullch;
+ }
+ curcop->cop_line++;
+ if (perldb && curstash != debstash) {
+ SV *sv = NEWSV(88,0);
+
+ sv_upgrade(sv, SVt_PVMG);
+ sv_setsv(sv,linestr);
+ av_store(GvAV(curcop->cop_filegv),
+ (I32)curcop->cop_line, sv);
+ }
+ bufend = SvPVX(linestr) + SvCUR(linestr);
}
- t = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
- yylval.arg[1].arg_ptr.arg_str->str_cur,&tlen);
- free_arg(yylval.arg);
- s = scanstr(s-1);
- if (s >= bufend) {
- yyerror("Translation replacement not terminated");
- yylval.arg = Nullarg;
- return s;
+ multi_end = curcop->cop_line;
+ s++;
+ if (SvCUR(sv) + 5 < SvLEN(sv)) {
+ SvLEN_set(sv, SvCUR(sv) + 1);
+ Renew(SvPVX(sv), SvLEN(sv), char);
}
- r = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
- yylval.arg[1].arg_ptr.arg_str->str_cur,&rlen);
- free_arg(yylval.arg);
- yylval.arg = arg;
- if (!*r) {
- Safefree(r);
- r = t; rlen = tlen;
- }
- for (i = 0, j = 0; i < tlen; i++,j++) {
- if (j >= rlen)
- --j;
- tbl[t[i] & 0377] = r[j];
- }
- if (r != t)
- Safefree(r);
- Safefree(t);
+ if (lex_stuff)
+ lex_repl = sv;
+ else
+ lex_stuff = sv;
return s;
}
char *
-scanstr(s)
-register char *s;
+scan_num(start)
+char *start;
{
- register char term;
+ register char *s = start;
register char *d;
- register ARG *arg;
- register char *send;
- register bool makesingle = FALSE;
- register STAB *stab;
- bool alwaysdollar = FALSE;
- bool hereis = FALSE;
- STR *herewas;
- char *leave = "\\$@nrtfb0123456789[{]}"; /* which backslash sequences to keep */
- int len;
-
- arg = op_new(1);
- yylval.arg = arg;
- arg->arg_type = O_ITEM;
+ I32 tryi32;
+ double value;
+ SV *sv;
+ I32 floatit;
+ char *lastub = 0;
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;
+ default:
+ croak("panic: scan_num");
case '0':
{
- long i;
- int shift;
+ U32 i;
+ I32 shift;
- arg[1].arg_type = A_SINGLE;
if (s[1] == 'x') {
shift = 4;
s += 2;
switch (*s) {
default:
goto out;
+ case '_':
+ s++;
+ break;
case '8': case '9':
if (shift != 4)
yyerror("Illegal octal digit");
}
}
out:
- (void)sprintf(tokenbuf,"%ld",i);
- arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
-#ifdef MICROPORT /* Microport 2.4 hack */
- { double zz = str_2num(arg[1].arg_ptr.arg_str); }
-#else
- (void)str_2num(arg[1].arg_ptr.arg_str);
-#endif /* Microport 2.4 hack */
+ sv = NEWSV(92,0);
+ tryi32 = i;
+ if (tryi32 == i && tryi32 >= 0)
+ sv_setiv(sv,tryi32);
+ else
+ sv_setnv(sv,(double)i);
}
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++;
+ floatit = FALSE;
+ while (isDIGIT(*s) || *s == '_') {
+ if (*s == '_') {
+ if (dowarn && lastub && s - lastub != 3)
+ warn("Misplaced _ in number");
+ lastub = ++s;
+ }
else
*d++ = *s++;
}
- if (*s == '.' && s[1] && index("0123456789eE ;",s[1])) {
+ if (dowarn && lastub && s - lastub != 3)
+ warn("Misplaced _ in number");
+ if (*s == '.' && s[1] != '.') {
+ floatit = TRUE;
*d++ = *s++;
- while (isdigit(*s) || *s == '_') {
+ while (isDIGIT(*s) || *s == '_') {
if (*s == '_')
s++;
else
*d++ = *s++;
}
}
- if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
- *d++ = *s++;
+ if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
+ floatit = TRUE;
+ s++;
+ *d++ = 'e'; /* At least some Mach atof()s don't grok 'E' */
if (*s == '+' || *s == '-')
*d++ = *s++;
- while (isdigit(*s))
+ while (isDIGIT(*s))
*d++ = *s++;
}
*d = '\0';
- arg[1].arg_ptr.arg_str = str_make(tokenbuf, d - tokenbuf);
-#ifdef MICROPORT /* Microport 2.4 hack */
- { double zz = str_2num(arg[1].arg_ptr.arg_str); }
-#else
- (void)str_2num(arg[1].arg_ptr.arg_str);
-#endif /* Microport 2.4 hack */
- break;
- case '<':
- 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 (isascii(*s) && (isalpha(*s) || isdigit(*s) || *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++;
- if (*d == '$') d++;
- while (*d &&
- (isalpha(*d) || isdigit(*d) || *d == '_' || *d == '\''))
- d++;
- if (d - tokenbuf != len) {
- d = tokenbuf;
- arg[1].arg_type = A_GLOB;
- d = nsavestr(d,len);
- arg[1].arg_ptr.arg_stab = stab = genstab();
- stab_io(stab) = stio_new();
- stab_val(stab) = str_make(d,len);
- stab_val(stab)->str_u.str_hash = curstash;
- Safefree(d);
- set_csh();
- }
- 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;
- if (rsfp == stdin && (strEQ(d,"stdin") || strEQ(d,"STDIN")))
- yyerror("Can't get both program and data from <STDIN>");
- 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;
- }
- }
- }
+ sv = NEWSV(92,0);
+ value = atof(tokenbuf);
+ tryi32 = I_32(value);
+ if (!floatit && (double)tryi32 == value)
+ sv_setiv(sv,tryi32);
+ else
+ sv_setnv(sv,value);
break;
+ }
- case 'q':
- s++;
- if (*s == 'q') {
- s++;
- goto do_double;
- }
- /* 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;
- char *tmps;
-
- multi_start = line;
- if (hereis)
- multi_open = multi_close = '<';
- else {
- multi_open = term;
- if (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')
- line++;
- }
- if (s >= bufend) {
- 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
- 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))) {
- line = multi_start;
- fatal("EOF in string");
- }
- line++;
- if (perldb) {
- STR *str = Str_new(88,0);
-
- str_sset(str,linestr);
- astore(lineary,(int)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 = 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_MASK) == 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 = '$'; /* 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) {
- s++;
- }
- s++;
- }
- s = d = tmpstr->str_ptr; /* assuming shrinkage only */
- while (s < send) {
- if ((*s == '$' && s+1 < send &&
- (alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) ||
- (*s == '@' && s+1 < send) ) {
- len = scanreg(s,send,tokenbuf) - s;
- if (*s == '$' || strEQ(tokenbuf,"ARGV")
- || strEQ(tokenbuf,"ENV")
- || strEQ(tokenbuf,"SIG")
- || strEQ(tokenbuf,"INC") )
- (void)stabent(tokenbuf,TRUE); /* make sure it exists */
- while (len--)
- *d++ = *s++;
- continue;
- }
- else if (*s == '\\' && s+1 < send) {
- s++;
- switch (*s) {
- 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 = *s++ - '0';
- if (s < send && *s && index("01234567",*s)) {
- *d <<= 3;
- *d += *s++ - '0';
- }
- if (s < send && *s && index("01234567",*s)) {
- *d <<= 3;
- *d += *s++ - '0';
- }
- d++;
- 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;
- }
- s++;
- continue;
- }
- *d++ = *s++;
- }
- *d = '\0';
-
- if ((arg[1].arg_type & A_MASK) == A_DOUBLE && makesingle)
- arg[1].arg_type = A_SINGLE; /* now we can optimize on it */
-
- tmpstr->str_u.str_hash = curstash; /* so interp knows package */
+ yylval.opval = newSVOP(OP_CONST, 0, sv);
- tmpstr->str_cur = d - tmpstr->str_ptr;
- arg[1].arg_ptr.arg_str = tmpstr;
- s = tmps;
- break;
- }
- }
- if (hereis)
- str_free(herewas);
return s;
}
-FCMD *
-load_format()
+static char *
+scan_formline(s)
+register char *s;
{
- FCMD froot;
- FCMD *flinebeg;
- char *eol;
- register FCMD *fprev = &froot;
- register FCMD *fcmd;
- register char *s;
+ register char *eol;
register char *t;
- register STR *str;
- bool noblank;
- bool repeater;
-
- Zero(&froot, 1, FCMD);
- s = bufptr;
- while (s < bufend || (s = str_gets(linestr,rsfp, 0)) != Nullch) {
- line++;
- if (perldb) {
- STR *tmpstr = Str_new(89,0);
+ SV *stuff = newSVpv("",0);
+ bool needargs = FALSE;
- str_sset(tmpstr,linestr);
- astore(lineary,(int)line,tmpstr);
+ while (!needargs) {
+ if (*s == '.' || *s == '}') {
+ /*SUPPRESS 530*/
+ for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
+ if (*t == '\n')
+ break;
}
if (in_eval && !rsfp) {
- eol = index(s,'\n');
+ eol = strchr(s,'\n');
if (!eol++)
eol = bufend;
}
else
- eol = bufend = linestr->str_ptr + linestr->str_cur;
- if (strnEQ(s,".\n",2)) {
- 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] = ' ';
- }
+ eol = bufend = SvPVX(linestr) + SvCUR(linestr);
+ if (*s != '#') {
+ for (t = s; t < eol; t++) {
+ if (*t == '~' && t[1] == '~' && SvCUR(stuff)) {
+ needargs = FALSE;
+ goto enough; /* ~~ must be first line in formline */
}
+ if (*t == '@' || *t == '^')
+ needargs = TRUE;
}
- 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;
- default:
- fcmd->f_type = F_LEFT;
+ sv_catpvn(stuff, s, eol-s);
+ }
+ s = eol;
+ if (rsfp) {
+ s = filter_gets(linestr, rsfp);
+ oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr);
+ bufend = bufptr + SvCUR(linestr);
+ if (!s) {
+ s = bufptr;
+ yyerror("Format not terminated");
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 && (s = str_gets(linestr, rsfp, 0)) == Nullch)
- goto badform;
- line++;
- if (perldb) {
- STR *tmpstr = Str_new(90,0);
-
- str_sset(tmpstr,linestr);
- astore(lineary,(int)line,tmpstr);
- }
- if (in_eval && !rsfp) {
- eol = index(s,'\n');
- if (!eol++)
- eol = bufend;
- }
- else
- eol = bufend = linestr->str_ptr + linestr->str_cur;
- 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 = 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 = scanreg(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);
- }
+ incline(s);
+ }
+ enough:
+ if (SvCUR(stuff)) {
+ expect = XTERM;
+ if (needargs) {
+ lex_state = LEX_NORMAL;
+ nextval[nexttoke].ival = 0;
+ force_next(',');
}
+ else
+ lex_state = LEX_FORMLINE;
+ nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
+ force_next(THING);
+ nextval[nexttoke].ival = OP_FORMLINE;
+ force_next(LSTOP);
+ }
+ else {
+ SvREFCNT_dec(stuff);
+ lex_formbrack = 0;
+ bufptr = s;
}
- badform:
- bufptr = str_get(linestr);
- yyerror("Format not terminated");
- return froot.f_next;
+ return s;
}
+static void
set_csh()
{
#ifdef CSH
cshlen = strlen(cshname);
#endif
}
+
+int
+start_subparse()
+{
+ int oldsavestack_ix = savestack_ix;
+ CV* outsidecv = compcv;
+ AV* comppadlist;
+
+ if (compcv) {
+ assert(SvTYPE(compcv) == SVt_PVCV);
+ }
+ save_I32(&subline);
+ save_item(subname);
+ SAVEINT(padix);
+ SAVESPTR(curpad);
+ SAVESPTR(comppad);
+ SAVESPTR(comppad_name);
+ SAVESPTR(compcv);
+ SAVEINT(comppad_name_fill);
+ SAVEINT(min_intro_pending);
+ SAVEINT(max_intro_pending);
+ SAVEINT(pad_reset_pending);
+
+ compcv = (CV*)NEWSV(1104,0);
+ sv_upgrade((SV *)compcv, SVt_PVCV);
+
+ comppad = newAV();
+ comppad_name = newAV();
+ comppad_name_fill = 0;
+ min_intro_pending = 0;
+ av_push(comppad, Nullsv);
+ curpad = AvARRAY(comppad);
+ padix = 0;
+ subline = curcop->cop_line;
+
+ comppadlist = newAV();
+ AvREAL_off(comppadlist);
+ av_store(comppadlist, 0, (SV*)comppad_name);
+ av_store(comppadlist, 1, (SV*)comppad);
+
+ CvPADLIST(compcv) = comppadlist;
+ CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv);
+
+ return oldsavestack_ix;
+}
+
+int
+yywarn(s)
+char *s;
+{
+ --error_count;
+ in_eval |= 2;
+ yyerror(s);
+ in_eval &= ~2;
+ return 0;
+}
+
+int
+yyerror(s)
+char *s;
+{
+ char tmpbuf[258];
+ char *tname = tmpbuf;
+
+ if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
+ oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
+ while (isSPACE(*oldoldbufptr))
+ oldoldbufptr++;
+ sprintf(tname,"near \"%.*s\"",bufptr - oldoldbufptr, oldoldbufptr);
+ }
+ else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
+ oldbufptr != bufptr) {
+ while (isSPACE(*oldbufptr))
+ oldbufptr++;
+ sprintf(tname,"near \"%.*s\"",bufptr - oldbufptr, oldbufptr);
+ }
+ else if (yychar > 255)
+ tname = "next token ???";
+ else if (!yychar || (yychar == ';' && !rsfp))
+ (void)strcpy(tname,"at EOF");
+ else if ((yychar & 127) == 127) {
+ if (lex_state == LEX_NORMAL ||
+ (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL))
+ (void)strcpy(tname,"at end of line");
+ else if (lex_inpat)
+ (void)strcpy(tname,"within pattern");
+ else
+ (void)strcpy(tname,"within string");
+ }
+ else if (yychar < 32)
+ (void)sprintf(tname,"next char ^%c",yychar+64);
+ else
+ (void)sprintf(tname,"next char %c",yychar);
+ (void)sprintf(buf, "%s at %s line %d, %s\n",
+ s,SvPVX(GvSV(curcop->cop_filegv)),curcop->cop_line,tname);
+ if (curcop->cop_line == multi_end && multi_start < multi_end) {
+ sprintf(buf+strlen(buf),
+ " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
+ multi_open,multi_close,(long)multi_start);
+ multi_end = 0;
+ }
+ if (in_eval & 2)
+ warn("%s",buf);
+ else if (in_eval)
+ sv_catpv(GvSV(errgv),buf);
+ else
+ fputs(buf,stderr);
+ if (++error_count >= 10)
+ croak("%s has too many errors.\n",
+ SvPVX(GvSV(curcop->cop_filegv)));
+ in_my = 0;
+ return 0;
+}
https://perl5.git.perl.org / perl5.git / blobdiff