1 /* $RCSfile: toke.c,v $$Revision: 4.1 $$Date: 92/08/07 18:28:39 $
3 * Copyright (c) 1991, Larry Wall
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
9 * Revision 4.1 92/08/07 18:28:39 lwall
11 * Revision 4.0.1.7 92/06/11 21:16:30 lwall
12 * patch34: expect incorrectly set to indicate start of program or block
14 * Revision 4.0.1.6 92/06/08 16:03:49 lwall
15 * patch20: an EXPR may now start with a bareword
16 * patch20: print $fh EXPR can now expect term rather than operator in EXPR
17 * patch20: added ... as variant on ..
18 * patch20: new warning on spurious backslash
19 * patch20: new warning on missing $ for foreach variable
20 * patch20: "foo"x1024 now legal without space after x
21 * patch20: new warning on print accidentally used as function
22 * patch20: tr/stuff// wasn't working right
23 * patch20: 2. now eats the dot
24 * patch20: <@ARGV> now notices @ARGV
25 * patch20: tr/// now lets you say \-
27 * Revision 4.0.1.5 91/11/11 16:45:51 lwall
28 * patch19: default arg for shift was wrong after first subroutine definition
30 * Revision 4.0.1.4 91/11/05 19:02:48 lwall
31 * patch11: \x and \c were subject to double interpretation in regexps
32 * patch11: prepared for ctype implementations that don't define isascii()
33 * patch11: nested list operators could miscount parens
34 * patch11: once-thru blocks didn't display right in the debugger
35 * patch11: sort eval "whatever" didn't work
36 * patch11: underscore is now allowed within literal octal and hex numbers
38 * Revision 4.0.1.3 91/06/10 01:32:26 lwall
39 * patch10: m'$foo' now treats string as single quoted
40 * patch10: certain pattern optimizations were botched
42 * Revision 4.0.1.2 91/06/07 12:05:56 lwall
43 * patch4: new copyright notice
44 * patch4: debugger lost track of lines in eval
45 * patch4: //o and s///o now optimize themselves fully at runtime
46 * patch4: added global modifier for pattern matches
48 * Revision 4.0.1.1 91/04/12 09:18:18 lwall
49 * patch1: perl -de "print" wouldn't stop at the first statement
51 * Revision 4.0 91/03/20 01:42:14 lwall
60 static void set_csh();
62 /* The following are arranged oddly so that the guard on the switch statement
63 * can get by with a single comparison (if the compiler is smart enough).
67 #define LEX_INTERPNORMAL 7
68 #define LEX_INTERPCASEMOD 6
69 #define LEX_INTERPSTART 5
70 #define LEX_INTERPEND 4
71 #define LEX_INTERPENDMAYBE 3
72 #define LEX_INTERPCONCAT 2
73 #define LEX_INTERPCONST 1
74 #define LEX_KNOWNEXT 0
76 static U32 lex_state = LEX_NORMAL; /* next token is determined */
77 static U32 lex_defer; /* state after determined token */
78 static I32 lex_brackets; /* bracket count */
79 static I32 lex_fakebrack; /* outer bracket is mere delimiter */
80 static I32 lex_casemods; /* casemod count */
81 static I32 lex_dojoin; /* doing an array interpolation */
82 static I32 lex_starts; /* how many interps done on level */
83 static SV * lex_stuff; /* runtime pattern from m// or s/// */
84 static SV * lex_repl; /* runtime replacement from s/// */
85 static OP * lex_op; /* extra info to pass back on op */
86 static I32 lex_inpat; /* in pattern $) and $| are special */
87 static I32 lex_inwhat; /* what kind of quoting are we in */
89 /* What we know when we're in LEX_KNOWNEXT state. */
90 static YYSTYPE nextval[5]; /* value of next token, if any */
91 static I32 nexttype[5]; /* type of next token */
92 static I32 nexttoke = 0;
105 #include "keywords.h"
112 #define CLINE (copline = (curcop->cop_line < copline ? curcop->cop_line : copline))
115 #define PERL_META(c) ((c) | 128)
117 #define META(c) ((c) | 128)
120 #define TOKEN(retval) return (bufptr = s,(int)retval)
121 #define OPERATOR(retval) return (expect = XTERM,bufptr = s,(int)retval)
122 #define PREBLOCK(retval) return (expect = XBLOCK,bufptr = s,(int)retval)
123 #define PREREF(retval) return (expect = XREF,bufptr = s,(int)retval)
124 #define TERM(retval) return (CLINE, expect = XOPERATOR,bufptr = s,(int)retval)
125 #define LOOPX(f) return(yylval.ival=f,expect = XOPERATOR,bufptr = s,(int)LOOPEX)
126 #define FTST(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)UNIOP)
127 #define FUN0(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC0)
128 #define FUN1(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC1)
129 #define BOop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)BITOROP)
130 #define BAop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)BITANDOP)
131 #define SHop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)SHIFTOP)
132 #define PWop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)POWOP)
133 #define PMop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)MATCHOP)
134 #define Aop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)ADDOP)
135 #define Mop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)MULOP)
136 #define Eop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)EQOP)
137 #define Rop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)RELOP)
139 /* This bit of chicanery makes a unary function followed by
140 * a parenthesis into a function with one argument, highest precedence.
142 #define UNI(f) return(yylval.ival = f, \
145 last_uni = oldbufptr, \
146 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
148 #define UNIBRACK(f) return(yylval.ival = f, \
150 last_uni = oldbufptr, \
151 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
153 /* This does similarly for list operators */
154 #define LOP(f) return(yylval.ival = f, \
158 last_lop = oldbufptr, \
159 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC : (int)LSTOP) )
161 /* grandfather return to old style */
162 #define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP)
166 while (s < bufend && isALNUM(*s)) \
173 lex_state = LEX_NORMAL;
188 oldoldbufptr = oldbufptr = bufptr = SvPVn(linestr);
189 bufend = bufptr + SvCUR(linestr);
200 while (s < bufend && isSPACE(*s))
210 if (oldoldbufptr != last_uni)
212 while (isSPACE(*last_uni))
214 for (s = last_uni; isALNUM(*s) || *s == '-'; s++) ;
217 warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
225 #define UNI(f) return uni(f,s)
226 #define LOP(f) return lop(f,s)
236 last_uni = oldbufptr;
255 last_uni = oldbufptr;
265 #endif /* CRIPPLED_CC */
271 nexttype[nexttoke] = type;
273 if (lex_state != LEX_KNOWNEXT) {
274 lex_defer = lex_state;
275 lex_state = LEX_KNOWNEXT;
287 if (isIDFIRST(*s) || *s == '\'') {
290 while (s < bufend && *s == '\'' && isIDFIRST(s[1])) {
294 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
305 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
323 send = s + SvCUR(sv);
324 while (s < send && *s != '\\')
329 delim = SvSTORAGE(sv);
332 if (s + 1 < send && (s[1] == '\\' || s[1] == delim))
333 s++; /* all that, just for this */
338 SvCUR_set(sv, d - SvPV(sv));
346 register I32 op_type = yylval.ival;
349 if (op_type == OP_NULL) {
350 yylval.opval = lex_op;
354 if (op_type == OP_CONST || op_type == OP_READLINE) {
355 yylval.opval = (OP*)newSVOP(op_type, 0, q(lex_stuff));
362 SAVEINT(lex_brackets);
363 SAVEINT(lex_fakebrack);
364 SAVEINT(lex_casemods);
369 SAVEINT(curcop->cop_line);
372 SAVESPTR(oldoldbufptr);
378 bufend = bufptr = oldbufptr = oldoldbufptr = SvPVn(linestr);
379 bufend += SvCUR(linestr);
386 lex_state = LEX_INTERPCONCAT;
387 curcop->cop_line = multi_start;
389 lex_inwhat = op_type;
390 if (op_type == OP_MATCH || op_type == OP_SUBST)
397 yylval.opval = lex_op;
410 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv("",0));
414 if (lex_casemods) { /* oops, we've got some unbalanced parens */
415 lex_state = LEX_INTERPCASEMOD;
420 /* Is there a right-hand side to take care of? */
421 if (lex_repl && (lex_inwhat == OP_SUBST || lex_inwhat == OP_TRANS)) {
424 bufend = bufptr = oldbufptr = oldoldbufptr = SvPVn(linestr);
425 bufend += SvCUR(linestr);
431 if (SvCOMPILED(lex_repl)) {
432 lex_state = LEX_INTERPNORMAL;
436 lex_state = LEX_INTERPCONCAT;
442 bufend = SvPVn(linestr);
443 bufend += SvCUR(linestr);
453 register char *send = bufend;
454 SV *sv = NEWSV(93, send - start);
455 register char *s = start;
456 register char *d = SvPV(sv);
457 char delim = SvSTORAGE(linestr);
458 bool dorange = FALSE;
462 ? "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}"
463 : (lex_inwhat & OP_TRANS)
467 while (s < send || dorange) {
468 if (lex_inwhat == OP_TRANS) {
473 SvGROW(sv, SvLEN(sv) + 256);
477 for (i = (*d & 0377); i <= max; i++)
482 else if (*s == '-' && s+1 < send && s != start) {
489 else if (*s == '$') {
490 if (!lex_inpat) /* not a regexp, so $ must be var */
492 if (s + 1 < send && s[1] != ')' && s[1] != '|')
493 break; /* in regexp, $ might be tail anchor */
495 if (*s == '\\' && s+1 < send) {
501 if (*s && strchr(leave, *s)) {
506 if (lex_inwhat == OP_SUBST && !lex_inpat &&
507 isDIGIT(*s) && !isDIGIT(s[1]))
512 if (lex_inwhat != OP_TRANS && *s && strchr("lLuUE", *s)) {
518 if (lex_inwhat == OP_TRANS) {
526 case '0': case '1': case '2': case '3':
527 case '4': case '5': case '6': case '7':
528 *d++ = scan_oct(s, 3, &len);
532 *d++ = scan_hex(++s, 2, &len);
570 SvCUR_set(sv, d - SvPV(sv));
573 if (SvCUR(sv) + 5 < SvLEN(sv)) {
574 SvLEN_set(sv, SvCUR(sv) + 1);
575 Renew(SvPV(sv), SvLEN(sv), char);
578 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
584 /* This is the one truly awful dwimmer necessary to conflate C and sed. */
591 if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
593 if (*s != '{' && *s != '[')
598 /* In a pattern, so maybe we have {n,m}. */
615 /* On the other hand, maybe we have a character class */
618 if (*s == ']' || *s == '^')
621 int weight = 2; /* let's weigh the evidence */
623 unsigned char un_char = 0, last_un_char;
624 char *send = strchr(s,']');
627 if (!send) /* has to be an expression */
633 else if (isDIGIT(*s)) {
635 if (isDIGIT(s[1]) && s[2] == ']')
641 for (; s < send; s++) {
642 last_un_char = un_char;
643 un_char = (unsigned char)*s;
648 weight -= seen[un_char] * 10;
650 scan_ident(s,send,tmpbuf,FALSE);
651 if (strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE))
656 else if (*s == '$' && s[1] &&
657 strchr("[#!%*<>()-=",s[1])) {
658 if (/*{*/ strchr("])} =",s[2]))
667 if (strchr("wds]",s[1]))
669 else if (seen['\''] || seen['"'])
671 else if (strchr("rnftbxcav",s[1]))
673 else if (isDIGIT(s[1])) {
675 while (s[1] && isDIGIT(s[1]))
685 if (strchr("aA01! ",last_un_char))
687 if (strchr("zZ79~",s[1]))
691 if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
692 isALPHA(*s) && s[1] && isALPHA(s[1])) {
697 if (keyword(tmpbuf, d - tmpbuf))
700 if (un_char == last_un_char + 1)
702 weight -= seen[un_char];
707 if (weight >= 0) /* probably a character class */
720 extern int yychar; /* last token */
724 case LEX_NORMAL: /* Some compilers will produce faster */
725 case LEX_INTERPNORMAL: /* code if we comment these out. */
731 yylval = nextval[nexttoke];
733 lex_state = lex_defer;
734 return(nexttype[nexttoke]);
736 case LEX_INTERPCASEMOD:
738 if (bufptr != bufend && *bufptr != '\\')
739 fatal("panic: INTERPCASEMOD");
741 if (bufptr == bufend || bufptr[1] == 'E') {
742 if (lex_casemods <= 1) {
743 if (bufptr != bufend)
745 lex_state = LEX_INTERPSTART;
755 if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
756 tmp = *s, *s = s[2], s[2] = tmp; /* misordered... */
758 lex_state = LEX_INTERPCONCAT;
759 nextval[nexttoke].ival = 0;
762 nextval[nexttoke].ival = OP_LCFIRST;
764 nextval[nexttoke].ival = OP_UCFIRST;
766 nextval[nexttoke].ival = OP_LC;
768 nextval[nexttoke].ival = OP_UC;
770 fatal("panic: yylex");
781 case LEX_INTERPSTART:
782 if (bufptr == bufend)
783 return sublex_done();
785 lex_dojoin = (*bufptr == '@');
786 lex_state = LEX_INTERPNORMAL;
788 nextval[nexttoke].ival = 0;
791 nextval[nexttoke].ival = 0;
793 nextval[nexttoke].ival = 0;
795 nextval[nexttoke].ival = OP_JOIN; /* emulate join($", ...) */
806 case LEX_INTERPENDMAYBE:
807 if (intuit_more(bufptr)) {
808 lex_state = LEX_INTERPNORMAL; /* false alarm, more expr */
816 lex_state = LEX_INTERPCONCAT;
820 case LEX_INTERPCONCAT:
823 fatal("panic: INTERPCONCAT");
825 if (bufptr == bufend)
826 return sublex_done();
828 if (SvSTORAGE(linestr) == '\'') {
829 SV *sv = newSVsv(linestr);
832 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
836 s = scan_const(bufptr);
838 lex_state = LEX_INTERPCASEMOD;
840 lex_state = LEX_INTERPSTART;
844 nextval[nexttoke] = yylval;
858 oldoldbufptr = oldbufptr;
864 fprintf(stderr,"Tokener at %s",s);
866 fprintf(stderr,"Tokener at %s\n",s);
870 if ((*s & 127) == '}') {
875 warn("Unrecognized character \\%03o ignored", *s++ & 255);
881 if ((*s & 127) == '}') {
886 warn("Unrecognized character \\%03o ignored", *s++ & 255);
890 goto fake_eof; /* emulate EOF on ^D or ^Z */
895 goto retry; /* ignore stray nulls */
900 sv_setpv(linestr,"");
902 char *pdb = getenv("PERLDB");
904 sv_catpv(linestr,"BEGIN{");
905 sv_catpv(linestr, pdb ? pdb : "require 'perldb.pl'");
906 sv_catpv(linestr, "}");
908 if (minus_n || minus_p) {
909 sv_catpv(linestr, "LINE: while (<>) {");
911 sv_catpv(linestr,"chop;");
913 sv_catpv(linestr,"@F=split(' ');");
915 oldoldbufptr = oldbufptr = s = SvPVn(linestr);
916 bufend = SvPV(linestr) + SvCUR(linestr);
921 #endif /* CRYPTSCRIPT */
923 if ((s = sv_gets(linestr, rsfp, 0)) == Nullch) {
927 (void)my_pclose(rsfp);
928 else if ((FILE*)rsfp == stdin)
934 if (minus_n || minus_p) {
935 sv_setpv(linestr,minus_p ? ";}continue{print" : "");
936 sv_catpv(linestr,";}");
937 oldoldbufptr = oldbufptr = s = SvPVn(linestr);
938 bufend = SvPV(linestr) + SvCUR(linestr);
939 minus_n = minus_p = 0;
942 oldoldbufptr = oldbufptr = s = SvPVn(linestr);
943 sv_setpv(linestr,"");
944 TOKEN(';'); /* not infinite loop because rsfp is NULL now */
946 if (doextract && *SvPV(linestr) == '#')
950 oldoldbufptr = oldbufptr = bufptr = s;
952 SV *sv = NEWSV(85,0);
954 sv_upgrade(sv, SVt_PVMG);
955 sv_setsv(sv,linestr);
956 av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
958 bufend = SvPV(linestr) + SvCUR(linestr);
959 if (curcop->cop_line == 1) {
960 while (s < bufend && isSPACE(*s))
962 if (*s == ':') /* for csh's that have to exec sh scripts */
964 if (*s == '#' && s[1] == '!') {
965 if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
973 while (s < bufend && !isSPACE(*s))
976 while (s < bufend && isSPACE(*s))
979 Newz(899,newargv,origargc+3,char*);
981 while (s < bufend && !isSPACE(*s))
984 Copy(origargv+1, newargv+2, origargc+1, char*);
990 fatal("Can't exec %s", cmd);
992 if (d = instr(s, "perl -")) {
995 while (d = moreswitches(d)) ;
999 if (in_format && lex_brackets <= 1) {
1000 s = scan_formline(s);
1006 case ' ': case '\t': case '\f': case '\r': case 013:
1010 if (preprocess && s == SvPVn(linestr) &&
1011 s[1] == ' ' && (isDIGIT(s[2]) || strnEQ(s+2,"line ",5)) ) {
1012 while (*s && !isDIGIT(*s))
1014 curcop->cop_line = atoi(s)-1;
1018 s[strlen(s)-1] = '\0'; /* wipe out newline */
1021 s[strlen(s)-1] = '\0'; /* wipe out trailing quote */
1024 curcop->cop_filegv = gv_fetchfile(s);
1026 curcop->cop_filegv = gv_fetchfile(origfilename);
1027 oldoldbufptr = oldbufptr = s = SvPVn(linestr);
1031 if (lex_state != LEX_NORMAL || (in_eval && !rsfp)) {
1033 while (s < d && *s != '\n')
1038 if (in_format && lex_brackets <= 1) {
1039 s = scan_formline(s);
1051 if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
1053 last_uni = oldbufptr;
1055 case 'r': FTST(OP_FTEREAD);
1056 case 'w': FTST(OP_FTEWRITE);
1057 case 'x': FTST(OP_FTEEXEC);
1058 case 'o': FTST(OP_FTEOWNED);
1059 case 'R': FTST(OP_FTRREAD);
1060 case 'W': FTST(OP_FTRWRITE);
1061 case 'X': FTST(OP_FTREXEC);
1062 case 'O': FTST(OP_FTROWNED);
1063 case 'e': FTST(OP_FTIS);
1064 case 'z': FTST(OP_FTZERO);
1065 case 's': FTST(OP_FTSIZE);
1066 case 'f': FTST(OP_FTFILE);
1067 case 'd': FTST(OP_FTDIR);
1068 case 'l': FTST(OP_FTLINK);
1069 case 'p': FTST(OP_FTPIPE);
1070 case 'S': FTST(OP_FTSOCK);
1071 case 'u': FTST(OP_FTSUID);
1072 case 'g': FTST(OP_FTSGID);
1073 case 'k': FTST(OP_FTSVTX);
1074 case 'b': FTST(OP_FTBLK);
1075 case 'c': FTST(OP_FTCHR);
1076 case 't': FTST(OP_FTTTY);
1077 case 'T': FTST(OP_FTTEXT);
1078 case 'B': FTST(OP_FTBINARY);
1079 case 'M': gv_fetchpv("\024",TRUE); FTST(OP_FTMTIME);
1080 case 'A': gv_fetchpv("\024",TRUE); FTST(OP_FTATIME);
1081 case 'C': gv_fetchpv("\024",TRUE); FTST(OP_FTCTIME);
1090 if (expect == XOPERATOR)
1095 else if (*s == '>') {
1098 if (isIDFIRST(*s)) {
1100 for (d = s; isALNUM(*d); d++) ;
1101 strncpy(tokenbuf,s,d-s);
1102 tokenbuf[d-s] = '\0';
1103 if (!keyword(tokenbuf, d - s))
1104 s = force_word(s,METHOD);
1108 if (expect == XOPERATOR)
1111 if (isSPACE(*s) || !isSPACE(*bufptr))
1113 OPERATOR('-'); /* unary minus */
1120 if (expect == XOPERATOR)
1125 if (expect == XOPERATOR)
1128 if (isSPACE(*s) || !isSPACE(*bufptr))
1134 if (expect != XOPERATOR) {
1135 s = scan_ident(s, bufend, tokenbuf, TRUE);
1136 force_ident(tokenbuf);
1147 if (expect != XOPERATOR) {
1148 s = scan_ident(s, bufend, tokenbuf + 1, TRUE);
1152 if (strchr(tokenbuf,'\''))
1153 fatal("\"my\" variable %s can't be in a package",tokenbuf);
1154 nextval[nexttoke].opval = newOP(OP_PADHV, 0);
1155 nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
1156 force_next(PRIVATEREF);
1159 if (!strchr(tokenbuf,'\'')) {
1160 if (tmp = pad_findmy(tokenbuf)) {
1161 nextval[nexttoke].opval = newOP(OP_PADHV, 0);
1162 nextval[nexttoke].opval->op_targ = tmp;
1163 force_next(PRIVATEREF);
1167 force_ident(tokenbuf + 1);
1189 if (curcop->cop_line < copline)
1190 copline = curcop->cop_line;
1198 if (lex_state == LEX_INTERPNORMAL) {
1199 if (--lex_brackets == 0) {
1200 if (*s != '-' || s[1] != '>')
1201 lex_state = LEX_INTERPEND;
1211 if (expect == XTERM)
1212 OPERATOR(HASHBRACK);
1213 else if (expect == XREF)
1217 yylval.ival = curcop->cop_line;
1218 if (isSPACE(*s) || *s == '#')
1219 copline = NOLINE; /* invalidate current command line number */
1224 if (lex_state == LEX_INTERPNORMAL) {
1225 if (--lex_brackets == 0) {
1226 if (lex_fakebrack) {
1227 lex_state = LEX_INTERPEND;
1229 return yylex(); /* ignore fake brackets */
1231 if (*s != '-' || s[1] != '>')
1232 lex_state = LEX_INTERPEND;
1243 if (expect == XOPERATOR)
1246 s = scan_ident(s-1, bufend, tokenbuf, TRUE);
1248 force_ident(tokenbuf);
1270 if (in_format == 2 && (tmp == '\n' || s[1] == '\n')) {
1287 if (expect != XOPERATOR) {
1288 if (s[1] != '<' && !strchr(s,'>'))
1291 s = scan_heredoc(s);
1293 s = scan_inputsymbol(s);
1294 TERM(sublex_start());
1299 SHop(OP_LEFT_SHIFT);
1313 SHop(OP_RIGHT_SHIFT);
1320 if (in_format && expect == XOPERATOR)
1321 OPERATOR(','); /* grandfather non-comma-format format */
1322 if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) {
1323 s = scan_ident(s+1, bufend, tokenbuf, FALSE);
1324 force_ident(tokenbuf);
1327 s = scan_ident(s, bufend, tokenbuf+1, FALSE);
1330 if (dowarn && *s == '[') {
1332 for (t = s+1; isSPACE(*t) || isALNUM(*t) || *t == '$'; t++) ;
1334 bufptr = skipspace(bufptr);
1335 while (t < bufend && *t != ']') t++;
1336 warn("Multidimensional syntax %.*s not supported",
1337 t-bufptr+1, bufptr);
1341 if (strchr(tokenbuf,'\''))
1342 fatal("\"my\" variable %s can't be in a package",tokenbuf);
1343 nextval[nexttoke].opval = newOP(OP_PADSV, 0);
1344 nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
1345 force_next(PRIVATEREF);
1347 else if (!strchr(tokenbuf,'\'')) {
1348 I32 optype = OP_PADSV;
1353 else if (*s == '{') {
1357 if (tmp = pad_findmy(tokenbuf)) {
1358 nextval[nexttoke].opval = newOP(optype, 0);
1359 nextval[nexttoke].opval->op_targ = tmp;
1360 force_next(PRIVATEREF);
1363 force_ident(tokenbuf+1);
1366 force_ident(tokenbuf+1);
1371 if (lex_state == LEX_NORMAL &&
1375 oldoldbufptr < bufptr)
1378 while (isSPACE(*oldoldbufptr))
1380 if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5)) {
1381 if (strchr("&*<%", *s) && isIDFIRST(s[1]))
1382 expect = XTERM; /* e.g. print $fh &sub */
1383 else if (*s == '.' && isDIGIT(s[1]))
1384 expect = XTERM; /* e.g. print $fh .3 */
1385 else if (strchr("/?-+", *s) && !isSPACE(s[1]))
1386 expect = XTERM; /* e.g. print $fh -1 */
1392 s = scan_ident(s, bufend, tokenbuf+1, FALSE);
1396 if (strchr(tokenbuf,'\''))
1397 fatal("\"my\" variable %s can't be in a package",tokenbuf);
1398 nextval[nexttoke].opval = newOP(OP_PADAV, 0);
1399 nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
1400 force_next(PRIVATEREF);
1403 else if (!strchr(tokenbuf,'\'')) {
1404 I32 optype = OP_PADAV;
1409 if (tmp = pad_findmy(tokenbuf)) {
1410 nextval[nexttoke].opval = newOP(optype, 0);
1411 nextval[nexttoke].opval->op_targ = tmp;
1412 force_next(PRIVATEREF);
1416 if (dowarn && *s == '[') {
1418 for (t = s+1; isSPACE(*t) || isALNUM(*t) || *t == '$'; t++) ;
1420 bufptr = skipspace(bufptr);
1421 warn("Scalar value %.*s better written as $%.*s",
1422 t-bufptr, bufptr, t-bufptr-1, bufptr+1);
1425 force_ident(tokenbuf+1);
1431 case '/': /* may either be division or pattern */
1432 case '?': /* may either be conditional or pattern */
1433 if (expect != XOPERATOR) {
1436 TERM(sublex_start());
1444 if (in_format == 2) {
1448 if (expect == XOPERATOR || !isDIGIT(s[1])) {
1454 yylval.ival = OPf_SPECIAL;
1460 if (expect != XOPERATOR)
1465 case '0': case '1': case '2': case '3': case '4':
1466 case '5': case '6': case '7': case '8': case '9':
1471 if (in_format && expect == XOPERATOR)
1472 OPERATOR(','); /* grandfather non-comma-format format */
1475 fatal("EOF in string");
1476 yylval.ival = OP_CONST;
1477 TERM(sublex_start());
1480 if (in_format && expect == XOPERATOR)
1481 OPERATOR(','); /* grandfather non-comma-format format */
1484 fatal("EOF in string");
1485 yylval.ival = OP_SCALAR;
1486 TERM(sublex_start());
1491 fatal("EOF in backticks");
1492 yylval.ival = OP_BACKTICK;
1494 TERM(sublex_start());
1501 if (isDIGIT(s[1]) && expect == XOPERATOR) {
1539 switch (tmp = keyword(tokenbuf, d - tokenbuf)) {
1541 default: /* not a keyword */
1544 while (*s == '\'' && isIDFIRST(s[1])) {
1548 if (expect == XBLOCK) { /* special case: start of statement */
1549 while (isSPACE(*s)) s++;
1551 yylval.pval = savestr(tokenbuf);
1557 gv = gv_fetchpv(tokenbuf,FALSE);
1558 if (gv && GvCV(gv)) {
1559 nextval[nexttoke].opval =
1560 (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
1561 nextval[nexttoke].opval->op_private = OPpCONST_BARE;
1566 if (oldoldbufptr && oldoldbufptr < bufptr) {
1567 if (oldoldbufptr == last_lop) {
1570 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
1571 newSVpv(tokenbuf,0));
1572 yylval.opval->op_private = OPpCONST_BARE;
1573 for (d = tokenbuf; *d && isLOWER(*d); d++) ;
1576 "\"%s\" may clash with future reserved word",
1581 while (s < bufend && isSPACE(*s))
1585 nextval[nexttoke].opval =
1586 (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
1587 nextval[nexttoke].opval->op_private = OPpCONST_BARE;
1592 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
1593 yylval.opval->op_private = OPpCONST_BARE;
1595 if (*s == '$' || *s == '{')
1598 for (d = tokenbuf; *d && isLOWER(*d); d++) ;
1601 "\"%s\" may clash with future reserved word",
1607 case KEY___FILE__: {
1608 if (tokenbuf[2] == 'L')
1609 (void)sprintf(tokenbuf,"%ld",(long)curcop->cop_line);
1611 strcpy(tokenbuf, SvPV(GvSV(curcop->cop_filegv)));
1612 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
1621 if (!in_eval && (gv = gv_fetchpv("DATA",FALSE))) {
1625 GvIO(gv)->ifp = rsfp;
1626 #if defined(HAS_FCNTL) && defined(FFt_SETFD)
1628 fcntl(fd,FFt_SETFD,fd >= 3);
1631 GvIO(gv)->type = '|';
1632 else if ((FILE*)rsfp == stdin)
1633 GvIO(gv)->type = '-';
1635 GvIO(gv)->type = '<';
1644 if (expect == XBLOCK && (minus_p || minus_n || *s == '{' )) {
1675 (void)gv_fetchpv("ENV",TRUE); /* may use HOME */
1699 if (dowarn && *s != '0' && isDIGIT(*s))
1700 warn("chmod: mode argument is missing initial 0");
1720 s = force_word(s,WORD);
1745 yylval.ival = curcop->cop_line;
1755 allgvs = TRUE; /* must initialize everything since */
1757 expect = (*s == '{') ? XBLOCK : XTERM;
1758 UNIBRACK(OP_ENTEREVAL); /* we don't know what will be used */
1773 case KEY_endhostent:
1779 case KEY_endservent:
1782 case KEY_endprotoent:
1793 yylval.ival = curcop->cop_line;
1794 while (s < bufend && isSPACE(*s))
1797 fatal("Missing $ on loop variable");
1839 case KEY_getpriority:
1840 LOP(OP_GETPRIORITY);
1842 case KEY_getprotobyname:
1845 case KEY_getprotobynumber:
1848 case KEY_getprotoent:
1860 case KEY_getpeername:
1861 UNI(OP_GETPEERNAME);
1863 case KEY_gethostbyname:
1866 case KEY_gethostbyaddr:
1869 case KEY_gethostent:
1872 case KEY_getnetbyname:
1875 case KEY_getnetbyaddr:
1881 case KEY_getservbyname:
1884 case KEY_getservbyport:
1887 case KEY_getservent:
1890 case KEY_getsockname:
1891 UNI(OP_GETSOCKNAME);
1893 case KEY_getsockopt:
1915 yylval.ival = curcop->cop_line;
1975 TERM(sublex_start());
2005 if (isIDFIRST(*s)) {
2007 for (d = s; isALNUM(*d); d++) ;
2009 if (strchr("|&*+-=!?:.", *t))
2010 warn("Precedence problem: open %.*s should be open(%.*s)",
2025 checkcomma(s,tokenbuf,"filehandle");
2029 checkcomma(s,tokenbuf,"filehandle");
2042 s = force_word(s,WORD);
2051 fatal("EOF in string");
2052 yylval.ival = OP_CONST;
2053 TERM(sublex_start());
2058 fatal("EOF in string");
2059 yylval.ival = OP_SCALAR;
2060 if (SvSTORAGE(lex_stuff) == '\'')
2061 SvSTORAGE(lex_stuff) = 0; /* qq'$foo' should intepolate */
2062 TERM(sublex_start());
2067 fatal("EOF in string");
2068 yylval.ival = OP_BACKTICK;
2070 TERM(sublex_start());
2076 allgvs = TRUE; /* must initialize everything since */
2077 UNI(OP_REQUIRE); /* we don't know what will be used */
2129 TERM(sublex_start());
2131 TOKEN(1); /* force error */
2157 case KEY_setpriority:
2158 LOP(OP_SETPRIORITY);
2160 case KEY_sethostent:
2166 case KEY_setservent:
2169 case KEY_setprotoent:
2181 case KEY_setsockopt:
2211 case KEY_socketpair:
2215 checkcomma(s,tokenbuf,"subroutine name");
2217 if (*s == ';' || *s == ')') /* probably a close */
2218 fatal("sort is now a reserved word");
2219 if (isIDFIRST(*s)) {
2221 for (d = s; isALNUM(*d); d++) ;
2222 strncpy(tokenbuf,s,d-s);
2223 tokenbuf[d-s] = '\0';
2224 if (!keyword(tokenbuf, d - s) || strEQ(tokenbuf,"reverse"))
2225 s = force_word(s,WORD);
2257 yylval.ival = savestack_ix; /* restore stuff on reduce */
2263 SAVESPTR(comppadname);
2264 SAVEINT(comppadnamefill);
2266 comppadname = newAV();
2267 comppadnamefill = -1;
2268 av_push(comppad, Nullsv);
2269 curpad = AvARRAY(comppad);
2272 subline = curcop->cop_line;
2274 if (isIDFIRST(*s) || *s == '\'') {
2275 sv_setsv(subname,curstname);
2276 sv_catpvn(subname,"'",1);
2277 for (d = s+1; isALNUM(*d) || *d == '\''; d++)
2282 sv_catpvn(subname,s,d-s);
2283 s = force_word(s,WORD);
2286 sv_setpv(subname,"?");
2288 if (tmp != KEY_format)
2313 TERM(sublex_start());
2337 yylval.ival = curcop->cop_line;
2341 yylval.ival = curcop->cop_line;
2358 if (dowarn && *s != '0' && isDIGIT(*s))
2359 warn("umask: argument is missing initial 0");
2373 yylval.ival = curcop->cop_line;
2392 if (expect == XOPERATOR)
2399 TERM(sublex_start());
2412 if (strEQ(d,"__LINE__")) return KEY___LINE__;
2413 if (strEQ(d,"__FILE__")) return KEY___FILE__;
2414 if (strEQ(d,"__END__")) return KEY___END__;
2418 if (strEQ(d,"alarm")) return KEY_alarm;
2419 if (strEQ(d,"accept")) return KEY_accept;
2420 if (strEQ(d,"atan2")) return KEY_atan2;
2423 if (strEQ(d,"BEGIN")) return KEY_BEGIN;
2426 if (strEQ(d,"bless")) return KEY_bless;
2427 if (strEQ(d,"bind")) return KEY_bind;
2428 if (strEQ(d,"binmode")) return KEY_binmode;
2433 if (strEQ(d,"cmp")) return KEY_cmp;
2434 if (strEQ(d,"cos")) return KEY_cos;
2437 if (strEQ(d,"chop")) return KEY_chop;
2440 if (strEQ(d,"close")) return KEY_close;
2441 if (strEQ(d,"chdir")) return KEY_chdir;
2442 if (strEQ(d,"chmod")) return KEY_chmod;
2443 if (strEQ(d,"chown")) return KEY_chown;
2444 if (strEQ(d,"crypt")) return KEY_crypt;
2447 if (strEQ(d,"chroot")) return KEY_chroot;
2448 if (strEQ(d,"caller")) return KEY_caller;
2451 if (strEQ(d,"connect")) return KEY_connect;
2454 if (strEQ(d,"closedir")) return KEY_closedir;
2455 if (strEQ(d,"continue")) return KEY_continue;
2462 if (strEQ(d,"do")) return KEY_do;
2465 if (strEQ(d,"die")) return KEY_die;
2468 if (strEQ(d,"dump")) return KEY_dump;
2471 if (strEQ(d,"delete")) return KEY_delete;
2474 if (strEQ(d,"defined")) return KEY_defined;
2475 if (strEQ(d,"dbmopen")) return KEY_dbmopen;
2478 if (strEQ(d,"dbmclose")) return KEY_dbmclose;
2483 if (strEQ(d,"EQ")) return KEY_eq;
2484 if (strEQ(d,"END")) return KEY_END;
2489 if (strEQ(d,"eq")) return KEY_eq;
2492 if (strEQ(d,"eof")) return KEY_eof;
2493 if (strEQ(d,"exp")) return KEY_exp;
2496 if (strEQ(d,"else")) return KEY_else;
2497 if (strEQ(d,"exit")) return KEY_exit;
2498 if (strEQ(d,"eval")) return KEY_eval;
2499 if (strEQ(d,"exec")) return KEY_exec;
2500 if (strEQ(d,"each")) return KEY_each;
2503 if (strEQ(d,"elsif")) return KEY_elsif;
2506 if (strEQ(d,"endgrent")) return KEY_endgrent;
2507 if (strEQ(d,"endpwent")) return KEY_endpwent;
2510 if (strEQ(d,"endnetent")) return KEY_endnetent;
2513 if (strEQ(d,"endhostent")) return KEY_endhostent;
2514 if (strEQ(d,"endservent")) return KEY_endservent;
2517 if (strEQ(d,"endprotoent")) return KEY_endprotoent;
2524 if (strEQ(d,"for")) return KEY_for;
2527 if (strEQ(d,"fork")) return KEY_fork;
2530 if (strEQ(d,"fcntl")) return KEY_fcntl;
2531 if (strEQ(d,"flock")) return KEY_flock;
2534 if (strEQ(d,"format")) return KEY_format;
2535 if (strEQ(d,"fileno")) return KEY_fileno;
2538 if (strEQ(d,"foreach")) return KEY_foreach;
2541 if (strEQ(d,"formline")) return KEY_formline;
2547 if (strEQ(d,"GT")) return KEY_gt;
2548 if (strEQ(d,"GE")) return KEY_ge;
2552 if (strnEQ(d,"get",3)) {
2557 if (strEQ(d,"ppid")) return KEY_getppid;
2558 if (strEQ(d,"pgrp")) return KEY_getpgrp;
2561 if (strEQ(d,"pwent")) return KEY_getpwent;
2562 if (strEQ(d,"pwnam")) return KEY_getpwnam;
2563 if (strEQ(d,"pwuid")) return KEY_getpwuid;
2566 if (strEQ(d,"peername")) return KEY_getpeername;
2567 if (strEQ(d,"protoent")) return KEY_getprotoent;
2568 if (strEQ(d,"priority")) return KEY_getpriority;
2571 if (strEQ(d,"protobyname")) return KEY_getprotobyname;
2574 if (strEQ(d,"protobynumber"))return KEY_getprotobynumber;
2578 else if (*d == 'h') {
2579 if (strEQ(d,"hostbyname")) return KEY_gethostbyname;
2580 if (strEQ(d,"hostbyaddr")) return KEY_gethostbyaddr;
2581 if (strEQ(d,"hostent")) return KEY_gethostent;
2583 else if (*d == 'n') {
2584 if (strEQ(d,"netbyname")) return KEY_getnetbyname;
2585 if (strEQ(d,"netbyaddr")) return KEY_getnetbyaddr;
2586 if (strEQ(d,"netent")) return KEY_getnetent;
2588 else if (*d == 's') {
2589 if (strEQ(d,"servbyname")) return KEY_getservbyname;
2590 if (strEQ(d,"servbyport")) return KEY_getservbyport;
2591 if (strEQ(d,"servent")) return KEY_getservent;
2592 if (strEQ(d,"sockname")) return KEY_getsockname;
2593 if (strEQ(d,"sockopt")) return KEY_getsockopt;
2595 else if (*d == 'g') {
2596 if (strEQ(d,"grent")) return KEY_getgrent;
2597 if (strEQ(d,"grnam")) return KEY_getgrnam;
2598 if (strEQ(d,"grgid")) return KEY_getgrgid;
2600 else if (*d == 'l') {
2601 if (strEQ(d,"login")) return KEY_getlogin;
2607 if (strEQ(d,"gt")) return KEY_gt;
2608 if (strEQ(d,"ge")) return KEY_ge;
2611 if (strEQ(d,"grep")) return KEY_grep;
2612 if (strEQ(d,"goto")) return KEY_goto;
2613 if (strEQ(d,"getc")) return KEY_getc;
2614 if (strEQ(d,"glob")) return KEY_glob;
2617 if (strEQ(d,"gmtime")) return KEY_gmtime;
2622 if (strEQ(d,"hex")) return KEY_hex;
2627 if (strEQ(d,"if")) return KEY_if;
2630 if (strEQ(d,"int")) return KEY_int;
2633 if (strEQ(d,"index")) return KEY_index;
2634 if (strEQ(d,"ioctl")) return KEY_ioctl;
2639 if (strEQ(d,"join")) return KEY_join;
2643 if (strEQ(d,"keys")) return KEY_keys;
2644 if (strEQ(d,"kill")) return KEY_kill;
2649 if (strEQ(d,"LT")) return KEY_lt;
2650 if (strEQ(d,"LE")) return KEY_le;
2656 if (strEQ(d,"lt")) return KEY_lt;
2657 if (strEQ(d,"le")) return KEY_le;
2658 if (strEQ(d,"lc")) return KEY_lc;
2661 if (strEQ(d,"log")) return KEY_log;
2664 if (strEQ(d,"last")) return KEY_last;
2665 if (strEQ(d,"link")) return KEY_link;
2668 if (strEQ(d,"local")) return KEY_local;
2669 if (strEQ(d,"lstat")) return KEY_lstat;
2672 if (strEQ(d,"length")) return KEY_length;
2673 if (strEQ(d,"listen")) return KEY_listen;
2676 if (strEQ(d,"lcfirst")) return KEY_lcfirst;
2679 if (strEQ(d,"localtime")) return KEY_localtime;
2685 case 1: return KEY_m;
2687 if (strEQ(d,"my")) return KEY_my;
2690 if (strEQ(d,"mkdir")) return KEY_mkdir;
2693 if (strEQ(d,"msgctl")) return KEY_msgctl;
2694 if (strEQ(d,"msgget")) return KEY_msgget;
2695 if (strEQ(d,"msgrcv")) return KEY_msgrcv;
2696 if (strEQ(d,"msgsnd")) return KEY_msgsnd;
2701 if (strEQ(d,"NE")) return KEY_ne;
2704 if (strEQ(d,"next")) return KEY_next;
2705 if (strEQ(d,"ne")) return KEY_ne;
2710 if (strEQ(d,"ord")) return KEY_ord;
2711 if (strEQ(d,"oct")) return KEY_oct;
2714 if (strEQ(d,"open")) return KEY_open;
2717 if (strEQ(d,"opendir")) return KEY_opendir;
2724 if (strEQ(d,"pop")) return KEY_pop;
2727 if (strEQ(d,"push")) return KEY_push;
2728 if (strEQ(d,"pack")) return KEY_pack;
2729 if (strEQ(d,"pipe")) return KEY_pipe;
2732 if (strEQ(d,"print")) return KEY_print;
2735 if (strEQ(d,"printf")) return KEY_printf;
2738 if (strEQ(d,"package")) return KEY_package;
2744 if (strEQ(d,"q")) return KEY_q;
2745 if (strEQ(d,"qq")) return KEY_qq;
2746 if (strEQ(d,"qx")) return KEY_qx;
2752 if (strEQ(d,"ref")) return KEY_ref;
2755 if (strEQ(d,"read")) return KEY_read;
2756 if (strEQ(d,"rand")) return KEY_rand;
2757 if (strEQ(d,"recv")) return KEY_recv;
2758 if (strEQ(d,"redo")) return KEY_redo;
2761 if (strEQ(d,"rmdir")) return KEY_rmdir;
2762 if (strEQ(d,"reset")) return KEY_reset;
2765 if (strEQ(d,"return")) return KEY_return;
2766 if (strEQ(d,"rename")) return KEY_rename;
2767 if (strEQ(d,"rindex")) return KEY_rindex;
2770 if (strEQ(d,"require")) return KEY_require;
2771 if (strEQ(d,"reverse")) return KEY_reverse;
2772 if (strEQ(d,"readdir")) return KEY_readdir;
2775 if (strEQ(d,"readlink")) return KEY_readlink;
2776 if (strEQ(d,"readline")) return KEY_readline;
2777 if (strEQ(d,"readpipe")) return KEY_readpipe;
2780 if (strEQ(d,"rewinddir")) return KEY_rewinddir;
2786 case 0: return KEY_s;
2788 if (strEQ(d,"scalar")) return KEY_scalar;
2793 if (strEQ(d,"seek")) return KEY_seek;
2794 if (strEQ(d,"send")) return KEY_send;
2797 if (strEQ(d,"semop")) return KEY_semop;
2800 if (strEQ(d,"select")) return KEY_select;
2801 if (strEQ(d,"semctl")) return KEY_semctl;
2802 if (strEQ(d,"semget")) return KEY_semget;
2805 if (strEQ(d,"setpgrp")) return KEY_setpgrp;
2806 if (strEQ(d,"seekdir")) return KEY_seekdir;
2809 if (strEQ(d,"setpwent")) return KEY_setpwent;
2810 if (strEQ(d,"setgrent")) return KEY_setgrent;
2813 if (strEQ(d,"setnetent")) return KEY_setnetent;
2816 if (strEQ(d,"setsockopt")) return KEY_setsockopt;
2817 if (strEQ(d,"sethostent")) return KEY_sethostent;
2818 if (strEQ(d,"setservent")) return KEY_setservent;
2821 if (strEQ(d,"setpriority")) return KEY_setpriority;
2822 if (strEQ(d,"setprotoent")) return KEY_setprotoent;
2829 if (strEQ(d,"shift")) return KEY_shift;
2832 if (strEQ(d,"shmctl")) return KEY_shmctl;
2833 if (strEQ(d,"shmget")) return KEY_shmget;
2836 if (strEQ(d,"shmread")) return KEY_shmread;
2839 if (strEQ(d,"shmwrite")) return KEY_shmwrite;
2840 if (strEQ(d,"shutdown")) return KEY_shutdown;
2845 if (strEQ(d,"sin")) return KEY_sin;
2848 if (strEQ(d,"sleep")) return KEY_sleep;
2851 if (strEQ(d,"sort")) return KEY_sort;
2852 if (strEQ(d,"socket")) return KEY_socket;
2853 if (strEQ(d,"socketpair")) return KEY_socketpair;
2856 if (strEQ(d,"split")) return KEY_split;
2857 if (strEQ(d,"sprintf")) return KEY_sprintf;
2858 if (strEQ(d,"splice")) return KEY_splice;
2861 if (strEQ(d,"sqrt")) return KEY_sqrt;
2864 if (strEQ(d,"srand")) return KEY_srand;
2867 if (strEQ(d,"stat")) return KEY_stat;
2868 if (strEQ(d,"study")) return KEY_study;
2871 if (strEQ(d,"substr")) return KEY_substr;
2872 if (strEQ(d,"sub")) return KEY_sub;
2877 if (strEQ(d,"system")) return KEY_system;
2880 if (strEQ(d,"sysread")) return KEY_sysread;
2881 if (strEQ(d,"symlink")) return KEY_symlink;
2882 if (strEQ(d,"syscall")) return KEY_syscall;
2885 if (strEQ(d,"syswrite")) return KEY_syswrite;
2894 if (strEQ(d,"tr")) return KEY_tr;
2897 if (strEQ(d,"tell")) return KEY_tell;
2898 if (strEQ(d,"time")) return KEY_time;
2901 if (strEQ(d,"times")) return KEY_times;
2904 if (strEQ(d,"telldir")) return KEY_telldir;
2907 if (strEQ(d,"truncate")) return KEY_truncate;
2914 if (strEQ(d,"uc")) return KEY_uc;
2917 if (strEQ(d,"undef")) return KEY_undef;
2918 if (strEQ(d,"until")) return KEY_until;
2919 if (strEQ(d,"utime")) return KEY_utime;
2920 if (strEQ(d,"umask")) return KEY_umask;
2923 if (strEQ(d,"unless")) return KEY_unless;
2924 if (strEQ(d,"unpack")) return KEY_unpack;
2925 if (strEQ(d,"unlink")) return KEY_unlink;
2928 if (strEQ(d,"unshift")) return KEY_unshift;
2929 if (strEQ(d,"ucfirst")) return KEY_ucfirst;
2934 if (strEQ(d,"values")) return KEY_values;
2935 if (strEQ(d,"vec")) return KEY_vec;
2940 if (strEQ(d,"warn")) return KEY_warn;
2941 if (strEQ(d,"wait")) return KEY_wait;
2944 if (strEQ(d,"while")) return KEY_while;
2945 if (strEQ(d,"write")) return KEY_write;
2948 if (strEQ(d,"waitpid")) return KEY_waitpid;
2951 if (strEQ(d,"wantarray")) return KEY_wantarray;
2956 if (len == 1) return KEY_x;
2959 if (len == 1) return KEY_y;
2968 checkcomma(s,name,what)
2975 if (dowarn && *s == ' ' && s[1] == '(') {
2978 for (w++; *w && isSPACE(*w); w++) ;
2979 if (!w || !*w || !strchr(";|}", *w)) /* an advisory hack only... */
2980 warn("%s (...) interpreted as function",name);
2982 while (s < bufend && isSPACE(*s))
2986 while (s < bufend && isSPACE(*s))
2988 if (isIDFIRST(*s)) {
2992 while (s < bufend && isSPACE(*s))
2997 "tell eof times getlogin wait length shift umask getppid \
2998 cos exp int log rand sin sqrt ord wantarray",
3003 fatal("No comma allowed after %s", what);
3009 scan_ident(s,send,dest,ck_uni)
3011 register char *send;
3018 if (lex_brackets == 0)
3027 while (isALNUM(*s) || *s == '\'')
3030 while (d > dest+1 && d[-1] == '\'')
3035 if (lex_state != LEX_NORMAL)
3036 lex_state = LEX_INTERPENDMAYBE;
3040 (*s == '$' && (isALPHA(s[1]) || s[1] == '$' || s[1] == '_')))
3051 if (*d == '^' && (isUPPER(*s) || strchr("[\\]^_?", *s))) {
3057 if (isALPHA(*d) || *d == '_') {
3062 if (*s == '[' || *s == '{') {
3064 fatal("Can't use delimiter brackets within expression");
3065 lex_fakebrack = TRUE;
3073 if (lex_state == LEX_INTERPNORMAL && !lex_brackets)
3074 lex_state = LEX_INTERPEND;
3077 s = bracket; /* let the parser handle it */
3081 else if (lex_state == LEX_INTERPNORMAL && !lex_brackets && !intuit_more(s))
3082 lex_state = LEX_INTERPEND;
3087 scan_prefix(pm,string,len)
3092 register SV *tmpstr;
3096 char *origstring = string;
3098 if (ninstr(string, string+len, vert, vert+1))
3102 tmpstr = NEWSV(86,len);
3103 sv_upgrade(tmpstr, SVt_PVBM);
3104 sv_setpvn(tmpstr,string,len);
3107 BmUSEFUL(tmpstr) = 100;
3108 for (d=t; d < e; ) {
3116 case '.': case '[': case '$': case '(': case ')': case '|': case '+':
3121 if (d[1] && strchr("wWbB0123456789sSdDlLuUExc",d[1])) {
3125 Move(d+1,d,e-d,char);
3150 if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
3162 SvCUR_set(tmpstr, d - t);
3164 pm->op_pmflags |= PMf_ALL;
3165 if (*origstring != '^')
3166 pm->op_pmflags |= PMf_SCANFIRST;
3167 pm->op_pmshort = tmpstr;
3168 pm->op_pmslen = d - t;
3178 multi_start = curcop->cop_line;
3180 s = scan_str(start);
3185 fatal("Search pattern not terminated");
3187 pm = (PMOP*)newPMOP(OP_MATCH, 0);
3189 pm->op_pmflags |= PMf_ONCE;
3191 while (*s == 'i' || *s == 'o' || *s == 'g') {
3195 pm->op_pmflags |= PMf_FOLD;
3199 pm->op_pmflags |= PMf_KEEP;
3203 pm->op_pmflags |= PMf_GLOBAL;
3208 yylval.ival = OP_MATCH;
3216 register char *s = start;
3220 multi_start = curcop->cop_line;
3221 yylval.ival = OP_NULL;
3229 fatal("Substitution pattern not terminated");
3232 if (s[-1] == *start)
3243 fatal("Substitution replacement not terminated");
3246 pm = (PMOP*)newPMOP(OP_SUBST, 0);
3247 while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
3254 pm->op_pmflags |= PMf_GLOBAL;
3259 pm->op_pmflags |= PMf_FOLD;
3263 pm->op_pmflags |= PMf_KEEP;
3269 pm->op_pmflags |= PMf_EVAL;
3273 sv_catpvn(repl, "eval ", 5);
3275 sv_catpvn(repl, "{ ", 2);
3276 sv_catsv(repl, lex_repl);
3277 sv_catpvn(repl, " };", 2);
3278 SvCOMPILED_on(repl);
3284 yylval.ival = OP_SUBST;
3292 if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
3293 (!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH)
3295 if (!(pm->op_pmregexp->reganch & ROPT_ANCH))
3296 pm->op_pmflags |= PMf_SCANFIRST;
3297 else if (pm->op_pmflags & PMf_FOLD)
3299 pm->op_pmshort = sv_ref(pm->op_pmregexp->regstart);
3301 else if (pm->op_pmregexp->regmust) {/* is there a better short-circuit? */
3302 if (pm->op_pmshort &&
3303 sv_eq(pm->op_pmshort,pm->op_pmregexp->regmust))
3305 if (pm->op_pmflags & PMf_SCANFIRST) {
3306 sv_free(pm->op_pmshort);
3307 pm->op_pmshort = Nullsv;
3310 sv_free(pm->op_pmregexp->regmust);
3311 pm->op_pmregexp->regmust = Nullsv;
3315 if (!pm->op_pmshort || /* promote the better string */
3316 ((pm->op_pmflags & PMf_SCANFIRST) &&
3317 (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)) )){
3318 sv_free(pm->op_pmshort); /* ok if null */
3319 pm->op_pmshort = pm->op_pmregexp->regmust;
3320 pm->op_pmregexp->regmust = Nullsv;
3321 pm->op_pmflags |= PMf_SCANFIRST;
3330 register char *s = start;
3337 yylval.ival = OP_NULL;
3344 fatal("Translation pattern not terminated");
3346 if (s[-1] == *start)
3357 fatal("Translation replacement not terminated");
3360 New(803,tbl,256,short);
3361 op = newPVOP(OP_TRANS, 0, (char*)tbl);
3363 complement = delete = squash = 0;
3364 while (*s == 'c' || *s == 'd' || *s == 's') {
3366 complement = OPpTRANS_COMPLEMENT;
3368 delete = OPpTRANS_DELETE;
3370 squash = OPpTRANS_SQUASH;
3373 op->op_private = delete|squash|complement;
3376 yylval.ival = OP_TRANS;
3385 I32 op_type = OP_SCALAR;
3395 if (*s && strchr("`'\"",*s)) {
3397 s = cpytill(d,s,bufend,term,&len);
3409 } /* assuming tokenbuf won't clobber */
3414 if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
3415 herewas = newSVpv(s,bufend-s);
3417 s--, herewas = newSVpv(s,d-s);
3418 s += SvCUR(herewas);
3422 op_type = OP_BACKTICK;
3425 multi_start = curcop->cop_line;
3426 multi_open = multi_close = '<';
3427 tmpstr = NEWSV(87,80);
3431 while (s < bufend &&
3432 (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
3437 curcop->cop_line = multi_start;
3438 fatal("EOF in string");
3440 sv_setpvn(tmpstr,d+1,s-d);
3442 sv_catpvn(herewas,s,bufend-s);
3443 sv_setsv(linestr,herewas);
3444 oldoldbufptr = oldbufptr = bufptr = s = SvPVn(linestr);
3445 bufend = SvPV(linestr) + SvCUR(linestr);
3448 sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */
3449 while (s >= bufend) { /* multiple line string? */
3451 !(oldoldbufptr = oldbufptr = s = sv_gets(linestr, rsfp, 0))) {
3452 curcop->cop_line = multi_start;
3453 fatal("EOF in string");
3457 SV *sv = NEWSV(88,0);
3459 sv_upgrade(sv, SVt_PVMG);
3460 sv_setsv(sv,linestr);
3461 av_store(GvAV(curcop->cop_filegv),
3462 (I32)curcop->cop_line,sv);
3464 bufend = SvPV(linestr) + SvCUR(linestr);
3465 if (*s == term && bcmp(s,tokenbuf,len) == 0) {
3468 sv_catsv(linestr,herewas);
3469 bufend = SvPV(linestr) + SvCUR(linestr);
3473 sv_catsv(tmpstr,linestr);
3476 multi_end = curcop->cop_line;
3478 if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
3479 SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
3480 Renew(SvPV(tmpstr), SvLEN(tmpstr), char);
3484 yylval.ival = op_type;
3489 scan_inputsymbol(start)
3492 register char *s = start;
3497 s = cpytill(d, s+1, bufend, '>', &len);
3501 fatal("Unterminated <> operator");
3504 while (*d && (isALNUM(*d) || *d == '\''))
3506 if (d - tokenbuf != len) {
3507 yylval.ival = OP_GLOB;
3509 s = scan_str(start);
3511 fatal("Glob not terminated");
3517 (void)strcpy(d,"ARGV");
3519 GV *gv = gv_fetchpv(d+1,TRUE);
3520 lex_op = (OP*)newUNOP(OP_READLINE, 0,
3521 newUNOP(OP_RV2GV, 0,
3522 newUNOP(OP_RV2SV, 0,
3523 newGVOP(OP_GV, 0, gv))));
3524 yylval.ival = OP_NULL;
3529 GV *gv = gv_fetchpv(d,TRUE);
3531 if (strEQ(d,"ARGV")) {
3533 io->flags |= IOf_ARGV|IOf_START;
3535 lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
3536 yylval.ival = OP_NULL;
3548 register char *s = start;
3549 register char term = *s;
3554 multi_start = curcop->cop_line;
3556 if (term && (tmps = strchr("([{< )]}> )]}>",term)))
3561 sv_upgrade(sv, SVt_PV);
3562 SvSTORAGE(sv) = term;
3563 SvPOK_only(sv); /* validate pointer */
3566 SvGROW(sv, SvCUR(sv) + (bufend - s) + 1);
3567 to = SvPV(sv)+SvCUR(sv);
3568 if (multi_open == multi_close) {
3569 for (; s < bufend; s++,to++) {
3570 if (*s == '\\' && s+1 < bufend && term != '\\')
3572 else if (*s == term)
3578 for (; s < bufend; s++,to++) {
3579 if (*s == '\\' && s+1 < bufend && term != '\\')
3581 else if (*s == term && --brackets <= 0)
3583 else if (*s == multi_open)
3589 SvCUR_set(sv, to - SvPV(sv));
3591 if (s < bufend) break; /* string ends on this line? */
3594 !(oldoldbufptr = oldbufptr = s = sv_gets(linestr, rsfp, 0))) {
3595 curcop->cop_line = multi_start;
3600 SV *sv = NEWSV(88,0);
3602 sv_upgrade(sv, SVt_PVMG);
3603 sv_setsv(sv,linestr);
3604 av_store(GvAV(curcop->cop_filegv),
3605 (I32)curcop->cop_line, sv);
3607 bufend = SvPV(linestr) + SvCUR(linestr);
3609 multi_end = curcop->cop_line;
3611 if (SvCUR(sv) + 5 < SvLEN(sv)) {
3612 SvLEN_set(sv, SvCUR(sv) + 1);
3613 Renew(SvPV(sv), SvLEN(sv), char);
3626 register char *s = start;
3636 fatal("panic: scan_num");
3646 else if (s[1] == '.')
3660 yyerror("Illegal octal digit");
3662 case '0': case '1': case '2': case '3': case '4':
3663 case '5': case '6': case '7':
3667 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
3668 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
3672 i += (*s++ & 7) + 9;
3679 if (tryi32 == i && tryi32 >= 0)
3680 sv_setiv(sv,tryi32);
3682 sv_setnv(sv,(double)i);
3685 case '1': case '2': case '3': case '4': case '5':
3686 case '6': case '7': case '8': case '9': case '.':
3690 while (isDIGIT(*s) || *s == '_') {
3692 if (dowarn && lastub && s - lastub != 3)
3693 warn("Misplaced _");
3699 if (dowarn && lastub && s - lastub != 3)
3700 warn("Misplaced _");
3701 if (*s == '.' && s[1] != '.') {
3704 while (isDIGIT(*s) || *s == '_') {
3711 if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
3714 *d++ = 'e'; /* At least some Mach atof()s don't grok 'E' */
3715 if (*s == '+' || *s == '-')
3722 value = atof(tokenbuf);
3723 tryi32 = (I32)value;
3724 if (!floatit && (double)tryi32 == value)
3725 sv_setiv(sv,tryi32);
3731 yylval.opval = newSVOP(OP_CONST, 0, sv);
3742 SV *stuff = NEWSV(0,0);
3743 bool needargs = FALSE;
3748 for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
3752 if (in_eval && !rsfp) {
3753 eol = strchr(s,'\n');
3758 eol = bufend = SvPV(linestr) + SvCUR(linestr);
3760 sv_catpvn(stuff, s, eol-s);
3762 if (*s == '@' || *s == '^') {
3771 s = sv_gets(linestr, rsfp, 0);
3772 oldoldbufptr = oldbufptr = bufptr = SvPVn(linestr);
3775 yyerror("Format not terminated");
3783 nextval[nexttoke].ival = 0;
3788 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
3790 nextval[nexttoke].ival = OP_FORMLINE;
3806 cshlen = strlen(cshname);