+ 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 || minus_p ) && !(oldn || oldp) )
+ /* if we have already added "LINE: while (<>) {",
+ we must not do it again */
+ {
+ 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++;
+ if (expect == XOPERATOR)
+ TERM(POSTINC);
+ else
+ OPERATOR(PREINC);
+ }
+ if (expect == XOPERATOR)
+ Aop(OP_ADD);
+ else {
+ if (isSPACE(*s) || !isSPACE(*bufptr))
+ check_uni();
+ OPERATOR('+');
+ }
+
+ 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') )
+ {
+ if (in_eval && !rsfp) {
+ d = bufend;
+ while (s < d) {
+ if (*s++ == '\n') {
+ incline(s);
+ if (strnEQ(s,"=cut",4)) {
+ s = strchr(s,'\n');
+ if (s)
+ s++;
+ else
+ s = d;
+ incline(s);
+ goto retry;
+ }
+ }
+ }
+ goto retry;
+ }
+ 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)) &&
+ GvIMPORTED_CV(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);
+ if (*s == '(') {
+ nextval[nexttoke].opval = yylval.opval;
+ 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;
+ /* Resolve to GV now. */
+ op_free(yylval.opval);
+ yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+ /* 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);
+ }
+ }
+ nextval[nexttoke].opval = yylval.opval;
+ 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 (rsfp && (!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);
+ GvMULTI_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:
+ case KEY_RESTART:
+ 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;
+ s = skipspace(s);
+ if (isIDFIRST(*s)) {
+ s = scan_word(s, tokenbuf, TRUE, &len);
+ in_my_stash = gv_stashpv(tokenbuf, FALSE);
+ if (!in_my_stash) {
+ char tmpbuf[1024];
+ bufptr = s;
+ sprintf(tmpbuf, "No such class %.1000s", tokenbuf);
+ yyerror(tmpbuf);
+ }
+ }
+ 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 KEY_send:
+ LOP(OP_SEND,XTERM);
+
+ case KEY_setpgrp:
+ LOP(OP_SETPGRP,XTERM);
+
+ case KEY_setpriority:
+ LOP(OP_SETPRIORITY,XTERM);
+
+ case KEY_sethostent:
+ FUN1(OP_SHOSTENT);
+
+ case KEY_setnetent:
+ FUN1(OP_SNETENT);
+
+ 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");
+ }
+ 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);