This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Integrate from mainperl.
[perl5.git] / toke.c
CommitLineData
a0d0e21e 1/* toke.c
a687059c 2 *
4eb8286e 3 * Copyright (c) 1991-1999, Larry Wall
a687059c 4 *
d48672a2
LW		 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.
378cc40b 7 *
a0d0e21e
LW		 8 */
9
10/*
11 * "It all comes from here, the stench and the peril." --Frodo
378cc40b
LW		 12 */
13
14#include "EXTERN.h"
864dbfa3 15#define PERL_IN_TOKE_C
378cc40b 16#include "perl.h"
378cc40b 17
d3b6f988
GS		 18#define yychar PL_yychar
19#define yylval PL_yylval
20
fc36a67e 21static char ident_too_long[] = "Identifier too long";
8903cb82 22
a0ed51b3 23#define UTF (PL_hints & HINT_UTF8)
834a4ddd
LW		 24/*
25 * Note: we try to be careful never to call the isXXX_utf8() functions
26 * unless we're pretty sure we've seen the beginning of a UTF-8 character
27 * (that is, the two high bits are set). Otherwise we risk loading in the
28 * heavy-duty SWASHINIT and SWASHGET routines unnecessarily.
29 */
30#define isIDFIRST_lazy(p) ((!UTF || (*((U8*)p) < 0xc0)) \
31 ? isIDFIRST(*(p)) \
32 : isIDFIRST_utf8((U8*)p))
33#define isALNUM_lazy(p) ((!UTF || (*((U8*)p) < 0xc0)) \
34 ? isALNUM(*(p)) \
35 : isALNUM_utf8((U8*)p))
a0ed51b3 36
2b92dfce
GS		 37/* In variables name $^X, these are the legal values for X.
38 * 1999-02-27 mjd-perl-patch@plover.com */
39#define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
40
79072805
LW		 41/* The following are arranged oddly so that the guard on the switch statement
42 * can get by with a single comparison (if the compiler is smart enough).
43 */
44
fb73857a 45/* #define LEX_NOTPARSING 11 is done in perl.h. */
46
55497cff 47#define LEX_NORMAL 10
48#define LEX_INTERPNORMAL 9
49#define LEX_INTERPCASEMOD 8
50#define LEX_INTERPPUSH 7
51#define LEX_INTERPSTART 6
52#define LEX_INTERPEND 5
53#define LEX_INTERPENDMAYBE 4
54#define LEX_INTERPCONCAT 3
55#define LEX_INTERPCONST 2
56#define LEX_FORMLINE 1
57#define LEX_KNOWNEXT 0
79072805 58
395c3793
LW		 59#ifdef I_FCNTL
60#include <fcntl.h>
61#endif
fe14fcc3
LW		 62#ifdef I_SYS_FILE
63#include <sys/file.h>
64#endif
395c3793 65
a790bc05 66/* XXX If this causes problems, set i_unistd=undef in the hint file. */
67#ifdef I_UNISTD
68# include <unistd.h> /* Needed for execv() */
69#endif
70
71
79072805
LW		 72#ifdef ff_next
73#undef ff_next
d48672a2
LW		 74#endif
75
a1a0e61e
TD		 76#ifdef USE_PURE_BISON
77YYSTYPE* yylval_pointer = NULL;
78int* yychar_pointer = NULL;
22c35a8c
GS		 79# undef yylval
80# undef yychar
e4bfbdd4
JH		 81# define yylval (*yylval_pointer)
82# define yychar (*yychar_pointer)
83# define PERL_YYLEX_PARAM yylval_pointer,yychar_pointer
cea2e8a9
GS		 84# undef yylex
85# define yylex() Perl_yylex(aTHX_ yylval_pointer, yychar_pointer)
a1a0e61e
TD		 86#endif
87
79072805 88#include "keywords.h"
fe14fcc3 89
ae986130
LW		 90#ifdef CLINE
91#undef CLINE
92#endif
3280af22
NIS		 93#define CLINE (PL_copline = (PL_curcop->cop_line < PL_copline ? PL_curcop->cop_line : PL_copline))
94
95#define TOKEN(retval) return (PL_bufptr = s,(int)retval)
96#define OPERATOR(retval) return (PL_expect = XTERM,PL_bufptr = s,(int)retval)
97#define AOPERATOR(retval) return ao((PL_expect = XTERM,PL_bufptr = s,(int)retval))
98#define PREBLOCK(retval) return (PL_expect = XBLOCK,PL_bufptr = s,(int)retval)
99#define PRETERMBLOCK(retval) return (PL_expect = XTERMBLOCK,PL_bufptr = s,(int)retval)
100#define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s,(int)retval)
101#define TERM(retval) return (CLINE, PL_expect = XOPERATOR,PL_bufptr = s,(int)retval)
102#define LOOPX(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LOOPEX)
103#define FTST(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)UNIOP)
104#define FUN0(f) return(yylval.ival = f,PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC0)
105#define FUN1(f) return(yylval.ival = f,PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC1)
106#define BOop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)BITOROP))
107#define BAop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)BITANDOP))
108#define SHop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)SHIFTOP))
109#define PWop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)POWOP))
110#define PMop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)MATCHOP)
111#define Aop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)ADDOP))
112#define Mop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)MULOP))
113#define Eop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)EQOP)
114#define Rop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)RELOP)
2f3197b3 115
a687059c
LW		 116/* This bit of chicanery makes a unary function followed by
117 * a parenthesis into a function with one argument, highest precedence.
118 */
2f3197b3 119#define UNI(f) return(yylval.ival = f, \
3280af22
NIS		 120 PL_expect = XTERM, \
121 PL_bufptr = s, \
122 PL_last_uni = PL_oldbufptr, \
123 PL_last_lop_op = f, \
a687059c
LW		 124 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
125
79072805 126#define UNIBRACK(f) return(yylval.ival = f, \
3280af22
NIS		 127 PL_bufptr = s, \
128 PL_last_uni = PL_oldbufptr, \
79072805
LW		 129 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
130
9f68db38 131/* grandfather return to old style */
3280af22 132#define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
79072805 133
76e3520e 134STATIC int
cea2e8a9 135S_ao(pTHX_ int toketype)
a0d0e21e 136{
3280af22
NIS		 137 if (*PL_bufptr == '=') {
138 PL_bufptr++;
a0d0e21e
LW		 139 if (toketype == ANDAND)
140 yylval.ival = OP_ANDASSIGN;
141 else if (toketype == OROR)
142 yylval.ival = OP_ORASSIGN;
143 toketype = ASSIGNOP;
144 }
145 return toketype;
146}
147
76e3520e 148STATIC void
cea2e8a9 149S_no_op(pTHX_ char *what, char *s)
463ee0b2 150{
3280af22
NIS		 151 char *oldbp = PL_bufptr;
152 bool is_first = (PL_oldbufptr == PL_linestart);
68dc0745 153
3280af22 154 PL_bufptr = s;
cea2e8a9 155 yywarn(Perl_form(aTHX_ "%s found where operator expected", what));
748a9306 156 if (is_first)
cea2e8a9 157 Perl_warn(aTHX_ "\t(Missing semicolon on previous line?)\n");
834a4ddd 158 else if (PL_oldoldbufptr && isIDFIRST_lazy(PL_oldoldbufptr)) {
748a9306 159 char *t;
834a4ddd 160 for (t = PL_oldoldbufptr; *t && (isALNUM_lazy(t) || *t == ':'); t++) ;
3280af22 161 if (t < PL_bufptr && isSPACE(*t))
cea2e8a9 162 Perl_warn(aTHX_ "\t(Do you need to predeclare %.*s?)\n",
3280af22 163 t - PL_oldoldbufptr, PL_oldoldbufptr);
748a9306
LW		 164
165 }
d194fe61 166 else if (s <= oldbp)
cea2e8a9 167 Perl_warn(aTHX_ "\t(Missing operator before end of line?)\n");
748a9306 168 else
cea2e8a9 169 Perl_warn(aTHX_ "\t(Missing operator before %.*s?)\n", s - oldbp, oldbp);
3280af22 170 PL_bufptr = oldbp;
8990e307
LW		 171}
172
76e3520e 173STATIC void
cea2e8a9 174S_missingterm(pTHX_ char *s)
8990e307
LW		 175{
176 char tmpbuf[3];
177 char q;
178 if (s) {
179 char *nl = strrchr(s,'\n');
d2719217 180 if (nl)
8990e307
LW		 181 *nl = '\0';
182 }
9d116dd7
JH		 183 else if (
184#ifdef EBCDIC
185 iscntrl(PL_multi_close)
186#else
187 PL_multi_close < 32 || PL_multi_close == 127
188#endif
189 ) {
8990e307 190 *tmpbuf = '^';
3280af22 191 tmpbuf[1] = toCTRL(PL_multi_close);
8990e307
LW		 192 s = "\\n";
193 tmpbuf[2] = '\0';
194 s = tmpbuf;
195 }
196 else {
3280af22 197 *tmpbuf = PL_multi_close;
8990e307
LW		 198 tmpbuf[1] = '\0';
199 s = tmpbuf;
200 }
201 q = strchr(s,'"') ? '\'' : '"';
cea2e8a9 202 Perl_croak(aTHX_ "Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
463ee0b2 203}
79072805
LW		 204
205void
864dbfa3 206Perl_deprecate(pTHX_ char *s)
a0d0e21e 207{
d008e5eb 208 dTHR;
599cee73 209 if (ckWARN(WARN_DEPRECATED))
cea2e8a9 210 Perl_warner(aTHX_ WARN_DEPRECATED, "Use of %s is deprecated", s);
a0d0e21e
LW		 211}
212
76e3520e 213STATIC void
cea2e8a9 214S_depcom(pTHX)
a0d0e21e
LW		 215{
216 deprecate("comma-less variable list");
217}
218
a868473f
NIS		 219#ifdef WIN32
220
76e3520e 221STATIC I32
cea2e8a9 222S_win32_textfilter(pTHX_ int idx, SV *sv, int maxlen)
a868473f
NIS		 223{
224 I32 count = FILTER_READ(idx+1, sv, maxlen);
225 if (count > 0 && !maxlen)
226 win32_strip_return(sv);
227 return count;
228}
229#endif
230
a0ed51b3 231STATIC I32
cea2e8a9 232S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
a0ed51b3
LW		 233{
234 I32 count = FILTER_READ(idx+1, sv, maxlen);
235 if (count) {
dfe13c55
GS		 236 U8* tmps;
237 U8* tend;
238 New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
a0ed51b3 239 tend = utf16_to_utf8((U16*)SvPVX(sv), tmps, SvCUR(sv));
dfe13c55 240 sv_usepvn(sv, (char*)tmps, tend - tmps);
a0ed51b3
LW		 241
242 }
243 return count;
244}
245
246STATIC I32
cea2e8a9 247S_utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
a0ed51b3
LW		 248{
249 I32 count = FILTER_READ(idx+1, sv, maxlen);
250 if (count) {
dfe13c55
GS		 251 U8* tmps;
252 U8* tend;
253 New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
a0ed51b3 254 tend = utf16_to_utf8_reversed((U16*)SvPVX(sv), tmps, SvCUR(sv));
dfe13c55 255 sv_usepvn(sv, (char*)tmps, tend - tmps);
a0ed51b3
LW		 256
257 }
258 return count;
259}
a868473f 260
a0d0e21e 261void
864dbfa3 262Perl_lex_start(pTHX_ SV *line)
79072805 263{
0f15f207 264 dTHR;
8990e307
LW		 265 char *s;
266 STRLEN len;
267
3280af22
NIS		 268 SAVEI32(PL_lex_dojoin);
269 SAVEI32(PL_lex_brackets);
270 SAVEI32(PL_lex_fakebrack);
271 SAVEI32(PL_lex_casemods);
272 SAVEI32(PL_lex_starts);
273 SAVEI32(PL_lex_state);
274 SAVESPTR(PL_lex_inpat);
275 SAVEI32(PL_lex_inwhat);
276 SAVEI16(PL_curcop->cop_line);
277 SAVEPPTR(PL_bufptr);
278 SAVEPPTR(PL_bufend);
279 SAVEPPTR(PL_oldbufptr);
280 SAVEPPTR(PL_oldoldbufptr);
281 SAVEPPTR(PL_linestart);
282 SAVESPTR(PL_linestr);
283 SAVEPPTR(PL_lex_brackstack);
284 SAVEPPTR(PL_lex_casestack);
cea2e8a9 285 SAVEDESTRUCTOR(S_restore_rsfp, PL_rsfp);
3280af22
NIS		 286 SAVESPTR(PL_lex_stuff);
287 SAVEI32(PL_lex_defer);
288 SAVESPTR(PL_lex_repl);
cea2e8a9
GS		 289 SAVEDESTRUCTOR(S_restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */
290 SAVEDESTRUCTOR(S_restore_lex_expect, PL_tokenbuf + PL_expect);
3280af22
NIS		 291
292 PL_lex_state = LEX_NORMAL;
293 PL_lex_defer = 0;
294 PL_expect = XSTATE;
295 PL_lex_brackets = 0;
296 PL_lex_fakebrack = 0;
297 New(899, PL_lex_brackstack, 120, char);
298 New(899, PL_lex_casestack, 12, char);
299 SAVEFREEPV(PL_lex_brackstack);
300 SAVEFREEPV(PL_lex_casestack);
301 PL_lex_casemods = 0;
302 *PL_lex_casestack = '\0';
303 PL_lex_dojoin = 0;
304 PL_lex_starts = 0;
305 PL_lex_stuff = Nullsv;
306 PL_lex_repl = Nullsv;
307 PL_lex_inpat = 0;
308 PL_lex_inwhat = 0;
309 PL_linestr = line;
310 if (SvREADONLY(PL_linestr))
311 PL_linestr = sv_2mortal(newSVsv(PL_linestr));
312 s = SvPV(PL_linestr, len);
8990e307 313 if (len && s[len-1] != ';') {
3280af22
NIS		 314 if (!(SvFLAGS(PL_linestr) & SVs_TEMP))
315 PL_linestr = sv_2mortal(newSVsv(PL_linestr));
316 sv_catpvn(PL_linestr, "\n;", 2);
8990e307 317 }
3280af22
NIS		 318 SvTEMP_off(PL_linestr);
319 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
320 PL_bufend = PL_bufptr + SvCUR(PL_linestr);
321 SvREFCNT_dec(PL_rs);
79cb57f6 322 PL_rs = newSVpvn("\n", 1);
3280af22 323 PL_rsfp = 0;
79072805 324}
a687059c 325
463ee0b2 326void
864dbfa3 327Perl_lex_end(pTHX)
463ee0b2 328{
3280af22 329 PL_doextract = FALSE;
463ee0b2
LW		 330}
331
76e3520e 332STATIC void
cea2e8a9 333S_restore_rsfp(pTHX_ void *f)
6d5fb7e3 334{
760ac839 335 PerlIO *fp = (PerlIO*)f;
6d5fb7e3 336
3280af22
NIS		 337 if (PL_rsfp == PerlIO_stdin())
338 PerlIO_clearerr(PL_rsfp);
339 else if (PL_rsfp && (PL_rsfp != fp))
340 PerlIO_close(PL_rsfp);
341 PL_rsfp = fp;
6d5fb7e3
CS		 342}
343
76e3520e 344STATIC void
cea2e8a9 345S_restore_expect(pTHX_ void *e)
49d8d3a1
MB		 346{
347 /* a safe way to store a small integer in a pointer */
3280af22 348 PL_expect = (expectation)((char *)e - PL_tokenbuf);
49d8d3a1
MB		 349}
350
837485b6 351STATIC void
cea2e8a9 352S_restore_lex_expect(pTHX_ void *e)
49d8d3a1
MB		 353{
354 /* a safe way to store a small integer in a pointer */
3280af22 355 PL_lex_expect = (expectation)((char *)e - PL_tokenbuf);
49d8d3a1
MB		 356}
357
837485b6 358STATIC void
cea2e8a9 359S_incline(pTHX_ char *s)
463ee0b2 360{
0f15f207 361 dTHR;
463ee0b2
LW		 362 char *t;
363 char *n;
364 char ch;
365 int sawline = 0;
366
3280af22 367 PL_curcop->cop_line++;
463ee0b2
LW		 368 if (*s++ != '#')
369 return;
370 while (*s == ' ' || *s == '\t') s++;
371 if (strnEQ(s, "line ", 5)) {
372 s += 5;
373 sawline = 1;
374 }
375 if (!isDIGIT(*s))
376 return;
377 n = s;
378 while (isDIGIT(*s))
379 s++;
380 while (*s == ' ' || *s == '\t')
381 s++;
382 if (*s == '"' && (t = strchr(s+1, '"')))
383 s++;
384 else {
385 if (!sawline)
386 return; /* false alarm */
387 for (t = s; !isSPACE(*t); t++) ;
388 }
389 ch = *t;
390 *t = '\0';
391 if (t - s > 0)
3280af22 392 PL_curcop->cop_filegv = gv_fetchfile(s);
463ee0b2 393 else
3280af22 394 PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename);
463ee0b2 395 *t = ch;
3280af22 396 PL_curcop->cop_line = atoi(n)-1;
463ee0b2
LW		 397}
398
76e3520e 399STATIC char *
cea2e8a9 400S_skipspace(pTHX_ register char *s)
a687059c 401{
11343788 402 dTHR;
3280af22
NIS		 403 if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
404 while (s < PL_bufend && (*s == ' ' || *s == '\t'))
463ee0b2
LW		 405 s++;
406 return s;
407 }
408 for (;;) {
fd049845 409 STRLEN prevlen;
60e6418e
GS		 410 while (s < PL_bufend && isSPACE(*s)) {
411 if (*s++ == '\n' && PL_in_eval && !PL_rsfp)
412 incline(s);
413 }
3280af22
NIS		 414 if (s < PL_bufend && *s == '#') {
415 while (s < PL_bufend && *s != '\n')
463ee0b2 416 s++;
60e6418e 417 if (s < PL_bufend) {
463ee0b2 418 s++;
60e6418e
GS		 419 if (PL_in_eval && !PL_rsfp) {
420 incline(s);
421 continue;
422 }
423 }
463ee0b2 424 }
3280af22 425 if (s < PL_bufend || !PL_rsfp || PL_lex_state != LEX_NORMAL)
463ee0b2 426 return s;
3280af22
NIS		 427 if ((s = filter_gets(PL_linestr, PL_rsfp, (prevlen = SvCUR(PL_linestr)))) == Nullch) {
428 if (PL_minus_n || PL_minus_p) {
429 sv_setpv(PL_linestr,PL_minus_p ?
08e9d68e
DD		 430 ";}continue{print or die qq(-p destination: $!\\n)" :
431 "");
3280af22
NIS		 432 sv_catpv(PL_linestr,";}");
433 PL_minus_n = PL_minus_p = 0;
a0d0e21e
LW		 434 }
435 else
3280af22
NIS		 436 sv_setpv(PL_linestr,";");
437 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
438 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
439 if (PL_preprocess && !PL_in_eval)
440 (void)PerlProc_pclose(PL_rsfp);
441 else if ((PerlIO*)PL_rsfp == PerlIO_stdin())
442 PerlIO_clearerr(PL_rsfp);
8990e307 443 else
3280af22
NIS		 444 (void)PerlIO_close(PL_rsfp);
445 PL_rsfp = Nullfp;
463ee0b2
LW		 446 return s;
447 }
3280af22
NIS		 448 PL_linestart = PL_bufptr = s + prevlen;
449 PL_bufend = s + SvCUR(PL_linestr);
450 s = PL_bufptr;
a0d0e21e 451 incline(s);
3280af22 452 if (PERLDB_LINE && PL_curstash != PL_debstash) {
8990e307
LW		 453 SV *sv = NEWSV(85,0);
454
455 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 456 sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
457 av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
8990e307 458 }
463ee0b2 459 }
a687059c 460}
378cc40b 461
76e3520e 462STATIC void
cea2e8a9 463S_check_uni(pTHX)
ba106d47 464{
2f3197b3
LW		 465 char *s;
466 char ch;
a0d0e21e 467 char *t;
2f3197b3 468
3280af22 469 if (PL_oldoldbufptr != PL_last_uni)
2f3197b3 470 return;
3280af22
NIS		 471 while (isSPACE(*PL_last_uni))
472 PL_last_uni++;
834a4ddd 473 for (s = PL_last_uni; isALNUM_lazy(s) || *s == '-'; s++) ;
3280af22 474 if ((t = strchr(s, '(')) && t < PL_bufptr)
a0d0e21e 475 return;
2f3197b3
LW		 476 ch = *s;
477 *s = '\0';
cea2e8a9 478 Perl_warn(aTHX_ "Warning: Use of \"%s\" without parens is ambiguous", PL_last_uni);
2f3197b3
LW		 479 *s = ch;
480}
481
ffed7fef
LW		 482#ifdef CRIPPLED_CC
483
484#undef UNI
ffed7fef 485#define UNI(f) return uni(f,s)
ffed7fef 486
76e3520e 487STATIC int
cea2e8a9 488S_uni(pTHX_ I32 f, char *s)
ffed7fef
LW		 489{
490 yylval.ival = f;
3280af22
NIS		 491 PL_expect = XTERM;
492 PL_bufptr = s;
8f872242
NIS		 493 PL_last_uni = PL_oldbufptr;
494 PL_last_lop_op = f;
ffed7fef
LW		 495 if (*s == '(')
496 return FUNC1;
497 s = skipspace(s);
498 if (*s == '(')
499 return FUNC1;
500 else
501 return UNIOP;
502}
503
a0d0e21e
LW		 504#endif /* CRIPPLED_CC */
505
506#define LOP(f,x) return lop(f,x,s)
507
76e3520e 508STATIC I32
cea2e8a9 509S_lop(pTHX_ I32 f, expectation x, char *s)
ffed7fef 510{
0f15f207 511 dTHR;
79072805 512 yylval.ival = f;
35c8bce7 513 CLINE;
3280af22
NIS		 514 PL_expect = x;
515 PL_bufptr = s;
516 PL_last_lop = PL_oldbufptr;
517 PL_last_lop_op = f;
518 if (PL_nexttoke)
a0d0e21e 519 return LSTOP;
79072805
LW		 520 if (*s == '(')
521 return FUNC;
522 s = skipspace(s);
523 if (*s == '(')
524 return FUNC;
525 else
526 return LSTOP;
527}
528
76e3520e 529STATIC void
cea2e8a9 530S_force_next(pTHX_ I32 type)
79072805 531{
3280af22
NIS		 532 PL_nexttype[PL_nexttoke] = type;
533 PL_nexttoke++;
534 if (PL_lex_state != LEX_KNOWNEXT) {
535 PL_lex_defer = PL_lex_state;
536 PL_lex_expect = PL_expect;
537 PL_lex_state = LEX_KNOWNEXT;
79072805
LW		 538 }
539}
540
76e3520e 541STATIC char *
cea2e8a9 542S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
79072805 543{
463ee0b2
LW		 544 register char *s;
545 STRLEN len;
546
547 start = skipspace(start);
548 s = start;
834a4ddd 549 if (isIDFIRST_lazy(s) ||
a0d0e21e 550 (allow_pack && *s == ':') ||
15f0808c 551 (allow_initial_tick && *s == '\'') )
a0d0e21e 552 {
3280af22
NIS		 553 s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len);
554 if (check_keyword && keyword(PL_tokenbuf, len))
463ee0b2
LW		 555 return start;
556 if (token == METHOD) {
557 s = skipspace(s);
558 if (*s == '(')
3280af22 559 PL_expect = XTERM;
463ee0b2 560 else {
3280af22 561 PL_expect = XOPERATOR;
463ee0b2 562 }
79072805 563 }
3280af22
NIS		 564 PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(PL_tokenbuf,0));
565 PL_nextval[PL_nexttoke].opval->op_private |= OPpCONST_BARE;
79072805
LW		 566 force_next(token);
567 }
568 return s;
569}
570
76e3520e 571STATIC void
cea2e8a9 572S_force_ident(pTHX_ register char *s, int kind)
79072805
LW		 573{
574 if (s && *s) {
11343788 575 OP* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
3280af22 576 PL_nextval[PL_nexttoke].opval = o;
79072805 577 force_next(WORD);
748a9306 578 if (kind) {
e858de61 579 dTHR; /* just for in_eval */
11343788 580 o->op_private = OPpCONST_ENTERED;
55497cff 581 /* XXX see note in pp_entereval() for why we forgo typo
582 warnings if the symbol must be introduced in an eval.
583 GSAR 96-10-12 */
3280af22 584 gv_fetchpv(s, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
a0d0e21e
LW		 585 kind == '$' ? SVt_PV :
586 kind == '@' ? SVt_PVAV :
587 kind == '%' ? SVt_PVHV :
588 SVt_PVGV
589 );
748a9306 590 }
79072805
LW		 591 }
592}
593
76e3520e 594STATIC char *
cea2e8a9 595S_force_version(pTHX_ char *s)
89bfa8cd 596{
597 OP *version = Nullop;
598
599 s = skipspace(s);
600
601 /* default VERSION number -- GBARR */
602
603 if(isDIGIT(*s)) {
604 char *d;
605 int c;
55497cff 606 for( d=s, c = 1; isDIGIT(*d) || *d == '_' || (*d == '.' && c--); d++);
89bfa8cd 607 if((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') {
608 s = scan_num(s);
609 /* real VERSION number -- GBARR */
610 version = yylval.opval;
611 }
612 }
613
614 /* NOTE: The parser sees the package name and the VERSION swapped */
3280af22 615 PL_nextval[PL_nexttoke].opval = version;
89bfa8cd 616 force_next(WORD);
617
618 return (s);
619}
620
76e3520e 621STATIC SV *
cea2e8a9 622S_tokeq(pTHX_ SV *sv)
79072805
LW		 623{
624 register char *s;
625 register char *send;
626 register char *d;
b3ac6de7
IZ		 627 STRLEN len = 0;
628 SV *pv = sv;
79072805
LW		 629
630 if (!SvLEN(sv))
b3ac6de7 631 goto finish;
79072805 632
a0d0e21e 633 s = SvPV_force(sv, len);
748a9306 634 if (SvIVX(sv) == -1)
b3ac6de7 635 goto finish;
463ee0b2 636 send = s + len;
79072805
LW		 637 while (s < send && *s != '\\')
638 s++;
639 if (s == send)
b3ac6de7 640 goto finish;
79072805 641 d = s;
3280af22 642 if ( PL_hints & HINT_NEW_STRING )
79cb57f6 643 pv = sv_2mortal(newSVpvn(SvPVX(pv), len));
79072805
LW		 644 while (s < send) {
645 if (*s == '\\') {
a0d0e21e 646 if (s + 1 < send && (s[1] == '\\'))
79072805
LW		 647 s++; /* all that, just for this */
648 }
649 *d++ = *s++;
650 }
651 *d = '\0';
463ee0b2 652 SvCUR_set(sv, d - SvPVX(sv));
b3ac6de7 653 finish:
3280af22 654 if ( PL_hints & HINT_NEW_STRING )
b3ac6de7 655 return new_constant(NULL, 0, "q", sv, pv, "q");
79072805
LW		 656 return sv;
657}
658
76e3520e 659STATIC I32
cea2e8a9 660S_sublex_start(pTHX)
79072805
LW		 661{
662 register I32 op_type = yylval.ival;
79072805
LW		 663
664 if (op_type == OP_NULL) {
3280af22
NIS		 665 yylval.opval = PL_lex_op;
666 PL_lex_op = Nullop;
79072805
LW		 667 return THING;
668 }
669 if (op_type == OP_CONST || op_type == OP_READLINE) {
3280af22 670 SV *sv = tokeq(PL_lex_stuff);
b3ac6de7
IZ		 671
672 if (SvTYPE(sv) == SVt_PVIV) {
673 /* Overloaded constants, nothing fancy: Convert to SVt_PV: */
674 STRLEN len;
675 char *p;
676 SV *nsv;
677
678 p = SvPV(sv, len);
79cb57f6 679 nsv = newSVpvn(p, len);
b3ac6de7
IZ		 680 SvREFCNT_dec(sv);
681 sv = nsv;
682 }
683 yylval.opval = (OP*)newSVOP(op_type, 0, sv);
3280af22 684 PL_lex_stuff = Nullsv;
79072805
LW		 685 return THING;
686 }
687
3280af22
NIS		 688 PL_sublex_info.super_state = PL_lex_state;
689 PL_sublex_info.sub_inwhat = op_type;
690 PL_sublex_info.sub_op = PL_lex_op;
691 PL_lex_state = LEX_INTERPPUSH;
55497cff 692
3280af22
NIS		 693 PL_expect = XTERM;
694 if (PL_lex_op) {
695 yylval.opval = PL_lex_op;
696 PL_lex_op = Nullop;
55497cff 697 return PMFUNC;
698 }
699 else
700 return FUNC;
701}
702
76e3520e 703STATIC I32
cea2e8a9 704S_sublex_push(pTHX)
55497cff 705{
0f15f207 706 dTHR;
f46d017c 707 ENTER;
55497cff 708
3280af22
NIS		 709 PL_lex_state = PL_sublex_info.super_state;
710 SAVEI32(PL_lex_dojoin);
711 SAVEI32(PL_lex_brackets);
712 SAVEI32(PL_lex_fakebrack);
713 SAVEI32(PL_lex_casemods);
714 SAVEI32(PL_lex_starts);
715 SAVEI32(PL_lex_state);
716 SAVESPTR(PL_lex_inpat);
717 SAVEI32(PL_lex_inwhat);
718 SAVEI16(PL_curcop->cop_line);
719 SAVEPPTR(PL_bufptr);
720 SAVEPPTR(PL_oldbufptr);
721 SAVEPPTR(PL_oldoldbufptr);
722 SAVEPPTR(PL_linestart);
723 SAVESPTR(PL_linestr);
724 SAVEPPTR(PL_lex_brackstack);
725 SAVEPPTR(PL_lex_casestack);
726
727 PL_linestr = PL_lex_stuff;
728 PL_lex_stuff = Nullsv;
729
730 PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
731 PL_bufend += SvCUR(PL_linestr);
732 SAVEFREESV(PL_linestr);
733
734 PL_lex_dojoin = FALSE;
735 PL_lex_brackets = 0;
736 PL_lex_fakebrack = 0;
737 New(899, PL_lex_brackstack, 120, char);
738 New(899, PL_lex_casestack, 12, char);
739 SAVEFREEPV(PL_lex_brackstack);
740 SAVEFREEPV(PL_lex_casestack);
741 PL_lex_casemods = 0;
742 *PL_lex_casestack = '\0';
743 PL_lex_starts = 0;
744 PL_lex_state = LEX_INTERPCONCAT;
745 PL_curcop->cop_line = PL_multi_start;
746
747 PL_lex_inwhat = PL_sublex_info.sub_inwhat;
748 if (PL_lex_inwhat == OP_MATCH || PL_lex_inwhat == OP_QR || PL_lex_inwhat == OP_SUBST)
749 PL_lex_inpat = PL_sublex_info.sub_op;
79072805 750 else
3280af22 751 PL_lex_inpat = Nullop;
79072805 752
55497cff 753 return '(';
79072805
LW		 754}
755
76e3520e 756STATIC I32
cea2e8a9 757S_sublex_done(pTHX)
79072805 758{
3280af22
NIS		 759 if (!PL_lex_starts++) {
760 PL_expect = XOPERATOR;
79cb57f6 761 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn("",0));
79072805
LW		 762 return THING;
763 }
764
3280af22
NIS		 765 if (PL_lex_casemods) { /* oops, we've got some unbalanced parens */
766 PL_lex_state = LEX_INTERPCASEMOD;
cea2e8a9 767 return yylex();
79072805
LW		 768 }
769
79072805 770 /* Is there a right-hand side to take care of? */
3280af22
NIS		 771 if (PL_lex_repl && (PL_lex_inwhat == OP_SUBST || PL_lex_inwhat == OP_TRANS)) {
772 PL_linestr = PL_lex_repl;
773 PL_lex_inpat = 0;
774 PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
775 PL_bufend += SvCUR(PL_linestr);
776 SAVEFREESV(PL_linestr);
777 PL_lex_dojoin = FALSE;
778 PL_lex_brackets = 0;
779 PL_lex_fakebrack = 0;
780 PL_lex_casemods = 0;
781 *PL_lex_casestack = '\0';
782 PL_lex_starts = 0;
25da4f38 783 if (SvEVALED(PL_lex_repl)) {
3280af22
NIS		 784 PL_lex_state = LEX_INTERPNORMAL;
785 PL_lex_starts++;
e9fa98b2
HS		 786 /* we don't clear PL_lex_repl here, so that we can check later
787 whether this is an evalled subst; that means we rely on the
788 logic to ensure sublex_done() is called again only via the
789 branch (in yylex()) that clears PL_lex_repl, else we'll loop */
79072805 790 }
e9fa98b2 791 else {
3280af22 792 PL_lex_state = LEX_INTERPCONCAT;
e9fa98b2
HS		 793 PL_lex_repl = Nullsv;
794 }
79072805 795 return ',';
ffed7fef
LW		 796 }
797 else {
f46d017c 798 LEAVE;
3280af22
NIS		 799 PL_bufend = SvPVX(PL_linestr);
800 PL_bufend += SvCUR(PL_linestr);
801 PL_expect = XOPERATOR;
79072805 802 return ')';
ffed7fef
LW		 803 }
804}
805
02aa26ce
NT		 806/*
807 scan_const
808
809 Extracts a pattern, double-quoted string, or transliteration. This
810 is terrifying code.
811
3280af22
NIS		 812 It looks at lex_inwhat and PL_lex_inpat to find out whether it's
813 processing a pattern (PL_lex_inpat is true), a transliteration
02aa26ce
NT		 814 (lex_inwhat & OP_TRANS is true), or a double-quoted string.
815
9b599b2a
GS		 816 Returns a pointer to the character scanned up to. Iff this is
817 advanced from the start pointer supplied (ie if anything was
818 successfully parsed), will leave an OP for the substring scanned
819 in yylval. Caller must intuit reason for not parsing further
820 by looking at the next characters herself.
821
02aa26ce
NT		 822 In patterns:
823 backslashes:
824 double-quoted style: \r and \n
825 regexp special ones: \D \s
826 constants: \x3
827 backrefs: \1 (deprecated in substitution replacements)
828 case and quoting: \U \Q \E
829 stops on @ and $, but not for $ as tail anchor
830
831 In transliterations:
832 characters are VERY literal, except for - not at the start or end
833 of the string, which indicates a range. scan_const expands the
834 range to the full set of intermediate characters.
835
836 In double-quoted strings:
837 backslashes:
838 double-quoted style: \r and \n
839 constants: \x3
840 backrefs: \1 (deprecated)
841 case and quoting: \U \Q \E
842 stops on @ and $
843
844 scan_const does *not* construct ops to handle interpolated strings.
845 It stops processing as soon as it finds an embedded $ or @ variable
846 and leaves it to the caller to work out what's going on.
847
848 @ in pattern could be: @foo, @{foo}, @$foo, @'foo, @:foo.
849
850 $ in pattern could be $foo or could be tail anchor. Assumption:
851 it's a tail anchor if $ is the last thing in the string, or if it's
852 followed by one of ")| \n\t"
853
854 \1 (backreferences) are turned into $1
855
856 The structure of the code is
857 while (there's a character to process) {
858 handle transliteration ranges
859 skip regexp comments
860 skip # initiated comments in //x patterns
861 check for embedded @foo
862 check for embedded scalars
863 if (backslash) {
864 leave intact backslashes from leave (below)
865 deprecate \1 in strings and sub replacements
866 handle string-changing backslashes \l \U \Q \E, etc.
867 switch (what was escaped) {
868 handle - in a transliteration (becomes a literal -)
869 handle \132 octal characters
870 handle 0x15 hex characters
871 handle \cV (control V)
872 handle printf backslashes (\f, \r, \n, etc)
873 } (end switch)
874 } (end if backslash)
875 } (end while character to read)
876
877*/
878
76e3520e 879STATIC char *
cea2e8a9 880S_scan_const(pTHX_ char *start)
79072805 881{
3280af22 882 register char *send = PL_bufend; /* end of the constant */
02aa26ce
NT		 883 SV *sv = NEWSV(93, send - start); /* sv for the constant */
884 register char *s = start; /* start of the constant */
885 register char *d = SvPVX(sv); /* destination for copies */
886 bool dorange = FALSE; /* are we in a translit range? */
887 I32 len; /* ? */
ac2262e3 888 I32 utf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
a0ed51b3
LW		 889 ? (PL_sublex_info.sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
890 : UTF;
ac2262e3 891 I32 thisutf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
a0ed51b3
LW		 892 ? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF))
893 : UTF;
02aa26ce 894
9b599b2a 895 /* leaveit is the set of acceptably-backslashed characters */
72aaf631 896 char *leaveit =
3280af22 897 PL_lex_inpat
a0ed51b3 898 ? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#"
9b599b2a 899 : "";
79072805
LW		 900
901 while (s < send || dorange) {
02aa26ce 902 /* get transliterations out of the way (they're most literal) */
3280af22 903 if (PL_lex_inwhat == OP_TRANS) {
02aa26ce 904 /* expand a range A-Z to the full set of characters. AIE! */
79072805 905 if (dorange) {
02aa26ce 906 I32 i; /* current expanded character */
8ada0baa 907 I32 min; /* first character in range */
02aa26ce
NT		 908 I32 max; /* last character in range */
909
910 i = d - SvPVX(sv); /* remember current offset */
911 SvGROW(sv, SvLEN(sv) + 256); /* expand the sv -- there'll never be more'n 256 chars in a range for it to grow by */
912 d = SvPVX(sv) + i; /* restore d after the grow potentially has changed the ptr */
913 d -= 2; /* eat the first char and the - */
914
8ada0baa
JH		 915 min = (U8)*d; /* first char in range */
916 max = (U8)d[1]; /* last char in range */
917
918#ifndef ASCIIish
919 if ((isLOWER(min) && isLOWER(max)) ||
920 (isUPPER(min) && isUPPER(max))) {
921 if (isLOWER(min)) {
922 for (i = min; i <= max; i++)
923 if (isLOWER(i))
924 *d++ = i;
925 } else {
926 for (i = min; i <= max; i++)
927 if (isUPPER(i))
928 *d++ = i;
929 }
930 }
931 else
932#endif
933 for (i = min; i <= max; i++)
934 *d++ = i;
02aa26ce
NT		 935
936 /* mark the range as done, and continue */
79072805
LW		 937 dorange = FALSE;
938 continue;
939 }
02aa26ce
NT		 940
941 /* range begins (ignore - as first or last char) */
79072805 942 else if (*s == '-' && s+1 < send && s != start) {
a0ed51b3 943 if (utf) {
a176fa2a 944 *d++ = (char)0xff; /* use illegal utf8 byte--see pmtrans */
a0ed51b3
LW		 945 s++;
946 continue;
947 }
79072805
LW		 948 dorange = TRUE;
949 s++;
950 }
951 }
02aa26ce
NT		 952
953 /* if we get here, we're not doing a transliteration */
954
0f5d15d6
IZ		 955 /* skip for regexp comments /(?#comment)/ and code /(?{code})/,
956 except for the last char, which will be done separately. */
3280af22 957 else if (*s == '(' && PL_lex_inpat && s[1] == '?') {
cc6b7395
IZ		 958 if (s[2] == '#') {
959 while (s < send && *s != ')')
960 *d++ = *s++;
0f5d15d6
IZ		 961 } else if (s[2] == '{'
962 || s[2] == 'p' && s[3] == '{') { /* This should march regcomp.c */
cc6b7395 963 I32 count = 1;
0f5d15d6 964 char *regparse = s + (s[2] == '{' ? 3 : 4);
cc6b7395
IZ		 965 char c;
966
d9f97599
GS		 967 while (count && (c = *regparse)) {
968 if (c == '\\' && regparse[1])
969 regparse++;
cc6b7395
IZ		 970 else if (c == '{')
971 count++;
972 else if (c == '}')
973 count--;
d9f97599 974 regparse++;
cc6b7395 975 }
5bdf89e7
IZ		 976 if (*regparse != ')') {
977 regparse--; /* Leave one char for continuation. */
cc6b7395 978 yyerror("Sequence (?{...}) not terminated or not {}-balanced");
5bdf89e7 979 }
0f5d15d6 980 while (s < regparse)
cc6b7395
IZ		 981 *d++ = *s++;
982 }
748a9306 983 }
02aa26ce
NT		 984
985 /* likewise skip #-initiated comments in //x patterns */
3280af22
NIS		 986 else if (*s == '#' && PL_lex_inpat &&
987 ((PMOP*)PL_lex_inpat)->op_pmflags & PMf_EXTENDED) {
748a9306
LW		 988 while (s+1 < send && *s != '\n')
989 *d++ = *s++;
990 }
02aa26ce
NT		 991
992 /* check for embedded arrays (@foo, @:foo, @'foo, @{foo}, @$foo) */
834a4ddd 993 else if (*s == '@' && s[1] && (isALNUM_lazy(s+1) || strchr(":'{$", s[1])))
79072805 994 break;
02aa26ce
NT		 995
996 /* check for embedded scalars. only stop if we're sure it's a
997 variable.
998 */
79072805 999 else if (*s == '$') {
3280af22 1000 if (!PL_lex_inpat) /* not a regexp, so $ must be var */
79072805 1001 break;
c277df42 1002 if (s + 1 < send && !strchr("()| \n\t", s[1]))
79072805
LW		 1003 break; /* in regexp, $ might be tail anchor */
1004 }
02aa26ce 1005
a0ed51b3
LW		 1006 /* (now in tr/// code again) */
1007
d008e5eb
GS		 1008 if (*s & 0x80 && thisutf) {
1009 dTHR; /* only for ckWARN */
1010 if (ckWARN(WARN_UTF8)) {
dfe13c55 1011 (void)utf8_to_uv((U8*)s, &len); /* could cvt latin-1 to utf8 here... */
d008e5eb
GS		 1012 if (len) {
1013 while (len--)
1014 *d++ = *s++;
1015 continue;
1016 }
a0ed51b3
LW		 1017 }
1018 }
1019
02aa26ce 1020 /* backslashes */
79072805
LW		 1021 if (*s == '\\' && s+1 < send) {
1022 s++;
02aa26ce
NT		 1023
1024 /* some backslashes we leave behind */
c9f97d15 1025 if (*leaveit && *s && strchr(leaveit, *s)) {
79072805
LW		 1026 *d++ = '\\';
1027 *d++ = *s++;
1028 continue;
1029 }
02aa26ce
NT		 1030
1031 /* deprecate \1 in strings and substitution replacements */
3280af22 1032 if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
a0d0e21e 1033 isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
79072805 1034 {
d008e5eb 1035 dTHR; /* only for ckWARN */
599cee73 1036 if (ckWARN(WARN_SYNTAX))
cea2e8a9 1037 Perl_warner(aTHX_ WARN_SYNTAX, "\\%c better written as $%c", *s, *s);
79072805
LW		 1038 *--s = '$';
1039 break;
1040 }
02aa26ce
NT		 1041
1042 /* string-change backslash escapes */
3280af22 1043 if (PL_lex_inwhat != OP_TRANS && *s && strchr("lLuUEQ", *s)) {
79072805
LW		 1044 --s;
1045 break;
1046 }
02aa26ce
NT		 1047
1048 /* if we get here, it's either a quoted -, or a digit */
79072805 1049 switch (*s) {
02aa26ce
NT		 1050
1051 /* quoted - in transliterations */
79072805 1052 case '-':
3280af22 1053 if (PL_lex_inwhat == OP_TRANS) {
79072805
LW		 1054 *d++ = *s++;
1055 continue;
1056 }
1057 /* FALL THROUGH */
1058 default:
11b8faa4
JH		 1059 {
1060 dTHR;
1061 if (ckWARN(WARN_UNSAFE) && isALPHA(*s))
cea2e8a9 1062 Perl_warner(aTHX_ WARN_UNSAFE,
11b8faa4
JH		 1063 "Unrecognized escape \\%c passed through",
1064 *s);
1065 /* default action is to copy the quoted character */
1066 *d++ = *s++;
1067 continue;
1068 }
02aa26ce
NT		 1069
1070 /* \132 indicates an octal constant */
79072805
LW		 1071 case '0': case '1': case '2': case '3':
1072 case '4': case '5': case '6': case '7':
1073 *d++ = scan_oct(s, 3, &len);
1074 s += len;
1075 continue;
02aa26ce
NT		 1076
1077 /* \x24 indicates a hex constant */
79072805 1078 case 'x':
a0ed51b3
LW		 1079 ++s;
1080 if (*s == '{') {
1081 char* e = strchr(s, '}');
1082
adaeee49 1083 if (!e) {
a0ed51b3 1084 yyerror("Missing right brace on \\x{}");
adaeee49
GA		 1085 e = s;
1086 }
d008e5eb
GS		 1087 if (!utf) {
1088 dTHR;
1089 if (ckWARN(WARN_UTF8))
cea2e8a9 1090 Perl_warner(aTHX_ WARN_UTF8,
d008e5eb
GS		 1091 "Use of \\x{} without utf8 declaration");
1092 }
a0ed51b3 1093 /* note: utf always shorter than hex */
dfe13c55
GS		 1094 d = (char*)uv_to_utf8((U8*)d,
1095 scan_hex(s + 1, e - s - 1, &len));
a0ed51b3
LW		 1096 s = e + 1;
1097
1098 }
1099 else {
1100 UV uv = (UV)scan_hex(s, 2, &len);
1101 if (utf && PL_lex_inwhat == OP_TRANS &&
1102 utf != (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
1103 {
dfe13c55 1104 d = (char*)uv_to_utf8((U8*)d, uv); /* doing a CU or UC */
a0ed51b3
LW		 1105 }
1106 else {
d008e5eb
GS		 1107 if (uv >= 127 && UTF) {
1108 dTHR;
1109 if (ckWARN(WARN_UTF8))
cea2e8a9 1110 Perl_warner(aTHX_ WARN_UTF8,
d008e5eb
GS		 1111 "\\x%.*s will produce malformed UTF-8 character; use \\x{%.*s} for that",
1112 len,s,len,s);
1113 }
a0ed51b3
LW		 1114 *d++ = (char)uv;
1115 }
1116 s += len;
1117 }
79072805 1118 continue;
02aa26ce
NT		 1119
1120 /* \c is a control character */
79072805
LW		 1121 case 'c':
1122 s++;
9d116dd7
JH		 1123#ifdef EBCDIC
1124 *d = *s++;
1125 if (isLOWER(*d))
1126 *d = toUPPER(*d);
1127 *d++ = toCTRL(*d);
1128#else
bbce6d69 1129 len = *s++;
1130 *d++ = toCTRL(len);
9d116dd7 1131#endif
79072805 1132 continue;
02aa26ce
NT		 1133
1134 /* printf-style backslashes, formfeeds, newlines, etc */
79072805
LW		 1135 case 'b':
1136 *d++ = '\b';
1137 break;
1138 case 'n':
1139 *d++ = '\n';
1140 break;
1141 case 'r':
1142 *d++ = '\r';
1143 break;
1144 case 'f':
1145 *d++ = '\f';
1146 break;
1147 case 't':
1148 *d++ = '\t';
1149 break;
1150 case 'e':
1151 *d++ = '\033';
1152 break;
1153 case 'a':
1154 *d++ = '\007';
1155 break;
02aa26ce
NT		 1156 } /* end switch */
1157
79072805
LW		 1158 s++;
1159 continue;
02aa26ce
NT		 1160 } /* end if (backslash) */
1161
79072805 1162 *d++ = *s++;
02aa26ce
NT		 1163 } /* while loop to process each character */
1164
1165 /* terminate the string and set up the sv */
79072805 1166 *d = '\0';
463ee0b2 1167 SvCUR_set(sv, d - SvPVX(sv));
79072805
LW		 1168 SvPOK_on(sv);
1169
02aa26ce 1170 /* shrink the sv if we allocated more than we used */
79072805
LW		 1171 if (SvCUR(sv) + 5 < SvLEN(sv)) {
1172 SvLEN_set(sv, SvCUR(sv) + 1);
463ee0b2 1173 Renew(SvPVX(sv), SvLEN(sv), char);
79072805 1174 }
02aa26ce 1175
9b599b2a 1176 /* return the substring (via yylval) only if we parsed anything */
3280af22
NIS		 1177 if (s > PL_bufptr) {
1178 if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) )
1179 sv = new_constant(start, s - start, (PL_lex_inpat ? "qr" : "q"),
b3ac6de7 1180 sv, Nullsv,
3280af22 1181 ( PL_lex_inwhat == OP_TRANS
b3ac6de7 1182 ? "tr"
3280af22 1183 : ( (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat)
b3ac6de7
IZ		 1184 ? "s"
1185 : "qq")));
79072805 1186 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
b3ac6de7 1187 } else
8990e307 1188 SvREFCNT_dec(sv);
79072805
LW		 1189 return s;
1190}
1191
1192/* This is the one truly awful dwimmer necessary to conflate C and sed. */
76e3520e 1193STATIC int
cea2e8a9 1194S_intuit_more(pTHX_ register char *s)
79072805 1195{
3280af22 1196 if (PL_lex_brackets)
79072805
LW		 1197 return TRUE;
1198 if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
1199 return TRUE;
1200 if (*s != '{' && *s != '[')
1201 return FALSE;
3280af22 1202 if (!PL_lex_inpat)
79072805
LW		 1203 return TRUE;
1204
1205 /* In a pattern, so maybe we have {n,m}. */
1206 if (*s == '{') {
1207 s++;
1208 if (!isDIGIT(*s))
1209 return TRUE;
1210 while (isDIGIT(*s))
1211 s++;
1212 if (*s == ',')
1213 s++;
1214 while (isDIGIT(*s))
1215 s++;
1216 if (*s == '}')
1217 return FALSE;
1218 return TRUE;
1219
1220 }
1221
1222 /* On the other hand, maybe we have a character class */
1223
1224 s++;
1225 if (*s == ']' || *s == '^')
1226 return FALSE;
1227 else {
1228 int weight = 2; /* let's weigh the evidence */
1229 char seen[256];
f27ffc4a 1230 unsigned char un_char = 255, last_un_char;
93a17b20 1231 char *send = strchr(s,']');
3280af22 1232 char tmpbuf[sizeof PL_tokenbuf * 4];
79072805
LW		 1233
1234 if (!send) /* has to be an expression */
1235 return TRUE;
1236
1237 Zero(seen,256,char);
1238 if (*s == '$')
1239 weight -= 3;
1240 else if (isDIGIT(*s)) {
1241 if (s[1] != ']') {
1242 if (isDIGIT(s[1]) && s[2] == ']')
1243 weight -= 10;
1244 }
1245 else
1246 weight -= 100;
1247 }
1248 for (; s < send; s++) {
1249 last_un_char = un_char;
1250 un_char = (unsigned char)*s;
1251 switch (*s) {
1252 case '@':
1253 case '&':
1254 case '$':
1255 weight -= seen[un_char] * 10;
834a4ddd 1256 if (isALNUM_lazy(s+1)) {
8903cb82 1257 scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE);
a0d0e21e 1258 if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
79072805
LW		 1259 weight -= 100;
1260 else
1261 weight -= 10;
1262 }
1263 else if (*s == '$' && s[1] &&
93a17b20
LW		 1264 strchr("[#!%*<>()-=",s[1])) {
1265 if (/*{*/ strchr("])} =",s[2]))
79072805
LW		 1266 weight -= 10;
1267 else
1268 weight -= 1;
1269 }
1270 break;
1271 case '\\':
1272 un_char = 254;
1273 if (s[1]) {
93a17b20 1274 if (strchr("wds]",s[1]))
79072805
LW		 1275 weight += 100;
1276 else if (seen['\''] || seen['"'])
1277 weight += 1;
93a17b20 1278 else if (strchr("rnftbxcav",s[1]))
79072805
LW		 1279 weight += 40;
1280 else if (isDIGIT(s[1])) {
1281 weight += 40;
1282 while (s[1] && isDIGIT(s[1]))
1283 s++;
1284 }
1285 }
1286 else
1287 weight += 100;
1288 break;
1289 case '-':
1290 if (s[1] == '\\')
1291 weight += 50;
93a17b20 1292 if (strchr("aA01! ",last_un_char))
79072805 1293 weight += 30;
93a17b20 1294 if (strchr("zZ79~",s[1]))
79072805 1295 weight += 30;
f27ffc4a
GS		 1296 if (last_un_char == 255 && (isDIGIT(s[1]) || s[1] == '$'))
1297 weight -= 5; /* cope with negative subscript */
79072805
LW		 1298 break;
1299 default:
93a17b20 1300 if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
79072805
LW		 1301 isALPHA(*s) && s[1] && isALPHA(s[1])) {
1302 char *d = tmpbuf;
1303 while (isALPHA(*s))
1304 *d++ = *s++;
1305 *d = '\0';
1306 if (keyword(tmpbuf, d - tmpbuf))
1307 weight -= 150;
1308 }
1309 if (un_char == last_un_char + 1)
1310 weight += 5;
1311 weight -= seen[un_char];
1312 break;
1313 }
1314 seen[un_char]++;
1315 }
1316 if (weight >= 0) /* probably a character class */
1317 return FALSE;
1318 }
1319
1320 return TRUE;
1321}
ffed7fef 1322
76e3520e 1323STATIC int
cea2e8a9 1324S_intuit_method(pTHX_ char *start, GV *gv)
a0d0e21e
LW		 1325{
1326 char *s = start + (*start == '$');
3280af22 1327 char tmpbuf[sizeof PL_tokenbuf];
a0d0e21e
LW		 1328 STRLEN len;
1329 GV* indirgv;
1330
1331 if (gv) {
b6c543e3 1332 CV *cv;
a0d0e21e
LW		 1333 if (GvIO(gv))
1334 return 0;
b6c543e3
IZ		 1335 if ((cv = GvCVu(gv))) {
1336 char *proto = SvPVX(cv);
1337 if (proto) {
1338 if (*proto == ';')
1339 proto++;
1340 if (*proto == '*')
1341 return 0;
1342 }
1343 } else
a0d0e21e
LW		 1344 gv = 0;
1345 }
8903cb82 1346 s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
a0d0e21e 1347 if (*start == '$') {
3280af22 1348 if (gv || PL_last_lop_op == OP_PRINT || isUPPER(*PL_tokenbuf))
a0d0e21e
LW		 1349 return 0;
1350 s = skipspace(s);
3280af22
NIS		 1351 PL_bufptr = start;
1352 PL_expect = XREF;
a0d0e21e
LW		 1353 return *s == '(' ? FUNCMETH : METHOD;
1354 }
1355 if (!keyword(tmpbuf, len)) {
c3e0f903
GS		 1356 if (len > 2 && tmpbuf[len - 2] == ':' && tmpbuf[len - 1] == ':') {
1357 len -= 2;
1358 tmpbuf[len] = '\0';
1359 goto bare_package;
1360 }
1361 indirgv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
8ebc5c01 1362 if (indirgv && GvCVu(indirgv))
a0d0e21e
LW		 1363 return 0;
1364 /* filehandle or package name makes it a method */
89bfa8cd 1365 if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) {
a0d0e21e 1366 s = skipspace(s);
3280af22 1367 if ((PL_bufend - s) >= 2 && *s == '=' && *(s+1) == '>')
55497cff 1368 return 0; /* no assumptions -- "=>" quotes bearword */
c3e0f903 1369 bare_package:
3280af22 1370 PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0,
79cb57f6 1371 newSVpvn(tmpbuf,len));
3280af22
NIS		 1372 PL_nextval[PL_nexttoke].opval->op_private = OPpCONST_BARE;
1373 PL_expect = XTERM;
a0d0e21e 1374 force_next(WORD);
3280af22 1375 PL_bufptr = s;
a0d0e21e
LW		 1376 return *s == '(' ? FUNCMETH : METHOD;
1377 }
1378 }
1379 return 0;
1380}
1381
76e3520e 1382STATIC char*
cea2e8a9 1383S_incl_perldb(pTHX)
a0d0e21e 1384{
3280af22 1385 if (PL_perldb) {
76e3520e 1386 char *pdb = PerlEnv_getenv("PERL5DB");
a0d0e21e
LW		 1387
1388 if (pdb)
1389 return pdb;
61bb5906 1390 SETERRNO(0,SS$_NORMAL);
a0d0e21e
LW		 1391 return "BEGIN { require 'perl5db.pl' }";
1392 }
1393 return "";
1394}
1395
1396
16d20bd9
AD		 1397/* Encoded script support. filter_add() effectively inserts a
1398 * 'pre-processing' function into the current source input stream.
1399 * Note that the filter function only applies to the current source file
1400 * (e.g., it will not affect files 'require'd or 'use'd by this one).
1401 *
1402 * The datasv parameter (which may be NULL) can be used to pass
1403 * private data to this instance of the filter. The filter function
1404 * can recover the SV using the FILTER_DATA macro and use it to
1405 * store private buffers and state information.
1406 *
1407 * The supplied datasv parameter is upgraded to a PVIO type
1408 * and the IoDIRP field is used to store the function pointer.
1409 * Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
1410 * private use must be set using malloc'd pointers.
1411 */
16d20bd9
AD		 1412
1413SV *
864dbfa3 1414Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
16d20bd9
AD		 1415{
1416 if (!funcp){ /* temporary handy debugging hack to be deleted */
80252599 1417 PL_filter_debug = atoi((char*)datasv);
16d20bd9
AD		 1418 return NULL;
1419 }
3280af22
NIS		 1420 if (!PL_rsfp_filters)
1421 PL_rsfp_filters = newAV();
16d20bd9 1422 if (!datasv)
8c52afec 1423 datasv = NEWSV(255,0);
16d20bd9 1424 if (!SvUPGRADE(datasv, SVt_PVIO))
cea2e8a9 1425 Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO");
16d20bd9 1426 IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
80252599 1427 if (PL_filter_debug) {
2d8e6c8d 1428 STRLEN n_a;
cea2e8a9 1429 Perl_warn(aTHX_ "filter_add func %p (%s)", funcp, SvPV(datasv, n_a));
2d8e6c8d 1430 }
3280af22
NIS		 1431 av_unshift(PL_rsfp_filters, 1);
1432 av_store(PL_rsfp_filters, 0, datasv) ;
16d20bd9
AD		 1433 return(datasv);
1434}
1435
1436
1437/* Delete most recently added instance of this filter function. */
a0d0e21e 1438void
864dbfa3 1439Perl_filter_del(pTHX_ filter_t funcp)
16d20bd9 1440{
80252599 1441 if (PL_filter_debug)
cea2e8a9 1442 Perl_warn(aTHX_ "filter_del func %p", funcp);
3280af22 1443 if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
16d20bd9
AD		 1444 return;
1445 /* if filter is on top of stack (usual case) just pop it off */
677ca527 1446 if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){
a6c40364 1447 IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL;
3280af22 1448 sv_free(av_pop(PL_rsfp_filters));
e50aee73 1449
16d20bd9
AD		 1450 return;
1451 }
1452 /* we need to search for the correct entry and clear it */
cea2e8a9 1453 Perl_die(aTHX_ "filter_del can only delete in reverse order (currently)");
16d20bd9
AD		 1454}
1455
1456
1457/* Invoke the n'th filter function for the current rsfp. */
1458I32
864dbfa3 1459Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
8ac85365
NIS		 1460
1461
1462 /* 0 = read one text line */
a0d0e21e 1463{
16d20bd9
AD		 1464 filter_t funcp;
1465 SV *datasv = NULL;
e50aee73 1466
3280af22 1467 if (!PL_rsfp_filters)
16d20bd9 1468 return -1;
3280af22 1469 if (idx > AvFILLp(PL_rsfp_filters)){ /* Any more filters? */
16d20bd9
AD		 1470 /* Provide a default input filter to make life easy. */
1471 /* Note that we append to the line. This is handy. */
80252599 1472 if (PL_filter_debug)
cea2e8a9 1473 Perl_warn(aTHX_ "filter_read %d: from rsfp\n", idx);
16d20bd9
AD		 1474 if (maxlen) {
1475 /* Want a block */
1476 int len ;
1477 int old_len = SvCUR(buf_sv) ;
1478
1479 /* ensure buf_sv is large enough */
1480 SvGROW(buf_sv, old_len + maxlen) ;
3280af22
NIS		 1481 if ((len = PerlIO_read(PL_rsfp, SvPVX(buf_sv) + old_len, maxlen)) <= 0){
1482 if (PerlIO_error(PL_rsfp))
37120919
AD		 1483 return -1; /* error */
1484 else
1485 return 0 ; /* end of file */
1486 }
16d20bd9
AD		 1487 SvCUR_set(buf_sv, old_len + len) ;
1488 } else {
1489 /* Want a line */
3280af22
NIS		 1490 if (sv_gets(buf_sv, PL_rsfp, SvCUR(buf_sv)) == NULL) {
1491 if (PerlIO_error(PL_rsfp))
37120919
AD		 1492 return -1; /* error */
1493 else
1494 return 0 ; /* end of file */
1495 }
16d20bd9
AD		 1496 }
1497 return SvCUR(buf_sv);
1498 }
1499 /* Skip this filter slot if filter has been deleted */
3280af22 1500 if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef){
80252599 1501 if (PL_filter_debug)
cea2e8a9 1502 Perl_warn(aTHX_ "filter_read %d: skipped (filter deleted)\n", idx);
16d20bd9
AD		 1503 return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
1504 }
1505 /* Get function pointer hidden within datasv */
1506 funcp = (filter_t)IoDIRP(datasv);
80252599 1507 if (PL_filter_debug) {
2d8e6c8d 1508 STRLEN n_a;
cea2e8a9 1509 Perl_warn(aTHX_ "filter_read %d: via function %p (%s)\n",
2d8e6c8d
GS		 1510 idx, funcp, SvPV(datasv,n_a));
1511 }
16d20bd9
AD		 1512 /* Call function. The function is expected to */
1513 /* call "FILTER_READ(idx+1, buf_sv)" first. */
37120919 1514 /* Return: <0:error, =0:eof, >0:not eof */
cea2e8a9 1515 return (*funcp)(aTHX_ idx, buf_sv, maxlen);
16d20bd9
AD		 1516}
1517
76e3520e 1518STATIC char *
cea2e8a9 1519S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append)
16d20bd9 1520{
a868473f 1521#ifdef WIN32FILTER
3280af22 1522 if (!PL_rsfp_filters) {
a868473f
NIS		 1523 filter_add(win32_textfilter,NULL);
1524 }
1525#endif
3280af22 1526 if (PL_rsfp_filters) {
16d20bd9 1527
55497cff 1528 if (!append)
1529 SvCUR_set(sv, 0); /* start with empty line */
16d20bd9
AD		 1530 if (FILTER_READ(0, sv, 0) > 0)
1531 return ( SvPVX(sv) ) ;
1532 else
1533 return Nullch ;
1534 }
9d116dd7 1535 else
fd049845 1536 return (sv_gets(sv, fp, append));
a0d0e21e
LW		 1537}
1538
1539
748a9306
LW		 1540#ifdef DEBUGGING
1541 static char* exp_name[] =
a0d0e21e 1542 { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "TERMBLOCK" };
748a9306 1543#endif
463ee0b2 1544
02aa26ce
NT		 1545/*
1546 yylex
1547
1548 Works out what to call the token just pulled out of the input
1549 stream. The yacc parser takes care of taking the ops we return and
1550 stitching them into a tree.
1551
1552 Returns:
1553 PRIVATEREF
1554
1555 Structure:
1556 if read an identifier
1557 if we're in a my declaration
1558 croak if they tried to say my($foo::bar)
1559 build the ops for a my() declaration
1560 if it's an access to a my() variable
1561 are we in a sort block?
1562 croak if my($a); $a <=> $b
1563 build ops for access to a my() variable
1564 if in a dq string, and they've said @foo and we can't find @foo
1565 croak
1566 build ops for a bareword
1567 if we already built the token before, use it.
1568*/
1569
864dbfa3
GS		 1570int
1571#ifdef USE_PURE_BISON
cea2e8a9 1572Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp)
864dbfa3 1573#else
cea2e8a9 1574Perl_yylex(pTHX)
864dbfa3 1575#endif
378cc40b 1576{
11343788 1577 dTHR;
79072805 1578 register char *s;
378cc40b 1579 register char *d;
79072805 1580 register I32 tmp;
463ee0b2 1581 STRLEN len;
161b471a
NIS		 1582 GV *gv = Nullgv;
1583 GV **gvp = 0;
a687059c 1584
a1a0e61e
TD		 1585#ifdef USE_PURE_BISON
1586 yylval_pointer = lvalp;
1587 yychar_pointer = lcharp;
1588#endif
1589
02aa26ce 1590 /* check if there's an identifier for us to look at */
3280af22 1591 if (PL_pending_ident) {
02aa26ce 1592 /* pit holds the identifier we read and pending_ident is reset */
3280af22
NIS		 1593 char pit = PL_pending_ident;
1594 PL_pending_ident = 0;
bbce6d69 1595
02aa26ce
NT		 1596 /* if we're in a my(), we can't allow dynamics here.
1597 $foo'bar has already been turned into $foo::bar, so
1598 just check for colons.
1599
1600 if it's a legal name, the OP is a PADANY.
1601 */
3280af22
NIS		 1602 if (PL_in_my) {
1603 if (strchr(PL_tokenbuf,':'))
cea2e8a9 1604 yyerror(Perl_form(aTHX_ PL_no_myglob,PL_tokenbuf));
02aa26ce 1605
bbce6d69 1606 yylval.opval = newOP(OP_PADANY, 0);
3280af22 1607 yylval.opval->op_targ = pad_allocmy(PL_tokenbuf);
bbce6d69 1608 return PRIVATEREF;
1609 }
1610
02aa26ce
NT		 1611 /*
1612 build the ops for accesses to a my() variable.
1613
1614 Deny my($a) or my($b) in a sort block, *if* $a or $b is
1615 then used in a comparison. This catches most, but not
1616 all cases. For instance, it catches
1617 sort { my($a); $a <=> $b }
1618 but not
1619 sort { my($a); $a < $b ? -1 : $a == $b ? 0 : 1; }
1620 (although why you'd do that is anyone's guess).
1621 */
1622
3280af22 1623 if (!strchr(PL_tokenbuf,':')) {
a863c7d1 1624#ifdef USE_THREADS
54b9620d 1625 /* Check for single character per-thread SVs */
3280af22
NIS		 1626 if (PL_tokenbuf[0] == '$' && PL_tokenbuf[2] == '\0'
1627 && !isALPHA(PL_tokenbuf[1]) /* Rule out obvious non-threadsvs */
1628 && (tmp = find_threadsv(&PL_tokenbuf[1])) != NOT_IN_PAD)
554b3eca 1629 {
2faa37cc 1630 yylval.opval = newOP(OP_THREADSV, 0);
a863c7d1
MB		 1631 yylval.opval->op_targ = tmp;
1632 return PRIVATEREF;
1633 }
1634#endif /* USE_THREADS */
3280af22 1635 if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
02aa26ce 1636 /* if it's a sort block and they're naming $a or $b */
3280af22
NIS		 1637 if (PL_last_lop_op == OP_SORT &&
1638 PL_tokenbuf[0] == '$' &&
1639 (PL_tokenbuf[1] == 'a' || PL_tokenbuf[1] == 'b')
1640 && !PL_tokenbuf[2])
bbce6d69 1641 {
3280af22
NIS		 1642 for (d = PL_in_eval ? PL_oldoldbufptr : PL_linestart;
1643 d < PL_bufend && *d != '\n';
a863c7d1
MB		 1644 d++)
1645 {
1646 if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
cea2e8a9 1647 Perl_croak(aTHX_ "Can't use \"my %s\" in sort comparison",
3280af22 1648 PL_tokenbuf);
a863c7d1 1649 }
bbce6d69 1650 }
1651 }
bbce6d69 1652
a863c7d1
MB		 1653 yylval.opval = newOP(OP_PADANY, 0);
1654 yylval.opval->op_targ = tmp;
1655 return PRIVATEREF;
1656 }
bbce6d69 1657 }
1658
02aa26ce
NT		 1659 /*
1660 Whine if they've said @foo in a doublequoted string,
1661 and @foo isn't a variable we can find in the symbol
1662 table.
1663 */
3280af22
NIS		 1664 if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
1665 GV *gv = gv_fetchpv(PL_tokenbuf+1, FALSE, SVt_PVAV);
1666 if (!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
cea2e8a9 1667 yyerror(Perl_form(aTHX_ "In string, %s now must be written as \\%s",
3280af22 1668 PL_tokenbuf, PL_tokenbuf));
bbce6d69 1669 }
1670
02aa26ce 1671 /* build ops for a bareword */
3280af22 1672 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0));
bbce6d69 1673 yylval.opval->op_private = OPpCONST_ENTERED;
3280af22
NIS		 1674 gv_fetchpv(PL_tokenbuf+1, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
1675 ((PL_tokenbuf[0] == '$') ? SVt_PV
1676 : (PL_tokenbuf[0] == '@') ? SVt_PVAV
bbce6d69 1677 : SVt_PVHV));
1678 return WORD;
1679 }
1680
02aa26ce
NT		 1681 /* no identifier pending identification */
1682
3280af22 1683 switch (PL_lex_state) {
79072805
LW		 1684#ifdef COMMENTARY
1685 case LEX_NORMAL: /* Some compilers will produce faster */
1686 case LEX_INTERPNORMAL: /* code if we comment these out. */
1687 break;
1688#endif
1689
02aa26ce 1690 /* when we're already built the next token, just pull it out the queue */
79072805 1691 case LEX_KNOWNEXT:
3280af22
NIS		 1692 PL_nexttoke--;
1693 yylval = PL_nextval[PL_nexttoke];
1694 if (!PL_nexttoke) {
1695 PL_lex_state = PL_lex_defer;
1696 PL_expect = PL_lex_expect;
1697 PL_lex_defer = LEX_NORMAL;
463ee0b2 1698 }
3280af22 1699 return(PL_nexttype[PL_nexttoke]);
79072805 1700
02aa26ce 1701 /* interpolated case modifiers like \L \U, including \Q and \E.
3280af22 1702 when we get here, PL_bufptr is at the \
02aa26ce 1703 */
79072805
LW		 1704 case LEX_INTERPCASEMOD:
1705#ifdef DEBUGGING
3280af22 1706 if (PL_bufptr != PL_bufend && *PL_bufptr != '\\')
cea2e8a9 1707 Perl_croak(aTHX_ "panic: INTERPCASEMOD");
79072805 1708#endif
02aa26ce 1709 /* handle \E or end of string */
3280af22 1710 if (PL_bufptr == PL_bufend || PL_bufptr[1] == 'E') {
a0d0e21e 1711 char oldmod;
02aa26ce
NT		 1712
1713 /* if at a \E */
3280af22
NIS		 1714 if (PL_lex_casemods) {
1715 oldmod = PL_lex_casestack[--PL_lex_casemods];
1716 PL_lex_casestack[PL_lex_casemods] = '\0';
02aa26ce 1717
3280af22
NIS		 1718 if (PL_bufptr != PL_bufend && strchr("LUQ", oldmod)) {
1719 PL_bufptr += 2;
1720 PL_lex_state = LEX_INTERPCONCAT;
a0d0e21e 1721 }
79072805
LW		 1722 return ')';
1723 }
3280af22
NIS		 1724 if (PL_bufptr != PL_bufend)
1725 PL_bufptr += 2;
1726 PL_lex_state = LEX_INTERPCONCAT;
cea2e8a9 1727 return yylex();
79072805
LW		 1728 }
1729 else {
3280af22 1730 s = PL_bufptr + 1;
79072805
LW		 1731 if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
1732 tmp = *s, *s = s[2], s[2] = tmp; /* misordered... */
a0d0e21e 1733 if (strchr("LU", *s) &&
3280af22 1734 (strchr(PL_lex_casestack, 'L') || strchr(PL_lex_casestack, 'U')))
a0d0e21e 1735 {
3280af22 1736 PL_lex_casestack[--PL_lex_casemods] = '\0';
a0d0e21e
LW		 1737 return ')';
1738 }
3280af22
NIS		 1739 if (PL_lex_casemods > 10) {
1740 char* newlb = Renew(PL_lex_casestack, PL_lex_casemods + 2, char);
1741 if (newlb != PL_lex_casestack) {
a0d0e21e 1742 SAVEFREEPV(newlb);
3280af22 1743 PL_lex_casestack = newlb;
a0d0e21e
LW		 1744 }
1745 }
3280af22
NIS		 1746 PL_lex_casestack[PL_lex_casemods++] = *s;
1747 PL_lex_casestack[PL_lex_casemods] = '\0';
1748 PL_lex_state = LEX_INTERPCONCAT;
1749 PL_nextval[PL_nexttoke].ival = 0;
79072805
LW		 1750 force_next('(');
1751 if (*s == 'l')
3280af22 1752 PL_nextval[PL_nexttoke].ival = OP_LCFIRST;
79072805 1753 else if (*s == 'u')
3280af22 1754 PL_nextval[PL_nexttoke].ival = OP_UCFIRST;
79072805 1755 else if (*s == 'L')
3280af22 1756 PL_nextval[PL_nexttoke].ival = OP_LC;
79072805 1757 else if (*s == 'U')
3280af22 1758 PL_nextval[PL_nexttoke].ival = OP_UC;
a0d0e21e 1759 else if (*s == 'Q')
3280af22 1760 PL_nextval[PL_nexttoke].ival = OP_QUOTEMETA;
79072805 1761 else
cea2e8a9 1762 Perl_croak(aTHX_ "panic: yylex");
3280af22 1763 PL_bufptr = s + 1;
79072805 1764 force_next(FUNC);
3280af22
NIS		 1765 if (PL_lex_starts) {
1766 s = PL_bufptr;
1767 PL_lex_starts = 0;
79072805
LW		 1768 Aop(OP_CONCAT);
1769 }
1770 else
cea2e8a9 1771 return yylex();
79072805
LW		 1772 }
1773
55497cff 1774 case LEX_INTERPPUSH:
1775 return sublex_push();
1776
79072805 1777 case LEX_INTERPSTART:
3280af22 1778 if (PL_bufptr == PL_bufend)
79072805 1779 return sublex_done();
3280af22
NIS		 1780 PL_expect = XTERM;
1781 PL_lex_dojoin = (*PL_bufptr == '@');
1782 PL_lex_state = LEX_INTERPNORMAL;
1783 if (PL_lex_dojoin) {
1784 PL_nextval[PL_nexttoke].ival = 0;
79072805 1785 force_next(',');
554b3eca 1786#ifdef USE_THREADS
533c011a
NIS		 1787 PL_nextval[PL_nexttoke].opval = newOP(OP_THREADSV, 0);
1788 PL_nextval[PL_nexttoke].opval->op_targ = find_threadsv("\"");
554b3eca
MB		 1789 force_next(PRIVATEREF);
1790#else
a0d0e21e 1791 force_ident("\"", '$');
554b3eca 1792#endif /* USE_THREADS */
3280af22 1793 PL_nextval[PL_nexttoke].ival = 0;
79072805 1794 force_next('$');
3280af22 1795 PL_nextval[PL_nexttoke].ival = 0;
79072805 1796 force_next('(');
3280af22 1797 PL_nextval[PL_nexttoke].ival = OP_JOIN; /* emulate join($", ...) */
79072805
LW		 1798 force_next(FUNC);
1799 }
3280af22
NIS		 1800 if (PL_lex_starts++) {
1801 s = PL_bufptr;
79072805
LW		 1802 Aop(OP_CONCAT);
1803 }
cea2e8a9 1804 return yylex();
79072805
LW		 1805
1806 case LEX_INTERPENDMAYBE:
3280af22
NIS		 1807 if (intuit_more(PL_bufptr)) {
1808 PL_lex_state = LEX_INTERPNORMAL; /* false alarm, more expr */
79072805
LW		 1809 break;
1810 }
1811 /* FALL THROUGH */
1812
1813 case LEX_INTERPEND:
3280af22
NIS		 1814 if (PL_lex_dojoin) {
1815 PL_lex_dojoin = FALSE;
1816 PL_lex_state = LEX_INTERPCONCAT;
79072805
LW		 1817 return ')';
1818 }
43a16006 1819 if (PL_lex_inwhat == OP_SUBST && PL_linestr == PL_lex_repl
25da4f38 1820 && SvEVALED(PL_lex_repl))
43a16006 1821 {
e9fa98b2 1822 if (PL_bufptr != PL_bufend)
cea2e8a9 1823 Perl_croak(aTHX_ "Bad evalled substitution pattern");
e9fa98b2
HS		 1824 PL_lex_repl = Nullsv;
1825 }
79072805
LW		 1826 /* FALLTHROUGH */
1827 case LEX_INTERPCONCAT:
1828#ifdef DEBUGGING
3280af22 1829 if (PL_lex_brackets)
cea2e8a9 1830 Perl_croak(aTHX_ "panic: INTERPCONCAT");
79072805 1831#endif
3280af22 1832 if (PL_bufptr == PL_bufend)
79072805
LW		 1833 return sublex_done();
1834
3280af22
NIS		 1835 if (SvIVX(PL_linestr) == '\'') {
1836 SV *sv = newSVsv(PL_linestr);
1837 if (!PL_lex_inpat)
76e3520e 1838 sv = tokeq(sv);
3280af22 1839 else if ( PL_hints & HINT_NEW_RE )
b3ac6de7 1840 sv = new_constant(NULL, 0, "qr", sv, sv, "q");
79072805 1841 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
3280af22 1842 s = PL_bufend;
79072805
LW		 1843 }
1844 else {
3280af22 1845 s = scan_const(PL_bufptr);
79072805 1846 if (*s == '\\')
3280af22 1847 PL_lex_state = LEX_INTERPCASEMOD;
79072805 1848 else
3280af22 1849 PL_lex_state = LEX_INTERPSTART;
79072805
LW		 1850 }
1851
3280af22
NIS		 1852 if (s != PL_bufptr) {
1853 PL_nextval[PL_nexttoke] = yylval;
1854 PL_expect = XTERM;
79072805 1855 force_next(THING);
3280af22 1856 if (PL_lex_starts++)
79072805
LW		 1857 Aop(OP_CONCAT);
1858 else {
3280af22 1859 PL_bufptr = s;
cea2e8a9 1860 return yylex();
79072805
LW		 1861 }
1862 }
1863
cea2e8a9 1864 return yylex();
a0d0e21e 1865 case LEX_FORMLINE:
3280af22
NIS		 1866 PL_lex_state = LEX_NORMAL;
1867 s = scan_formline(PL_bufptr);
1868 if (!PL_lex_formbrack)
a0d0e21e
LW		 1869 goto rightbracket;
1870 OPERATOR(';');
79072805
LW		 1871 }
1872
3280af22
NIS		 1873 s = PL_bufptr;
1874 PL_oldoldbufptr = PL_oldbufptr;
1875 PL_oldbufptr = s;
79072805 1876 DEBUG_p( {
3280af22 1877 PerlIO_printf(PerlIO_stderr(), "### Tokener expecting %s at %s\n", exp_name[PL_expect], s);
79072805 1878 } )
463ee0b2
LW		 1879
1880 retry:
378cc40b
LW		 1881 switch (*s) {
1882 default:
834a4ddd
LW		 1883 if (isIDFIRST_lazy(s))
1884 goto keylookup;
cea2e8a9 1885 Perl_croak(aTHX_ "Unrecognized character \\x%02X", *s & 255);
e929a76b
LW		 1886 case 4:
1887 case 26:
1888 goto fake_eof; /* emulate EOF on ^D or ^Z */
378cc40b 1889 case 0:
3280af22
NIS		 1890 if (!PL_rsfp) {
1891 PL_last_uni = 0;
1892 PL_last_lop = 0;
1893 if (PL_lex_brackets)
d98d5fff 1894 yyerror("Missing right curly or square bracket");
79072805 1895 TOKEN(0);
463ee0b2 1896 }
3280af22 1897 if (s++ < PL_bufend)
a687059c 1898 goto retry; /* ignore stray nulls */
3280af22
NIS		 1899 PL_last_uni = 0;
1900 PL_last_lop = 0;
1901 if (!PL_in_eval && !PL_preambled) {
1902 PL_preambled = TRUE;
1903 sv_setpv(PL_linestr,incl_perldb());
1904 if (SvCUR(PL_linestr))
1905 sv_catpv(PL_linestr,";");
1906 if (PL_preambleav){
1907 while(AvFILLp(PL_preambleav) >= 0) {
1908 SV *tmpsv = av_shift(PL_preambleav);
1909 sv_catsv(PL_linestr, tmpsv);
1910 sv_catpv(PL_linestr, ";");
91b7def8 1911 sv_free(tmpsv);
1912 }
3280af22
NIS		 1913 sv_free((SV*)PL_preambleav);
1914 PL_preambleav = NULL;
91b7def8 1915 }
3280af22
NIS		 1916 if (PL_minus_n || PL_minus_p) {
1917 sv_catpv(PL_linestr, "LINE: while (<>) {");
1918 if (PL_minus_l)
1919 sv_catpv(PL_linestr,"chomp;");
1920 if (PL_minus_a) {
8fd239a7
CS		 1921 GV* gv = gv_fetchpv("::F", TRUE, SVt_PVAV);
1922 if (gv)
1923 GvIMPORTED_AV_on(gv);
3280af22
NIS		 1924 if (PL_minus_F) {
1925 if (strchr("/'\"", *PL_splitstr)
1926 && strchr(PL_splitstr + 1, *PL_splitstr))
cea2e8a9 1927 Perl_sv_catpvf(aTHX_ PL_linestr, "@F=split(%s);", PL_splitstr);
54310121 1928 else {
1929 char delim;
1930 s = "'~#\200\1'"; /* surely one char is unused...*/
3280af22 1931 while (s[1] && strchr(PL_splitstr, *s)) s++;
54310121 1932 delim = *s;
cea2e8a9 1933 Perl_sv_catpvf(aTHX_ PL_linestr, "@F=split(%s%c",
46fc3d4c 1934 "q" + (delim == '\''), delim);
3280af22 1935 for (s = PL_splitstr; *s; s++) {
54310121 1936 if (*s == '\\')
3280af22
NIS		 1937 sv_catpvn(PL_linestr, "\\", 1);
1938 sv_catpvn(PL_linestr, s, 1);
54310121 1939 }
cea2e8a9 1940 Perl_sv_catpvf(aTHX_ PL_linestr, "%c);", delim);
54310121 1941 }
2304df62
AD		 1942 }
1943 else
3280af22 1944 sv_catpv(PL_linestr,"@F=split(' ');");
2304df62 1945 }
79072805 1946 }
3280af22
NIS		 1947 sv_catpv(PL_linestr, "\n");
1948 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
1949 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
1950 if (PERLDB_LINE && PL_curstash != PL_debstash) {
a0d0e21e
LW		 1951 SV *sv = NEWSV(85,0);
1952
1953 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 1954 sv_setsv(sv,PL_linestr);
1955 av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
a0d0e21e 1956 }
79072805 1957 goto retry;
a687059c 1958 }
e929a76b 1959 do {
3280af22 1960 if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
e929a76b 1961 fake_eof:
3280af22
NIS		 1962 if (PL_rsfp) {
1963 if (PL_preprocess && !PL_in_eval)
1964 (void)PerlProc_pclose(PL_rsfp);
1965 else if ((PerlIO *)PL_rsfp == PerlIO_stdin())
1966 PerlIO_clearerr(PL_rsfp);
395c3793 1967 else
3280af22
NIS		 1968 (void)PerlIO_close(PL_rsfp);
1969 PL_rsfp = Nullfp;
4a9ae47a 1970 PL_doextract = FALSE;
395c3793 1971 }
3280af22
NIS		 1972 if (!PL_in_eval && (PL_minus_n || PL_minus_p)) {
1973 sv_setpv(PL_linestr,PL_minus_p ? ";}continue{print" : "");
1974 sv_catpv(PL_linestr,";}");
1975 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
1976 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
1977 PL_minus_n = PL_minus_p = 0;
e929a76b
LW		 1978 goto retry;
1979 }
3280af22
NIS		 1980 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
1981 sv_setpv(PL_linestr,"");
79072805 1982 TOKEN(';'); /* not infinite loop because rsfp is NULL now */
378cc40b 1983 }
3280af22 1984 if (PL_doextract) {
a0d0e21e 1985 if (*s == '#' && s[1] == '!' && instr(s,"perl"))
3280af22 1986 PL_doextract = FALSE;
a0d0e21e
LW		 1987
1988 /* Incest with pod. */
1989 if (*s == '=' && strnEQ(s, "=cut", 4)) {
3280af22
NIS		 1990 sv_setpv(PL_linestr, "");
1991 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
1992 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
1993 PL_doextract = FALSE;
a0d0e21e
LW		 1994 }
1995 }
463ee0b2 1996 incline(s);
3280af22
NIS		 1997 } while (PL_doextract);
1998 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
1999 if (PERLDB_LINE && PL_curstash != PL_debstash) {
79072805 2000 SV *sv = NEWSV(85,0);
a687059c 2001
93a17b20 2002 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 2003 sv_setsv(sv,PL_linestr);
2004 av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
a687059c 2005 }
3280af22
NIS		 2006 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
2007 if (PL_curcop->cop_line == 1) {
2008 while (s < PL_bufend && isSPACE(*s))
79072805 2009 s++;
a0d0e21e 2010 if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
79072805 2011 s++;
44a8e56a 2012 d = Nullch;
3280af22 2013 if (!PL_in_eval) {
44a8e56a 2014 if (*s == '#' && *(s+1) == '!')
2015 d = s + 2;
2016#ifdef ALTERNATE_SHEBANG
2017 else {
2018 static char as[] = ALTERNATE_SHEBANG;
2019 if (*s == as[0] && strnEQ(s, as, sizeof(as) - 1))
2020 d = s + (sizeof(as) - 1);
2021 }
2022#endif /* ALTERNATE_SHEBANG */
2023 }
2024 if (d) {
b8378b72 2025 char *ipath;
774d564b 2026 char *ipathend;
b8378b72 2027
774d564b 2028 while (isSPACE(*d))
b8378b72
CS		 2029 d++;
2030 ipath = d;
774d564b 2031 while (*d && !isSPACE(*d))
2032 d++;
2033 ipathend = d;
2034
2035#ifdef ARG_ZERO_IS_SCRIPT
2036 if (ipathend > ipath) {
2037 /*
2038 * HP-UX (at least) sets argv[0] to the script name,
2039 * which makes $^X incorrect. And Digital UNIX and Linux,
2040 * at least, set argv[0] to the basename of the Perl
2041 * interpreter. So, having found "#!", we'll set it right.
2042 */
2043 SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
2044 assert(SvPOK(x) || SvGMAGICAL(x));
6b88bc9c 2045 if (sv_eq(x, GvSV(PL_curcop->cop_filegv))) {
774d564b 2046 sv_setpvn(x, ipath, ipathend - ipath);
9607fc9c 2047 SvSETMAGIC(x);
2048 }
774d564b 2049 TAINT_NOT; /* $^X is always tainted, but that's OK */
8ebc5c01 2050 }
774d564b 2051#endif /* ARG_ZERO_IS_SCRIPT */
b8378b72
CS		 2052
2053 /*
2054 * Look for options.
2055 */
748a9306
LW		 2056 d = instr(s,"perl -");
2057 if (!d)
2058 d = instr(s,"perl");
44a8e56a 2059#ifdef ALTERNATE_SHEBANG
2060 /*
2061 * If the ALTERNATE_SHEBANG on this system starts with a
2062 * character that can be part of a Perl expression, then if
2063 * we see it but not "perl", we're probably looking at the
2064 * start of Perl code, not a request to hand off to some
2065 * other interpreter. Similarly, if "perl" is there, but
2066 * not in the first 'word' of the line, we assume the line
2067 * contains the start of the Perl program.
44a8e56a 2068 */
2069 if (d && *s != '#') {
774d564b 2070 char *c = ipath;
44a8e56a 2071 while (*c && !strchr("; \t\r\n\f\v#", *c))
2072 c++;
2073 if (c < d)
2074 d = Nullch; /* "perl" not in first word; ignore */
2075 else
2076 *s = '#'; /* Don't try to parse shebang line */
2077 }
774d564b 2078#endif /* ALTERNATE_SHEBANG */
748a9306 2079 if (!d &&
44a8e56a 2080 *s == '#' &&
774d564b 2081 ipathend > ipath &&
3280af22 2082 !PL_minus_c &&
748a9306 2083 !instr(s,"indir") &&
3280af22 2084 instr(PL_origargv[0],"perl"))
748a9306 2085 {
9f68db38 2086 char **newargv;
9f68db38 2087
774d564b 2088 *ipathend = '\0';
2089 s = ipathend + 1;
3280af22 2090 while (s < PL_bufend && isSPACE(*s))
9f68db38 2091 s++;
3280af22
NIS		 2092 if (s < PL_bufend) {
2093 Newz(899,newargv,PL_origargc+3,char*);
9f68db38 2094 newargv[1] = s;
3280af22 2095 while (s < PL_bufend && !isSPACE(*s))
9f68db38
LW		 2096 s++;
2097 *s = '\0';
3280af22 2098 Copy(PL_origargv+1, newargv+2, PL_origargc+1, char*);
9f68db38
LW		 2099 }
2100 else
3280af22 2101 newargv = PL_origargv;
774d564b 2102 newargv[0] = ipath;
80252599 2103 PerlProc_execv(ipath, newargv);
cea2e8a9 2104 Perl_croak(aTHX_ "Can't exec %s", ipath);
9f68db38 2105 }
748a9306 2106 if (d) {
3280af22
NIS		 2107 U32 oldpdb = PL_perldb;
2108 bool oldn = PL_minus_n;
2109 bool oldp = PL_minus_p;
748a9306
LW		 2110
2111 while (*d && !isSPACE(*d)) d++;
89bfa8cd 2112 while (*d == ' ' || *d == '\t') d++;
748a9306
LW		 2113
2114 if (*d++ == '-') {
8cc95fdb 2115 do {
2116 if (*d == 'M' || *d == 'm') {
2117 char *m = d;
2118 while (*d && !isSPACE(*d)) d++;
cea2e8a9 2119 Perl_croak(aTHX_ "Too late for \"-%.*s\" option",
8cc95fdb 2120 (int)(d - m), m);
2121 }
2122 d = moreswitches(d);
2123 } while (d);
84902520 2124 if (PERLDB_LINE && !oldpdb ||
3280af22 2125 ( PL_minus_n || PL_minus_p ) && !(oldn || oldp) )
b084f20b 2126 /* if we have already added "LINE: while (<>) {",
2127 we must not do it again */
748a9306 2128 {
3280af22
NIS		 2129 sv_setpv(PL_linestr, "");
2130 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
2131 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
2132 PL_preambled = FALSE;
84902520 2133 if (PERLDB_LINE)
3280af22 2134 (void)gv_fetchfile(PL_origfilename);
748a9306
LW		 2135 goto retry;
2136 }
a0d0e21e 2137 }
79072805 2138 }
9f68db38 2139 }
79072805 2140 }
3280af22
NIS		 2141 if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
2142 PL_bufptr = s;
2143 PL_lex_state = LEX_FORMLINE;
cea2e8a9 2144 return yylex();
ae986130 2145 }
378cc40b 2146 goto retry;
4fdae800 2147 case '\r':
6a27c188 2148#ifdef PERL_STRICT_CR
cea2e8a9
GS		 2149 Perl_warn(aTHX_ "Illegal character \\%03o (carriage return)", '\r');
2150 Perl_croak(aTHX_
54310121 2151 "(Maybe you didn't strip carriage returns after a network transfer?)\n");
a868473f 2152#endif
4fdae800 2153 case ' ': case '\t': case '\f': case 013:
378cc40b
LW		 2154 s++;
2155 goto retry;
378cc40b 2156 case '#':
e929a76b 2157 case '\n':
3280af22
NIS		 2158 if (PL_lex_state != LEX_NORMAL || (PL_in_eval && !PL_rsfp)) {
2159 d = PL_bufend;
a687059c 2160 while (s < d && *s != '\n')
378cc40b 2161 s++;
0f85fab0 2162 if (s < d)
378cc40b 2163 s++;
463ee0b2 2164 incline(s);
3280af22
NIS		 2165 if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
2166 PL_bufptr = s;
2167 PL_lex_state = LEX_FORMLINE;
cea2e8a9 2168 return yylex();
a687059c 2169 }
378cc40b 2170 }
a687059c 2171 else {
378cc40b 2172 *s = '\0';
3280af22 2173 PL_bufend = s;
a687059c 2174 }
378cc40b
LW		 2175 goto retry;
2176 case '-':
79072805 2177 if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
378cc40b 2178 s++;
3280af22 2179 PL_bufptr = s;
748a9306
LW		 2180 tmp = *s++;
2181
3280af22 2182 while (s < PL_bufend && (*s == ' ' || *s == '\t'))
748a9306
LW		 2183 s++;
2184
2185 if (strnEQ(s,"=>",2)) {
3280af22 2186 s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
748a9306
LW		 2187 OPERATOR('-'); /* unary minus */
2188 }
3280af22
NIS		 2189 PL_last_uni = PL_oldbufptr;
2190 PL_last_lop_op = OP_FTEREAD; /* good enough */
748a9306 2191 switch (tmp) {
79072805
LW		 2192 case 'r': FTST(OP_FTEREAD);
2193 case 'w': FTST(OP_FTEWRITE);
2194 case 'x': FTST(OP_FTEEXEC);
2195 case 'o': FTST(OP_FTEOWNED);
2196 case 'R': FTST(OP_FTRREAD);
2197 case 'W': FTST(OP_FTRWRITE);
2198 case 'X': FTST(OP_FTREXEC);
2199 case 'O': FTST(OP_FTROWNED);
2200 case 'e': FTST(OP_FTIS);
2201 case 'z': FTST(OP_FTZERO);
2202 case 's': FTST(OP_FTSIZE);
2203 case 'f': FTST(OP_FTFILE);
2204 case 'd': FTST(OP_FTDIR);
2205 case 'l': FTST(OP_FTLINK);
2206 case 'p': FTST(OP_FTPIPE);
2207 case 'S': FTST(OP_FTSOCK);
2208 case 'u': FTST(OP_FTSUID);
2209 case 'g': FTST(OP_FTSGID);
2210 case 'k': FTST(OP_FTSVTX);
2211 case 'b': FTST(OP_FTBLK);
2212 case 'c': FTST(OP_FTCHR);
2213 case 't': FTST(OP_FTTTY);
2214 case 'T': FTST(OP_FTTEXT);
2215 case 'B': FTST(OP_FTBINARY);
85e6fe83
LW		 2216 case 'M': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTMTIME);
2217 case 'A': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTATIME);
2218 case 'C': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTCTIME);
378cc40b 2219 default:
cea2e8a9 2220 Perl_croak(aTHX_ "Unrecognized file test: -%c", (int)tmp);
378cc40b
LW		 2221 break;
2222 }
2223 }
a687059c
LW		 2224 tmp = *s++;
2225 if (*s == tmp) {
2226 s++;
3280af22 2227 if (PL_expect == XOPERATOR)
79072805
LW		 2228 TERM(POSTDEC);
2229 else
2230 OPERATOR(PREDEC);
2231 }
2232 else if (*s == '>') {
2233 s++;
2234 s = skipspace(s);
834a4ddd 2235 if (isIDFIRST_lazy(s)) {
a0d0e21e 2236 s = force_word(s,METHOD,FALSE,TRUE,FALSE);
463ee0b2 2237 TOKEN(ARROW);
79072805 2238 }
748a9306
LW		 2239 else if (*s == '$')
2240 OPERATOR(ARROW);
463ee0b2 2241 else
748a9306 2242 TERM(ARROW);
a687059c 2243 }
3280af22 2244 if (PL_expect == XOPERATOR)
79072805
LW		 2245 Aop(OP_SUBTRACT);
2246 else {
3280af22 2247 if (isSPACE(*s) || !isSPACE(*PL_bufptr))
2f3197b3 2248 check_uni();
79072805 2249 OPERATOR('-'); /* unary minus */
2f3197b3 2250 }
79072805 2251
378cc40b 2252 case '+':
a687059c
LW		 2253 tmp = *s++;
2254 if (*s == tmp) {
378cc40b 2255 s++;
3280af22 2256 if (PL_expect == XOPERATOR)
79072805
LW		 2257 TERM(POSTINC);
2258 else
2259 OPERATOR(PREINC);
378cc40b 2260 }
3280af22 2261 if (PL_expect == XOPERATOR)
79072805
LW		 2262 Aop(OP_ADD);
2263 else {
3280af22 2264 if (isSPACE(*s) || !isSPACE(*PL_bufptr))
2f3197b3 2265 check_uni();
a687059c 2266 OPERATOR('+');
2f3197b3 2267 }
a687059c 2268
378cc40b 2269 case '*':
3280af22
NIS		 2270 if (PL_expect != XOPERATOR) {
2271 s = scan_ident(s, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE);
2272 PL_expect = XOPERATOR;
2273 force_ident(PL_tokenbuf, '*');
2274 if (!*PL_tokenbuf)
a0d0e21e 2275 PREREF('*');
79072805 2276 TERM('*');
a687059c 2277 }
79072805
LW		 2278 s++;
2279 if (*s == '*') {
a687059c 2280 s++;
79072805 2281 PWop(OP_POW);
a687059c 2282 }
79072805
LW		 2283 Mop(OP_MULTIPLY);
2284
378cc40b 2285 case '%':
3280af22 2286 if (PL_expect == XOPERATOR) {
bbce6d69 2287 ++s;
2288 Mop(OP_MODULO);
a687059c 2289 }
3280af22
NIS		 2290 PL_tokenbuf[0] = '%';
2291 s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, TRUE);
2292 if (!PL_tokenbuf[1]) {
2293 if (s == PL_bufend)
bbce6d69 2294 yyerror("Final % should be \\% or %name");
2295 PREREF('%');
a687059c 2296 }
3280af22 2297 PL_pending_ident = '%';
bbce6d69 2298 TERM('%');
a687059c 2299
378cc40b 2300 case '^':
79072805 2301 s++;
a0d0e21e 2302 BOop(OP_BIT_XOR);
79072805 2303 case '[':
3280af22 2304 PL_lex_brackets++;
79072805 2305 /* FALL THROUGH */
378cc40b 2306 case '~':
378cc40b 2307 case ',':
378cc40b
LW		 2308 tmp = *s++;
2309 OPERATOR(tmp);
a0d0e21e
LW		 2310 case ':':
2311 if (s[1] == ':') {
2312 len = 0;
2313 goto just_a_word;
2314 }
2315 s++;
2316 OPERATOR(':');
8990e307
LW		 2317 case '(':
2318 s++;
3280af22
NIS		 2319 if (PL_last_lop == PL_oldoldbufptr || PL_last_uni == PL_oldoldbufptr)
2320 PL_oldbufptr = PL_oldoldbufptr; /* allow print(STDOUT 123) */
a0d0e21e 2321 else
3280af22 2322 PL_expect = XTERM;
a0d0e21e 2323 TOKEN('(');
378cc40b 2324 case ';':
3280af22
NIS		 2325 if (PL_curcop->cop_line < PL_copline)
2326 PL_copline = PL_curcop->cop_line;
378cc40b
LW		 2327 tmp = *s++;
2328 OPERATOR(tmp);
2329 case ')':
378cc40b 2330 tmp = *s++;
16d20bd9
AD		 2331 s = skipspace(s);
2332 if (*s == '{')
2333 PREBLOCK(tmp);
378cc40b 2334 TERM(tmp);
79072805
LW		 2335 case ']':
2336 s++;
3280af22 2337 if (PL_lex_brackets <= 0)
d98d5fff 2338 yyerror("Unmatched right square bracket");
463ee0b2 2339 else
3280af22
NIS		 2340 --PL_lex_brackets;
2341 if (PL_lex_state == LEX_INTERPNORMAL) {
2342 if (PL_lex_brackets == 0) {
a0d0e21e 2343 if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
3280af22 2344 PL_lex_state = LEX_INTERPEND;
79072805
LW		 2345 }
2346 }
4633a7c4 2347 TERM(']');
79072805
LW		 2348 case '{':
2349 leftbracket:
79072805 2350 s++;
3280af22
NIS		 2351 if (PL_lex_brackets > 100) {
2352 char* newlb = Renew(PL_lex_brackstack, PL_lex_brackets + 1, char);
2353 if (newlb != PL_lex_brackstack) {
8990e307 2354 SAVEFREEPV(newlb);
3280af22 2355 PL_lex_brackstack = newlb;
8990e307
LW		 2356 }
2357 }
3280af22 2358 switch (PL_expect) {
a0d0e21e 2359 case XTERM:
3280af22 2360 if (PL_lex_formbrack) {
a0d0e21e
LW		 2361 s--;
2362 PRETERMBLOCK(DO);
2363 }
3280af22
NIS		 2364 if (PL_oldoldbufptr == PL_last_lop)
2365 PL_lex_brackstack[PL_lex_brackets++] = XTERM;
a0d0e21e 2366 else
3280af22 2367 PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
79072805 2368 OPERATOR(HASHBRACK);
a0d0e21e 2369 case XOPERATOR:
3280af22 2370 while (s < PL_bufend && (*s == ' ' || *s == '\t'))
748a9306 2371 s++;
44a8e56a 2372 d = s;
3280af22
NIS		 2373 PL_tokenbuf[0] = '\0';
2374 if (d < PL_bufend && *d == '-') {
2375 PL_tokenbuf[0] = '-';
44a8e56a 2376 d++;
3280af22 2377 while (d < PL_bufend && (*d == ' ' || *d == '\t'))
44a8e56a 2378 d++;
2379 }
834a4ddd 2380 if (d < PL_bufend && isIDFIRST_lazy(d)) {
3280af22 2381 d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
8903cb82 2382 FALSE, &len);
3280af22 2383 while (d < PL_bufend && (*d == ' ' || *d == '\t'))
748a9306
LW		 2384 d++;
2385 if (*d == '}') {
3280af22 2386 char minus = (PL_tokenbuf[0] == '-');
44a8e56a 2387 s = force_word(s + minus, WORD, FALSE, TRUE, FALSE);
2388 if (minus)
2389 force_next('-');
748a9306
LW		 2390 }
2391 }
2392 /* FALL THROUGH */
2393 case XBLOCK:
3280af22
NIS		 2394 PL_lex_brackstack[PL_lex_brackets++] = XSTATE;
2395 PL_expect = XSTATE;
a0d0e21e
LW		 2396 break;
2397 case XTERMBLOCK:
3280af22
NIS		 2398 PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
2399 PL_expect = XSTATE;
a0d0e21e
LW		 2400 break;
2401 default: {
2402 char *t;
3280af22
NIS		 2403 if (PL_oldoldbufptr == PL_last_lop)
2404 PL_lex_brackstack[PL_lex_brackets++] = XTERM;
a0d0e21e 2405 else
3280af22 2406 PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
a0d0e21e 2407 s = skipspace(s);
09ecc4b6 2408 if (*s == '}')
a0d0e21e 2409 OPERATOR(HASHBRACK);
b8a4b1be
GS		 2410 /* This hack serves to disambiguate a pair of curlies
2411 * as being a block or an anon hash. Normally, expectation
2412 * determines that, but in cases where we're not in a
2413 * position to expect anything in particular (like inside
2414 * eval"") we have to resolve the ambiguity. This code
2415 * covers the case where the first term in the curlies is a
2416 * quoted string. Most other cases need to be explicitly
2417 * disambiguated by prepending a `+' before the opening
2418 * curly in order to force resolution as an anon hash.
2419 *
2420 * XXX should probably propagate the outer expectation
2421 * into eval"" to rely less on this hack, but that could
2422 * potentially break current behavior of eval"".
2423 * GSAR 97-07-21
2424 */
2425 t = s;
2426 if (*s == '\'' || *s == '"' || *s == '`') {
2427 /* common case: get past first string, handling escapes */
3280af22 2428 for (t++; t < PL_bufend && *t != *s;)
b8a4b1be
GS		 2429 if (*t++ == '\\' && (*t == '\\' || *t == *s))
2430 t++;
2431 t++;
a0d0e21e 2432 }
b8a4b1be 2433 else if (*s == 'q') {
3280af22 2434 if (++t < PL_bufend
b8a4b1be 2435 && (!isALNUM(*t)
3280af22 2436 || ((*t == 'q' || *t == 'x') && ++t < PL_bufend
b8a4b1be
GS		 2437 && !isALNUM(*t)))) {
2438 char *tmps;
2439 char open, close, term;
2440 I32 brackets = 1;
2441
3280af22 2442 while (t < PL_bufend && isSPACE(*t))
b8a4b1be
GS		 2443 t++;
2444 term = *t;
2445 open = term;
2446 if (term && (tmps = strchr("([{< )]}> )]}>",term)))
2447 term = tmps[5];
2448 close = term;
2449 if (open == close)
3280af22
NIS		 2450 for (t++; t < PL_bufend; t++) {
2451 if (*t == '\\' && t+1 < PL_bufend && open != '\\')
b8a4b1be 2452 t++;
6d07e5e9 2453 else if (*t == open)
b8a4b1be
GS		 2454 break;
2455 }
2456 else
3280af22
NIS		 2457 for (t++; t < PL_bufend; t++) {
2458 if (*t == '\\' && t+1 < PL_bufend)
b8a4b1be 2459 t++;
6d07e5e9 2460 else if (*t == close && --brackets <= 0)
b8a4b1be
GS		 2461 break;
2462 else if (*t == open)
2463 brackets++;
2464 }
2465 }
2466 t++;
a0d0e21e 2467 }
834a4ddd
LW		 2468 else if (isIDFIRST_lazy(s)) {
2469 for (t++; t < PL_bufend && isALNUM_lazy(t); t++) ;
a0d0e21e 2470 }
3280af22 2471 while (t < PL_bufend && isSPACE(*t))
a0d0e21e 2472 t++;
b8a4b1be
GS		 2473 /* if comma follows first term, call it an anon hash */
2474 /* XXX it could be a comma expression with loop modifiers */
3280af22 2475 if (t < PL_bufend && ((*t == ',' && (*s == 'q' || !isLOWER(*s)))
b8a4b1be 2476 || (*t == '=' && t[1] == '>')))
a0d0e21e 2477 OPERATOR(HASHBRACK);
3280af22 2478 if (PL_expect == XREF)
834a4ddd 2479 PL_expect = XSTATE; /* was XTERM, trying XSTATE */
a0d0e21e 2480 else {
3280af22
NIS		 2481 PL_lex_brackstack[PL_lex_brackets-1] = XSTATE;
2482 PL_expect = XSTATE;
a0d0e21e 2483 }
8990e307 2484 }
a0d0e21e 2485 break;
463ee0b2 2486 }
3280af22 2487 yylval.ival = PL_curcop->cop_line;
79072805 2488 if (isSPACE(*s) || *s == '#')
3280af22 2489 PL_copline = NOLINE; /* invalidate current command line number */
79072805 2490 TOKEN('{');
378cc40b 2491 case '}':
79072805
LW		 2492 rightbracket:
2493 s++;
3280af22 2494 if (PL_lex_brackets <= 0)
d98d5fff 2495 yyerror("Unmatched right curly bracket");
463ee0b2 2496 else
3280af22
NIS		 2497 PL_expect = (expectation)PL_lex_brackstack[--PL_lex_brackets];
2498 if (PL_lex_brackets < PL_lex_formbrack)
2499 PL_lex_formbrack = 0;
2500 if (PL_lex_state == LEX_INTERPNORMAL) {
2501 if (PL_lex_brackets == 0) {
2502 if (PL_lex_fakebrack) {
2503 PL_lex_state = LEX_INTERPEND;
2504 PL_bufptr = s;
cea2e8a9 2505 return yylex(); /* ignore fake brackets */
79072805 2506 }
fa83b5b6 2507 if (*s == '-' && s[1] == '>')
3280af22 2508 PL_lex_state = LEX_INTERPENDMAYBE;
fa83b5b6 2509 else if (*s != '[' && *s != '{')
3280af22 2510 PL_lex_state = LEX_INTERPEND;
79072805
LW		 2511 }
2512 }
3280af22
NIS		 2513 if (PL_lex_brackets < PL_lex_fakebrack) {
2514 PL_bufptr = s;
2515 PL_lex_fakebrack = 0;
cea2e8a9 2516 return yylex(); /* ignore fake brackets */
748a9306 2517 }
79072805
LW		 2518 force_next('}');
2519 TOKEN(';');
378cc40b
LW		 2520 case '&':
2521 s++;
2522 tmp = *s++;
2523 if (tmp == '&')
a0d0e21e 2524 AOPERATOR(ANDAND);
378cc40b 2525 s--;
3280af22 2526 if (PL_expect == XOPERATOR) {
834a4ddd 2527 if (ckWARN(WARN_SEMICOLON) && isIDFIRST_lazy(s) && PL_bufptr == PL_linestart) {
3280af22 2528 PL_curcop->cop_line--;
cea2e8a9 2529 Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi);
3280af22 2530 PL_curcop->cop_line++;
463ee0b2 2531 }
79072805 2532 BAop(OP_BIT_AND);
463ee0b2 2533 }
79072805 2534
3280af22
NIS		 2535 s = scan_ident(s - 1, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE);
2536 if (*PL_tokenbuf) {
2537 PL_expect = XOPERATOR;
2538 force_ident(PL_tokenbuf, '&');
463ee0b2 2539 }
79072805
LW		 2540 else
2541 PREREF('&');
c07a80fd 2542 yylval.ival = (OPpENTERSUB_AMPER<<8);
79072805
LW		 2543 TERM('&');
2544
378cc40b
LW		 2545 case '|':
2546 s++;
2547 tmp = *s++;
2548 if (tmp == '|')
a0d0e21e 2549 AOPERATOR(OROR);
378cc40b 2550 s--;
79072805 2551 BOop(OP_BIT_OR);
378cc40b
LW		 2552 case '=':
2553 s++;
2554 tmp = *s++;
2555 if (tmp == '=')
79072805
LW		 2556 Eop(OP_EQ);
2557 if (tmp == '>')
2558 OPERATOR(',');
378cc40b 2559 if (tmp == '~')
79072805 2560 PMop(OP_MATCH);
599cee73 2561 if (ckWARN(WARN_SYNTAX) && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
cea2e8a9 2562 Perl_warner(aTHX_ WARN_SYNTAX, "Reversed %c= operator",(int)tmp);
378cc40b 2563 s--;
3280af22
NIS		 2564 if (PL_expect == XSTATE && isALPHA(tmp) &&
2565 (s == PL_linestart+1 || s[-2] == '\n') )
748a9306 2566 {
3280af22
NIS		 2567 if (PL_in_eval && !PL_rsfp) {
2568 d = PL_bufend;
a5f75d66
AD		 2569 while (s < d) {
2570 if (*s++ == '\n') {
2571 incline(s);
2572 if (strnEQ(s,"=cut",4)) {
2573 s = strchr(s,'\n');
2574 if (s)
2575 s++;
2576 else
2577 s = d;
2578 incline(s);
2579 goto retry;
2580 }
2581 }
2582 }
2583 goto retry;
2584 }
3280af22
NIS		 2585 s = PL_bufend;
2586 PL_doextract = TRUE;
a0d0e21e
LW		 2587 goto retry;
2588 }
3280af22 2589 if (PL_lex_brackets < PL_lex_formbrack) {
a0d0e21e 2590 char *t;
51882d45 2591#ifdef PERL_STRICT_CR
a0d0e21e 2592 for (t = s; *t == ' ' || *t == '\t'; t++) ;
51882d45
GS		 2593#else
2594 for (t = s; *t == ' ' || *t == '\t' || *t == '\r'; t++) ;
2595#endif
a0d0e21e
LW		 2596 if (*t == '\n' || *t == '#') {
2597 s--;
3280af22 2598 PL_expect = XBLOCK;
a0d0e21e
LW		 2599 goto leftbracket;
2600 }
79072805 2601 }
a0d0e21e
LW		 2602 yylval.ival = 0;
2603 OPERATOR(ASSIGNOP);
378cc40b
LW		 2604 case '!':
2605 s++;
2606 tmp = *s++;
2607 if (tmp == '=')
79072805 2608 Eop(OP_NE);
378cc40b 2609 if (tmp == '~')
79072805 2610 PMop(OP_NOT);
378cc40b
LW		 2611 s--;
2612 OPERATOR('!');
2613 case '<':
3280af22 2614 if (PL_expect != XOPERATOR) {
93a17b20 2615 if (s[1] != '<' && !strchr(s,'>'))
2f3197b3 2616 check_uni();
79072805
LW		 2617 if (s[1] == '<')
2618 s = scan_heredoc(s);
2619 else
2620 s = scan_inputsymbol(s);
2621 TERM(sublex_start());
378cc40b
LW		 2622 }
2623 s++;
2624 tmp = *s++;
2625 if (tmp == '<')
79072805 2626 SHop(OP_LEFT_SHIFT);
395c3793
LW		 2627 if (tmp == '=') {
2628 tmp = *s++;
2629 if (tmp == '>')
79072805 2630 Eop(OP_NCMP);
395c3793 2631 s--;
79072805 2632 Rop(OP_LE);
395c3793 2633 }
378cc40b 2634 s--;
79072805 2635 Rop(OP_LT);
378cc40b
LW		 2636 case '>':
2637 s++;
2638 tmp = *s++;
2639 if (tmp == '>')
79072805 2640 SHop(OP_RIGHT_SHIFT);
378cc40b 2641 if (tmp == '=')
79072805 2642 Rop(OP_GE);
378cc40b 2643 s--;
79072805 2644 Rop(OP_GT);
378cc40b
LW		 2645
2646 case '$':
bbce6d69 2647 CLINE;
2648
3280af22
NIS		 2649 if (PL_expect == XOPERATOR) {
2650 if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
2651 PL_expect = XTERM;
a0d0e21e 2652 depcom();
bbce6d69 2653 return ','; /* grandfather non-comma-format format */
a0d0e21e 2654 }
8990e307 2655 }
a0d0e21e 2656
834a4ddd 2657 if (s[1] == '#' && (isIDFIRST_lazy(s+2) || strchr("{$:+-", s[2]))) {
3280af22
NIS		 2658 if (PL_expect == XOPERATOR)
2659 no_op("Array length", PL_bufptr);
2660 PL_tokenbuf[0] = '@';
2661 s = scan_ident(s + 1, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
8903cb82 2662 FALSE);
3280af22 2663 if (!PL_tokenbuf[1])
a0d0e21e 2664 PREREF(DOLSHARP);
3280af22
NIS		 2665 PL_expect = XOPERATOR;
2666 PL_pending_ident = '#';
463ee0b2 2667 TOKEN(DOLSHARP);
79072805 2668 }
bbce6d69 2669
3280af22
NIS		 2670 if (PL_expect == XOPERATOR)
2671 no_op("Scalar", PL_bufptr);
2672 PL_tokenbuf[0] = '$';
2673 s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
2674 if (!PL_tokenbuf[1]) {
2675 if (s == PL_bufend)
bbce6d69 2676 yyerror("Final $ should be \\$ or $name");
2677 PREREF('$');
8990e307 2678 }
a0d0e21e 2679
bbce6d69 2680 /* This kludge not intended to be bulletproof. */
3280af22 2681 if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) {
bbce6d69 2682 yylval.opval = newSVOP(OP_CONST, 0,
3280af22 2683 newSViv((IV)PL_compiling.cop_arybase));
bbce6d69 2684 yylval.opval->op_private = OPpCONST_ARYBASE;
2685 TERM(THING);
2686 }
2687
ff68c719 2688 d = s;
69d2bceb 2689 tmp = (I32)*s;
3280af22 2690 if (PL_lex_state == LEX_NORMAL)
ff68c719 2691 s = skipspace(s);
2692
3280af22 2693 if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
bbce6d69 2694 char *t;
2695 if (*s == '[') {
3280af22 2696 PL_tokenbuf[0] = '@';
599cee73 2697 if (ckWARN(WARN_SYNTAX)) {
bbce6d69 2698 for(t = s + 1;
834a4ddd 2699 isSPACE(*t) || isALNUM_lazy(t) || *t == '$';
bbce6d69 2700 t++) ;
a0d0e21e 2701 if (*t++ == ',') {
3280af22
NIS		 2702 PL_bufptr = skipspace(PL_bufptr);
2703 while (t < PL_bufend && *t != ']')
bbce6d69 2704 t++;
cea2e8a9 2705 Perl_warner(aTHX_ WARN_SYNTAX,
599cee73
PM		 2706 "Multidimensional syntax %.*s not supported",
2707 (t - PL_bufptr) + 1, PL_bufptr);
a0d0e21e
LW		 2708 }
2709 }
bbce6d69 2710 }
2711 else if (*s == '{') {
3280af22 2712 PL_tokenbuf[0] = '%';
599cee73 2713 if (ckWARN(WARN_SYNTAX) && strEQ(PL_tokenbuf+1, "SIG") &&
bbce6d69 2714 (t = strchr(s, '}')) && (t = strchr(t, '=')))
2715 {
3280af22 2716 char tmpbuf[sizeof PL_tokenbuf];
a0d0e21e
LW		 2717 STRLEN len;
2718 for (t++; isSPACE(*t); t++) ;
834a4ddd 2719 if (isIDFIRST_lazy(t)) {
8903cb82 2720 t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
59a6d928 2721 for (; isSPACE(*t); t++) ;
864dbfa3 2722 if (*t == ';' && get_cv(tmpbuf, FALSE))
cea2e8a9 2723 Perl_warner(aTHX_ WARN_SYNTAX,
599cee73 2724 "You need to quote \"%s\"", tmpbuf);
748a9306 2725 }
93a17b20
LW		 2726 }
2727 }
2f3197b3 2728 }
bbce6d69 2729
3280af22 2730 PL_expect = XOPERATOR;
69d2bceb 2731 if (PL_lex_state == LEX_NORMAL && isSPACE((char)tmp)) {
3280af22
NIS		 2732 bool islop = (PL_last_lop == PL_oldoldbufptr);
2733 if (!islop || PL_last_lop_op == OP_GREPSTART)
2734 PL_expect = XOPERATOR;
bbce6d69 2735 else if (strchr("$@\"'`q", *s))
3280af22 2736 PL_expect = XTERM; /* e.g. print $fh "foo" */
834a4ddd 2737 else if (strchr("&*<%", *s) && isIDFIRST_lazy(s+1))
3280af22 2738 PL_expect = XTERM; /* e.g. print $fh &sub */
834a4ddd 2739 else if (isIDFIRST_lazy(s)) {
3280af22 2740 char tmpbuf[sizeof PL_tokenbuf];
8903cb82 2741 scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
84902520
TB		 2742 if (tmp = keyword(tmpbuf, len)) {
2743 /* binary operators exclude handle interpretations */
2744 switch (tmp) {
2745 case -KEY_x:
2746 case -KEY_eq:
2747 case -KEY_ne:
2748 case -KEY_gt:
2749 case -KEY_lt:
2750 case -KEY_ge:
2751 case -KEY_le:
2752 case -KEY_cmp:
2753 break;
2754 default:
3280af22 2755 PL_expect = XTERM; /* e.g. print $fh length() */
84902520
TB		 2756 break;
2757 }
2758 }
68dc0745 2759 else {
2760 GV *gv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
2761 if (gv && GvCVu(gv))
3280af22 2762 PL_expect = XTERM; /* e.g. print $fh subr() */
93a17b20 2763 }
93a17b20 2764 }
bbce6d69 2765 else if (isDIGIT(*s))
3280af22 2766 PL_expect = XTERM; /* e.g. print $fh 3 */
bbce6d69 2767 else if (*s == '.' && isDIGIT(s[1]))
3280af22 2768 PL_expect = XTERM; /* e.g. print $fh .3 */
e0587a03 2769 else if (strchr("/?-+", *s) && !isSPACE(s[1]) && s[1] != '=')
3280af22 2770 PL_expect = XTERM; /* e.g. print $fh -1 */
e0587a03 2771 else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]) && s[2] != '=')
3280af22 2772 PL_expect = XTERM; /* print $fh <<"EOF" */
bbce6d69 2773 }
3280af22 2774 PL_pending_ident = '$';
79072805 2775 TOKEN('$');
378cc40b
LW		 2776
2777 case '@':
3280af22 2778 if (PL_expect == XOPERATOR)
bbce6d69 2779 no_op("Array", s);
3280af22
NIS		 2780 PL_tokenbuf[0] = '@';
2781 s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
2782 if (!PL_tokenbuf[1]) {
2783 if (s == PL_bufend)
bbce6d69 2784 yyerror("Final @ should be \\@ or @name");
2785 PREREF('@');
2786 }
3280af22 2787 if (PL_lex_state == LEX_NORMAL)
ff68c719 2788 s = skipspace(s);
3280af22 2789 if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
bbce6d69 2790 if (*s == '{')
3280af22 2791 PL_tokenbuf[0] = '%';
a0d0e21e
LW		 2792
2793 /* Warn about @ where they meant $. */
599cee73 2794 if (ckWARN(WARN_SYNTAX)) {
a0d0e21e
LW		 2795 if (*s == '[' || *s == '{') {
2796 char *t = s + 1;
834a4ddd 2797 while (*t && (isALNUM_lazy(t) || strchr(" \t$#+-'\"", *t)))
a0d0e21e
LW		 2798 t++;
2799 if (*t == '}' || *t == ']') {
2800 t++;
3280af22 2801 PL_bufptr = skipspace(PL_bufptr);
cea2e8a9 2802 Perl_warner(aTHX_ WARN_SYNTAX,
599cee73 2803 "Scalar value %.*s better written as $%.*s",
3280af22 2804 t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1);
a0d0e21e 2805 }
93a17b20
LW		 2806 }
2807 }
463ee0b2 2808 }
3280af22 2809 PL_pending_ident = '@';
79072805 2810 TERM('@');
378cc40b
LW		 2811
2812 case '/': /* may either be division or pattern */
2813 case '?': /* may either be conditional or pattern */
3280af22 2814 if (PL_expect != XOPERATOR) {
c277df42 2815 /* Disable warning on "study /blah/" */
3280af22
NIS		 2816 if (PL_oldoldbufptr == PL_last_uni
2817 && (*PL_last_uni != 's' || s - PL_last_uni < 5
834a4ddd 2818 || memNE(PL_last_uni, "study", 5) || isALNUM_lazy(PL_last_uni+5)))
c277df42 2819 check_uni();
8782bef2 2820 s = scan_pat(s,OP_MATCH);
79072805 2821 TERM(sublex_start());
378cc40b
LW		 2822 }
2823 tmp = *s++;
a687059c 2824 if (tmp == '/')
79072805 2825 Mop(OP_DIVIDE);
378cc40b
LW		 2826 OPERATOR(tmp);
2827
2828 case '.':
51882d45
GS		 2829 if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack
2830#ifdef PERL_STRICT_CR
2831 && s[1] == '\n'
2832#else
2833 && (s[1] == '\n' || (s[1] == '\r' && s[2] == '\n'))
2834#endif
2835 && (s == PL_linestart || s[-1] == '\n') )
2836 {
3280af22
NIS		 2837 PL_lex_formbrack = 0;
2838 PL_expect = XSTATE;
79072805
LW		 2839 goto rightbracket;
2840 }
3280af22 2841 if (PL_expect == XOPERATOR || !isDIGIT(s[1])) {
378cc40b 2842 tmp = *s++;
a687059c
LW		 2843 if (*s == tmp) {
2844 s++;
2f3197b3
LW		 2845 if (*s == tmp) {
2846 s++;
79072805 2847 yylval.ival = OPf_SPECIAL;
2f3197b3
LW		 2848 }
2849 else
79072805 2850 yylval.ival = 0;
378cc40b 2851 OPERATOR(DOTDOT);
a687059c 2852 }
3280af22 2853 if (PL_expect != XOPERATOR)
2f3197b3 2854 check_uni();
79072805 2855 Aop(OP_CONCAT);
378cc40b
LW		 2856 }
2857 /* FALL THROUGH */
2858 case '0': case '1': case '2': case '3': case '4':
2859 case '5': case '6': case '7': case '8': case '9':
79072805 2860 s = scan_num(s);
3280af22 2861 if (PL_expect == XOPERATOR)
8990e307 2862 no_op("Number",s);
79072805
LW		 2863 TERM(THING);
2864
2865 case '\'':
8990e307 2866 s = scan_str(s);
3280af22
NIS		 2867 if (PL_expect == XOPERATOR) {
2868 if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
2869 PL_expect = XTERM;
a0d0e21e
LW		 2870 depcom();
2871 return ','; /* grandfather non-comma-format format */
2872 }
463ee0b2 2873 else
8990e307 2874 no_op("String",s);
463ee0b2 2875 }
79072805 2876 if (!s)
85e6fe83 2877 missingterm((char*)0);
79072805
LW		 2878 yylval.ival = OP_CONST;
2879 TERM(sublex_start());
2880
2881 case '"':
8990e307 2882 s = scan_str(s);
3280af22
NIS		 2883 if (PL_expect == XOPERATOR) {
2884 if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
2885 PL_expect = XTERM;
a0d0e21e
LW		 2886 depcom();
2887 return ','; /* grandfather non-comma-format format */
2888 }
463ee0b2 2889 else
8990e307 2890 no_op("String",s);
463ee0b2 2891 }
79072805 2892 if (!s)
85e6fe83 2893 missingterm((char*)0);
4633a7c4 2894 yylval.ival = OP_CONST;
3280af22 2895 for (d = SvPV(PL_lex_stuff, len); len; len--, d++) {
a0ed51b3 2896 if (*d == '$' || *d == '@' || *d == '\\' || *d & 0x80) {
4633a7c4
LW		 2897 yylval.ival = OP_STRINGIFY;
2898 break;
2899 }
2900 }
79072805
LW		 2901 TERM(sublex_start());
2902
2903 case '`':
2904 s = scan_str(s);
3280af22 2905 if (PL_expect == XOPERATOR)
8990e307 2906 no_op("Backticks",s);
79072805 2907 if (!s)
85e6fe83 2908 missingterm((char*)0);
79072805
LW		 2909 yylval.ival = OP_BACKTICK;
2910 set_csh();
2911 TERM(sublex_start());
2912
2913 case '\\':
2914 s++;
599cee73 2915 if (ckWARN(WARN_SYNTAX) && PL_lex_inwhat && isDIGIT(*s))
cea2e8a9 2916 Perl_warner(aTHX_ WARN_SYNTAX,"Can't use \\%c to mean $%c in expression",
599cee73 2917 *s, *s);
3280af22 2918 if (PL_expect == XOPERATOR)
8990e307 2919 no_op("Backslash",s);
79072805
LW		 2920 OPERATOR(REFGEN);
2921
2922 case 'x':
3280af22 2923 if (isDIGIT(s[1]) && PL_expect == XOPERATOR) {
79072805
LW		 2924 s++;
2925 Mop(OP_REPEAT);
2f3197b3 2926 }
79072805
LW		 2927 goto keylookup;
2928
378cc40b 2929 case '_':
79072805
LW		 2930 case 'a': case 'A':
2931 case 'b': case 'B':
2932 case 'c': case 'C':
2933 case 'd': case 'D':
2934 case 'e': case 'E':
2935 case 'f': case 'F':
2936 case 'g': case 'G':
2937 case 'h': case 'H':
2938 case 'i': case 'I':
2939 case 'j': case 'J':
2940 case 'k': case 'K':
2941 case 'l': case 'L':
2942 case 'm': case 'M':
2943 case 'n': case 'N':
2944 case 'o': case 'O':
2945 case 'p': case 'P':
2946 case 'q': case 'Q':
2947 case 'r': case 'R':
2948 case 's': case 'S':
2949 case 't': case 'T':
2950 case 'u': case 'U':
2951 case 'v': case 'V':
2952 case 'w': case 'W':
2953 case 'X':
2954 case 'y': case 'Y':
2955 case 'z': case 'Z':
2956
49dc05e3 2957 keylookup: {
2d8e6c8d 2958 STRLEN n_a;
161b471a
NIS		 2959 gv = Nullgv;
2960 gvp = 0;
49dc05e3 2961
3280af22
NIS		 2962 PL_bufptr = s;
2963 s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
8ebc5c01 2964
2965 /* Some keywords can be followed by any delimiter, including ':' */
3280af22
NIS		 2966 tmp = (len == 1 && strchr("msyq", PL_tokenbuf[0]) ||
2967 len == 2 && ((PL_tokenbuf[0] == 't' && PL_tokenbuf[1] == 'r') ||
2968 (PL_tokenbuf[0] == 'q' &&
2969 strchr("qwxr", PL_tokenbuf[1]))));
8ebc5c01 2970
2971 /* x::* is just a word, unless x is "CORE" */
3280af22 2972 if (!tmp && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE"))
4633a7c4
LW		 2973 goto just_a_word;
2974
3643fb5f 2975 d = s;
3280af22 2976 while (d < PL_bufend && isSPACE(*d))
3643fb5f
CS		 2977 d++; /* no comments skipped here, or s### is misparsed */
2978
2979 /* Is this a label? */
3280af22
NIS		 2980 if (!tmp && PL_expect == XSTATE
2981 && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
8ebc5c01 2982 s = d + 1;
3280af22 2983 yylval.pval = savepv(PL_tokenbuf);
8ebc5c01 2984 CLINE;
2985 TOKEN(LABEL);
3643fb5f
CS		 2986 }
2987
2988 /* Check for keywords */
3280af22 2989 tmp = keyword(PL_tokenbuf, len);
748a9306
LW		 2990
2991 /* Is this a word before a => operator? */
748a9306
LW		 2992 if (strnEQ(d,"=>",2)) {
2993 CLINE;
3280af22 2994 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
748a9306
LW		 2995 yylval.opval->op_private = OPpCONST_BARE;
2996 TERM(WORD);
2997 }
2998
a0d0e21e 2999 if (tmp < 0) { /* second-class keyword? */
56f7f34b
CS		 3000 GV *ogv = Nullgv; /* override (winner) */
3001 GV *hgv = Nullgv; /* hidden (loser) */
3280af22 3002 if (PL_expect != XOPERATOR && (*s != ':' || s[1] != ':')) {
56f7f34b 3003 CV *cv;
3280af22 3004 if ((gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV)) &&
56f7f34b
CS		 3005 (cv = GvCVu(gv)))
3006 {
3007 if (GvIMPORTED_CV(gv))
3008 ogv = gv;
3009 else if (! CvMETHOD(cv))
3010 hgv = gv;
3011 }
3012 if (!ogv &&
3280af22
NIS		 3013 (gvp = (GV**)hv_fetch(PL_globalstash,PL_tokenbuf,len,FALSE)) &&
3014 (gv = *gvp) != (GV*)&PL_sv_undef &&
56f7f34b
CS		 3015 GvCVu(gv) && GvIMPORTED_CV(gv))
3016 {
3017 ogv = gv;
3018 }
3019 }
3020 if (ogv) {
3021 tmp = 0; /* overridden by import or by GLOBAL */
6e7b2336
GS		 3022 }
3023 else if (gv && !gvp
3024 && -tmp==KEY_lock /* XXX generalizable kludge */
3280af22 3025 && !hv_fetch(GvHVn(PL_incgv), "Thread.pm", 9, FALSE))
6e7b2336
GS		 3026 {
3027 tmp = 0; /* any sub overrides "weak" keyword */
a0d0e21e 3028 }
56f7f34b
CS		 3029 else { /* no override */
3030 tmp = -tmp;
3031 gv = Nullgv;
3032 gvp = 0;
4944e2f7
GS		 3033 if (ckWARN(WARN_AMBIGUOUS) && hgv
3034 && tmp != KEY_x && tmp != KEY_CORE) /* never ambiguous */
cea2e8a9 3035 Perl_warner(aTHX_ WARN_AMBIGUOUS,
599cee73 3036 "Ambiguous call resolved as CORE::%s(), %s",
2f3ca594 3037 GvENAME(hgv), "qualify as such or use &");
49dc05e3 3038 }
a0d0e21e
LW		 3039 }
3040
3041 reserved_word:
3042 switch (tmp) {
79072805
LW		 3043
3044 default: /* not a keyword */
93a17b20 3045 just_a_word: {
96e4d5b1 3046 SV *sv;
3280af22 3047 char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
8990e307
LW		 3048
3049 /* Get the rest if it looks like a package qualifier */
3050
a0d0e21e 3051 if (*s == '\'' || *s == ':' && s[1] == ':') {
c3e0f903 3052 STRLEN morelen;
3280af22 3053 s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len,
c3e0f903
GS		 3054 TRUE, &morelen);
3055 if (!morelen)
cea2e8a9 3056 Perl_croak(aTHX_ "Bad name after %s%s", PL_tokenbuf,
ec2ab091 3057 *s == '\'' ? "'" : "::");
c3e0f903 3058 len += morelen;
a0d0e21e 3059 }
8990e307 3060
3280af22
NIS		 3061 if (PL_expect == XOPERATOR) {
3062 if (PL_bufptr == PL_linestart) {
3063 PL_curcop->cop_line--;
cea2e8a9 3064 Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi);
3280af22 3065 PL_curcop->cop_line++;
463ee0b2
LW		 3066 }
3067 else
54310121 3068 no_op("Bareword",s);
463ee0b2 3069 }
8990e307 3070
c3e0f903
GS		 3071 /* Look for a subroutine with this name in current package,
3072 unless name is "Foo::", in which case Foo is a bearword
3073 (and a package name). */
3074
3075 if (len > 2 &&
3280af22 3076 PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
c3e0f903 3077 {
599cee73 3078 if (ckWARN(WARN_UNSAFE) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
cea2e8a9 3079 Perl_warner(aTHX_ WARN_UNSAFE,
599cee73 3080 "Bareword \"%s\" refers to nonexistent package",
3280af22 3081 PL_tokenbuf);
c3e0f903 3082 len -= 2;
3280af22 3083 PL_tokenbuf[len] = '\0';
c3e0f903
GS		 3084 gv = Nullgv;
3085 gvp = 0;
3086 }
3087 else {
3088 len = 0;
3089 if (!gv)
3280af22 3090 gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV);
c3e0f903
GS		 3091 }
3092
3093 /* if we saw a global override before, get the right name */
8990e307 3094
49dc05e3 3095 if (gvp) {
79cb57f6 3096 sv = newSVpvn("CORE::GLOBAL::",14);
3280af22 3097 sv_catpv(sv,PL_tokenbuf);
49dc05e3
GS		 3098 }
3099 else
3280af22 3100 sv = newSVpv(PL_tokenbuf,0);
8990e307 3101
a0d0e21e
LW		 3102 /* Presume this is going to be a bareword of some sort. */
3103
3104 CLINE;
49dc05e3 3105 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
a0d0e21e
LW		 3106 yylval.opval->op_private = OPpCONST_BARE;
3107
c3e0f903
GS		 3108 /* And if "Foo::", then that's what it certainly is. */
3109
3110 if (len)
3111 goto safe_bareword;
3112
8990e307
LW		 3113 /* See if it's the indirect object for a list operator. */
3114
3280af22
NIS		 3115 if (PL_oldoldbufptr &&
3116 PL_oldoldbufptr < PL_bufptr &&
3117 (PL_oldoldbufptr == PL_last_lop || PL_oldoldbufptr == PL_last_uni) &&
a0d0e21e 3118 /* NO SKIPSPACE BEFORE HERE! */
a9ef352a
GS		 3119 (PL_expect == XREF ||
3120 ((PL_opargs[PL_last_lop_op] >> OASHIFT)& 7) == OA_FILEREF))
a0d0e21e 3121 {
748a9306
LW		 3122 bool immediate_paren = *s == '(';
3123
a0d0e21e
LW		 3124 /* (Now we can afford to cross potential line boundary.) */
3125 s = skipspace(s);
3126
3127 /* Two barewords in a row may indicate method call. */
3128
834a4ddd 3129 if ((isIDFIRST_lazy(s) || *s == '$') && (tmp=intuit_method(s,gv)))
a0d0e21e
LW		 3130 return tmp;
3131
3132 /* If not a declared subroutine, it's an indirect object. */
3133 /* (But it's an indir obj regardless for sort.) */
3134
3280af22 3135 if ((PL_last_lop_op == OP_SORT ||
a9ef352a
GS		 3136 (!immediate_paren && (!gv || !GvCVu(gv)))) &&
3137 (PL_last_lop_op != OP_MAPSTART &&
3138 PL_last_lop_op != OP_GREPSTART))
3139 {
3280af22 3140 PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
748a9306 3141 goto bareword;
93a17b20
LW		 3142 }
3143 }
8990e307
LW		 3144
3145 /* If followed by a paren, it's certainly a subroutine. */
3146
3280af22 3147 PL_expect = XOPERATOR;
8990e307 3148 s = skipspace(s);
93a17b20 3149 if (*s == '(') {
79072805 3150 CLINE;
96e4d5b1 3151 if (gv && GvCVu(gv)) {
3152 for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
7a52d87a 3153 if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
96e4d5b1 3154 s = d + 1;
3155 goto its_constant;
3156 }
3157 }
3280af22
NIS		 3158 PL_nextval[PL_nexttoke].opval = yylval.opval;
3159 PL_expect = XOPERATOR;
93a17b20 3160 force_next(WORD);
c07a80fd 3161 yylval.ival = 0;
463ee0b2 3162 TOKEN('&');
79072805 3163 }
93a17b20 3164
a0d0e21e 3165 /* If followed by var or block, call it a method (unless sub) */
8990e307 3166
8ebc5c01 3167 if ((*s == '$' || *s == '{') && (!gv || !GvCVu(gv))) {
3280af22
NIS		 3168 PL_last_lop = PL_oldbufptr;
3169 PL_last_lop_op = OP_METHOD;
93a17b20 3170 PREBLOCK(METHOD);
463ee0b2
LW		 3171 }
3172
8990e307
LW		 3173 /* If followed by a bareword, see if it looks like indir obj. */
3174
834a4ddd 3175 if ((isIDFIRST_lazy(s) || *s == '$') && (tmp = intuit_method(s,gv)))
a0d0e21e 3176 return tmp;
93a17b20 3177
8990e307
LW		 3178 /* Not a method, so call it a subroutine (if defined) */
3179
8ebc5c01 3180 if (gv && GvCVu(gv)) {
46fc3d4c 3181 CV* cv;
748a9306 3182 if (lastchar == '-')
cea2e8a9 3183 Perl_warn(aTHX_ "Ambiguous use of -%s resolved as -&%s()",
3280af22 3184 PL_tokenbuf, PL_tokenbuf);
89bfa8cd 3185 /* Check for a constant sub */
46fc3d4c 3186 cv = GvCV(gv);
96e4d5b1 3187 if ((sv = cv_const_sv(cv))) {
3188 its_constant:
3189 SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
3190 ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc(sv);
3191 yylval.opval->op_private = 0;
3192 TOKEN(WORD);
89bfa8cd 3193 }
3194
a5f75d66
AD		 3195 /* Resolve to GV now. */
3196 op_free(yylval.opval);
3197 yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
9675f7ac 3198 yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
7a52d87a 3199 PL_last_lop = PL_oldbufptr;
bf848113 3200 PL_last_lop_op = OP_ENTERSUB;
4633a7c4
LW		 3201 /* Is there a prototype? */
3202 if (SvPOK(cv)) {
3203 STRLEN len;
7a52d87a 3204 char *proto = SvPV((SV*)cv, len);
4633a7c4
LW		 3205 if (!len)
3206 TERM(FUNC0SUB);
7a52d87a 3207 if (strEQ(proto, "$"))
4633a7c4 3208 OPERATOR(UNIOPSUB);
7a52d87a 3209 if (*proto == '&' && *s == '{') {
3280af22 3210 sv_setpv(PL_subname,"__ANON__");
4633a7c4
LW		 3211 PREBLOCK(LSTOPSUB);
3212 }
a9ef352a 3213 }
3280af22
NIS		 3214 PL_nextval[PL_nexttoke].opval = yylval.opval;
3215 PL_expect = XTERM;
8990e307
LW		 3216 force_next(WORD);
3217 TOKEN(NOAMP);
3218 }
748a9306 3219
8990e307
LW		 3220 /* Call it a bare word */
3221
5603f27d
GS		 3222 if (PL_hints & HINT_STRICT_SUBS)
3223 yylval.opval->op_private |= OPpCONST_STRICT;
3224 else {
3225 bareword:
3226 if (ckWARN(WARN_RESERVED)) {
3227 if (lastchar != '-') {
3228 for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
3229 if (!*d)
cea2e8a9 3230 Perl_warner(aTHX_ WARN_RESERVED, PL_warn_reserved,
5603f27d
GS		 3231 PL_tokenbuf);
3232 }
748a9306
LW		 3233 }
3234 }
c3e0f903
GS		 3235
3236 safe_bareword:
748a9306 3237 if (lastchar && strchr("*%&", lastchar)) {
cea2e8a9 3238 Perl_warn(aTHX_ "Operator or semicolon missing before %c%s",
3280af22 3239 lastchar, PL_tokenbuf);
cea2e8a9 3240 Perl_warn(aTHX_ "Ambiguous use of %c resolved as operator %c",
748a9306
LW		 3241 lastchar, lastchar);
3242 }
93a17b20 3243 TOKEN(WORD);
79072805 3244 }
79072805 3245
68dc0745 3246 case KEY___FILE__:
46fc3d4c 3247 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3280af22 3248 newSVsv(GvSV(PL_curcop->cop_filegv)));
46fc3d4c 3249 TERM(THING);
3250
79072805 3251 case KEY___LINE__:
46fc3d4c 3252 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
cea2e8a9 3253 Perl_newSVpvf(aTHX_ "%ld", (long)PL_curcop->cop_line));
79072805 3254 TERM(THING);
68dc0745 3255
3256 case KEY___PACKAGE__:
3257 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3280af22
NIS		 3258 (PL_curstash
3259 ? newSVsv(PL_curstname)
3260 : &PL_sv_undef));
79072805 3261 TERM(THING);
79072805 3262
e50aee73 3263 case KEY___DATA__:
79072805
LW		 3264 case KEY___END__: {
3265 GV *gv;
79072805
LW		 3266
3267 /*SUPPRESS 560*/
3280af22 3268 if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D')) {
e50aee73 3269 char *pname = "main";
3280af22
NIS		 3270 if (PL_tokenbuf[2] == 'D')
3271 pname = HvNAME(PL_curstash ? PL_curstash : PL_defstash);
cea2e8a9 3272 gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), TRUE, SVt_PVIO);
a5f75d66 3273 GvMULTI_on(gv);
79072805 3274 if (!GvIO(gv))
a0d0e21e 3275 GvIOp(gv) = newIO();
3280af22 3276 IoIFP(GvIOp(gv)) = PL_rsfp;
a0d0e21e
LW		 3277#if defined(HAS_FCNTL) && defined(F_SETFD)
3278 {
3280af22 3279 int fd = PerlIO_fileno(PL_rsfp);
a0d0e21e
LW		 3280 fcntl(fd,F_SETFD,fd >= 3);
3281 }
79072805 3282#endif
fd049845 3283 /* Mark this internal pseudo-handle as clean */
3284 IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT;
3280af22 3285 if (PL_preprocess)
a0d0e21e 3286 IoTYPE(GvIOp(gv)) = '|';
3280af22 3287 else if ((PerlIO*)PL_rsfp == PerlIO_stdin())
a0d0e21e 3288 IoTYPE(GvIOp(gv)) = '-';
79072805 3289 else
a0d0e21e 3290 IoTYPE(GvIOp(gv)) = '<';
3280af22 3291 PL_rsfp = Nullfp;
79072805
LW		 3292 }
3293 goto fake_eof;
e929a76b 3294 }
de3bb511 3295
8990e307 3296 case KEY_AUTOLOAD:
ed6116ce 3297 case KEY_DESTROY:
79072805
LW		 3298 case KEY_BEGIN:
3299 case KEY_END:
7d07dbc2 3300 case KEY_INIT:
3280af22
NIS		 3301 if (PL_expect == XSTATE) {
3302 s = PL_bufptr;
93a17b20 3303 goto really_sub;
79072805
LW		 3304 }
3305 goto just_a_word;
3306
a0d0e21e
LW		 3307 case KEY_CORE:
3308 if (*s == ':' && s[1] == ':') {
3309 s += 2;
748a9306 3310 d = s;
3280af22
NIS		 3311 s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
3312 tmp = keyword(PL_tokenbuf, len);
a0d0e21e
LW		 3313 if (tmp < 0)
3314 tmp = -tmp;
3315 goto reserved_word;
3316 }
3317 goto just_a_word;
3318
463ee0b2
LW		 3319 case KEY_abs:
3320 UNI(OP_ABS);
3321
79072805
LW		 3322 case KEY_alarm:
3323 UNI(OP_ALARM);
3324
3325 case KEY_accept:
a0d0e21e 3326 LOP(OP_ACCEPT,XTERM);
79072805 3327
463ee0b2
LW		 3328 case KEY_and:
3329 OPERATOR(ANDOP);
3330
79072805 3331 case KEY_atan2:
a0d0e21e 3332 LOP(OP_ATAN2,XTERM);
85e6fe83 3333
79072805 3334 case KEY_bind:
a0d0e21e 3335 LOP(OP_BIND,XTERM);
79072805
LW		 3336
3337 case KEY_binmode:
3338 UNI(OP_BINMODE);
3339
3340 case KEY_bless:
a0d0e21e 3341 LOP(OP_BLESS,XTERM);
79072805
LW		 3342
3343 case KEY_chop:
3344 UNI(OP_CHOP);
3345
3346 case KEY_continue:
3347 PREBLOCK(CONTINUE);
3348
3349 case KEY_chdir:
85e6fe83 3350 (void)gv_fetchpv("ENV",TRUE, SVt_PVHV); /* may use HOME */
79072805
LW		 3351 UNI(OP_CHDIR);
3352
3353 case KEY_close:
3354 UNI(OP_CLOSE);
3355
3356 case KEY_closedir:
3357 UNI(OP_CLOSEDIR);
3358
3359 case KEY_cmp:
3360 Eop(OP_SCMP);
3361
3362 case KEY_caller:
3363 UNI(OP_CALLER);
3364
3365 case KEY_crypt:
3366#ifdef FCRYPT
6b88bc9c 3367 if (!PL_cryptseen++)
de3bb511 3368 init_des();
a687059c 3369#endif
a0d0e21e 3370 LOP(OP_CRYPT,XTERM);
79072805
LW		 3371
3372 case KEY_chmod:
599cee73 3373 if (ckWARN(WARN_OCTAL)) {
3280af22 3374 for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
748a9306
LW		 3375 if (*d != '0' && isDIGIT(*d))
3376 yywarn("chmod: mode argument is missing initial 0");
3377 }
a0d0e21e 3378 LOP(OP_CHMOD,XTERM);
79072805
LW		 3379
3380 case KEY_chown:
a0d0e21e 3381 LOP(OP_CHOWN,XTERM);
79072805
LW		 3382
3383 case KEY_connect:
a0d0e21e 3384 LOP(OP_CONNECT,XTERM);
79072805 3385
463ee0b2
LW		 3386 case KEY_chr:
3387 UNI(OP_CHR);
3388
79072805
LW		 3389 case KEY_cos:
3390 UNI(OP_COS);
3391
3392 case KEY_chroot:
3393 UNI(OP_CHROOT);
3394
3395 case KEY_do:
3396 s = skipspace(s);
3397 if (*s == '{')
a0d0e21e 3398 PRETERMBLOCK(DO);
79072805 3399 if (*s != '\'')
a0d0e21e 3400 s = force_word(s,WORD,FALSE,TRUE,FALSE);
378cc40b 3401 OPERATOR(DO);
79072805
LW		 3402
3403 case KEY_die:
3280af22 3404 PL_hints |= HINT_BLOCK_SCOPE;
a0d0e21e 3405 LOP(OP_DIE,XTERM);
79072805
LW		 3406
3407 case KEY_defined:
3408 UNI(OP_DEFINED);
3409
3410 case KEY_delete:
a0d0e21e 3411 UNI(OP_DELETE);
79072805
LW		 3412
3413 case KEY_dbmopen:
a0d0e21e
LW		 3414 gv_fetchpv("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV);
3415 LOP(OP_DBMOPEN,XTERM);
79072805
LW		 3416
3417 case KEY_dbmclose:
3418 UNI(OP_DBMCLOSE);
3419
3420 case KEY_dump:
a0d0e21e 3421 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3422 LOOPX(OP_DUMP);
3423
3424 case KEY_else:
3425 PREBLOCK(ELSE);
3426
3427 case KEY_elsif:
3280af22 3428 yylval.ival = PL_curcop->cop_line;
79072805
LW		 3429 OPERATOR(ELSIF);
3430
3431 case KEY_eq:
3432 Eop(OP_SEQ);
3433
a0d0e21e
LW		 3434 case KEY_exists:
3435 UNI(OP_EXISTS);
3436
79072805
LW		 3437 case KEY_exit:
3438 UNI(OP_EXIT);
3439
3440 case KEY_eval:
79072805 3441 s = skipspace(s);
3280af22 3442 PL_expect = (*s == '{') ? XTERMBLOCK : XTERM;
463ee0b2 3443 UNIBRACK(OP_ENTEREVAL);
79072805
LW		 3444
3445 case KEY_eof:
3446 UNI(OP_EOF);
3447
3448 case KEY_exp:
3449 UNI(OP_EXP);
3450
3451 case KEY_each:
3452 UNI(OP_EACH);
3453
3454 case KEY_exec:
3455 set_csh();
a0d0e21e 3456 LOP(OP_EXEC,XREF);
79072805
LW		 3457
3458 case KEY_endhostent:
3459 FUN0(OP_EHOSTENT);
3460
3461 case KEY_endnetent:
3462 FUN0(OP_ENETENT);
3463
3464 case KEY_endservent:
3465 FUN0(OP_ESERVENT);
3466
3467 case KEY_endprotoent:
3468 FUN0(OP_EPROTOENT);
3469
3470 case KEY_endpwent:
3471 FUN0(OP_EPWENT);
3472
3473 case KEY_endgrent:
3474 FUN0(OP_EGRENT);
3475
3476 case KEY_for:
3477 case KEY_foreach:
3280af22 3478 yylval.ival = PL_curcop->cop_line;
55497cff 3479 s = skipspace(s);
834a4ddd 3480 if (PL_expect == XSTATE && isIDFIRST_lazy(s)) {
55497cff 3481 char *p = s;
3280af22 3482 if ((PL_bufend - p) >= 3 &&
55497cff 3483 strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
3484 p += 2;
3485 p = skipspace(p);
834a4ddd 3486 if (isIDFIRST_lazy(p))
cea2e8a9 3487 Perl_croak(aTHX_ "Missing $ on loop variable");
55497cff 3488 }
79072805
LW		 3489 OPERATOR(FOR);
3490
3491 case KEY_formline:
a0d0e21e 3492 LOP(OP_FORMLINE,XTERM);
79072805
LW		 3493
3494 case KEY_fork:
3495 FUN0(OP_FORK);
3496
3497 case KEY_fcntl:
a0d0e21e 3498 LOP(OP_FCNTL,XTERM);
79072805
LW		 3499
3500 case KEY_fileno:
3501 UNI(OP_FILENO);
3502
3503 case KEY_flock:
a0d0e21e 3504 LOP(OP_FLOCK,XTERM);
79072805
LW		 3505
3506 case KEY_gt:
3507 Rop(OP_SGT);
3508
3509 case KEY_ge:
3510 Rop(OP_SGE);
3511
3512 case KEY_grep:
a0d0e21e 3513 LOP(OP_GREPSTART, *s == '(' ? XTERM : XREF);
79072805
LW		 3514
3515 case KEY_goto:
a0d0e21e 3516 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3517 LOOPX(OP_GOTO);
3518
3519 case KEY_gmtime:
3520 UNI(OP_GMTIME);
3521
3522 case KEY_getc:
3523 UNI(OP_GETC);
3524
3525 case KEY_getppid:
3526 FUN0(OP_GETPPID);
3527
3528 case KEY_getpgrp:
3529 UNI(OP_GETPGRP);
3530
3531 case KEY_getpriority:
a0d0e21e 3532 LOP(OP_GETPRIORITY,XTERM);
79072805
LW		 3533
3534 case KEY_getprotobyname:
3535 UNI(OP_GPBYNAME);
3536
3537 case KEY_getprotobynumber:
a0d0e21e 3538 LOP(OP_GPBYNUMBER,XTERM);
79072805
LW		 3539
3540 case KEY_getprotoent:
3541 FUN0(OP_GPROTOENT);
3542
3543 case KEY_getpwent:
3544 FUN0(OP_GPWENT);
3545
3546 case KEY_getpwnam:
ff68c719 3547 UNI(OP_GPWNAM);
79072805
LW		 3548
3549 case KEY_getpwuid:
ff68c719 3550 UNI(OP_GPWUID);
79072805
LW		 3551
3552 case KEY_getpeername:
3553 UNI(OP_GETPEERNAME);
3554
3555 case KEY_gethostbyname:
3556 UNI(OP_GHBYNAME);
3557
3558 case KEY_gethostbyaddr:
a0d0e21e 3559 LOP(OP_GHBYADDR,XTERM);
79072805
LW		 3560
3561 case KEY_gethostent:
3562 FUN0(OP_GHOSTENT);
3563
3564 case KEY_getnetbyname:
3565 UNI(OP_GNBYNAME);
3566
3567 case KEY_getnetbyaddr:
a0d0e21e 3568 LOP(OP_GNBYADDR,XTERM);
79072805
LW		 3569
3570 case KEY_getnetent:
3571 FUN0(OP_GNETENT);
3572
3573 case KEY_getservbyname:
a0d0e21e 3574 LOP(OP_GSBYNAME,XTERM);
79072805
LW		 3575
3576 case KEY_getservbyport:
a0d0e21e 3577 LOP(OP_GSBYPORT,XTERM);
79072805
LW		 3578
3579 case KEY_getservent:
3580 FUN0(OP_GSERVENT);
3581
3582 case KEY_getsockname:
3583 UNI(OP_GETSOCKNAME);
3584
3585 case KEY_getsockopt:
a0d0e21e 3586 LOP(OP_GSOCKOPT,XTERM);
79072805
LW		 3587
3588 case KEY_getgrent:
3589 FUN0(OP_GGRENT);
3590
3591 case KEY_getgrnam:
ff68c719 3592 UNI(OP_GGRNAM);
79072805
LW		 3593
3594 case KEY_getgrgid:
ff68c719 3595 UNI(OP_GGRGID);
79072805
LW		 3596
3597 case KEY_getlogin:
3598 FUN0(OP_GETLOGIN);
3599
93a17b20 3600 case KEY_glob:
a0d0e21e
LW		 3601 set_csh();
3602 LOP(OP_GLOB,XTERM);
93a17b20 3603
79072805
LW		 3604 case KEY_hex:
3605 UNI(OP_HEX);
3606
3607 case KEY_if:
3280af22 3608 yylval.ival = PL_curcop->cop_line;
79072805
LW		 3609 OPERATOR(IF);
3610
3611 case KEY_index:
a0d0e21e 3612 LOP(OP_INDEX,XTERM);
79072805
LW		 3613
3614 case KEY_int:
3615 UNI(OP_INT);
3616
3617 case KEY_ioctl:
a0d0e21e 3618 LOP(OP_IOCTL,XTERM);
79072805
LW		 3619
3620 case KEY_join:
a0d0e21e 3621 LOP(OP_JOIN,XTERM);
79072805
LW		 3622
3623 case KEY_keys:
3624 UNI(OP_KEYS);
3625
3626 case KEY_kill:
a0d0e21e 3627 LOP(OP_KILL,XTERM);
79072805
LW		 3628
3629 case KEY_last:
a0d0e21e 3630 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805 3631 LOOPX(OP_LAST);
a0d0e21e 3632
79072805
LW		 3633 case KEY_lc:
3634 UNI(OP_LC);
3635
3636 case KEY_lcfirst:
3637 UNI(OP_LCFIRST);
3638
3639 case KEY_local:
3640 OPERATOR(LOCAL);
3641
3642 case KEY_length:
3643 UNI(OP_LENGTH);
3644
3645 case KEY_lt:
3646 Rop(OP_SLT);
3647
3648 case KEY_le:
3649 Rop(OP_SLE);
3650
3651 case KEY_localtime:
3652 UNI(OP_LOCALTIME);
3653
3654 case KEY_log:
3655 UNI(OP_LOG);
3656
3657 case KEY_link:
a0d0e21e 3658 LOP(OP_LINK,XTERM);
79072805
LW		 3659
3660 case KEY_listen:
a0d0e21e 3661 LOP(OP_LISTEN,XTERM);
79072805 3662
c0329465
MB		 3663 case KEY_lock:
3664 UNI(OP_LOCK);
3665
79072805
LW		 3666 case KEY_lstat:
3667 UNI(OP_LSTAT);
3668
3669 case KEY_m:
8782bef2 3670 s = scan_pat(s,OP_MATCH);
79072805
LW		 3671 TERM(sublex_start());
3672
a0d0e21e 3673 case KEY_map:
834a4ddd 3674 LOP(OP_MAPSTART, XREF);
a0d0e21e 3675
79072805 3676 case KEY_mkdir:
a0d0e21e 3677 LOP(OP_MKDIR,XTERM);
79072805
LW		 3678
3679 case KEY_msgctl:
a0d0e21e 3680 LOP(OP_MSGCTL,XTERM);
79072805
LW		 3681
3682 case KEY_msgget:
a0d0e21e 3683 LOP(OP_MSGGET,XTERM);
79072805
LW		 3684
3685 case KEY_msgrcv:
a0d0e21e 3686 LOP(OP_MSGRCV,XTERM);
79072805
LW		 3687
3688 case KEY_msgsnd:
a0d0e21e 3689 LOP(OP_MSGSND,XTERM);
79072805 3690
93a17b20 3691 case KEY_my:
3280af22 3692 PL_in_my = TRUE;
c750a3ec 3693 s = skipspace(s);
834a4ddd 3694 if (isIDFIRST_lazy(s)) {
3280af22
NIS		 3695 s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
3696 PL_in_my_stash = gv_stashpv(PL_tokenbuf, FALSE);
3697 if (!PL_in_my_stash) {
c750a3ec 3698 char tmpbuf[1024];
3280af22
NIS		 3699 PL_bufptr = s;
3700 sprintf(tmpbuf, "No such class %.1000s", PL_tokenbuf);
c750a3ec
MB		 3701 yyerror(tmpbuf);
3702 }
3703 }
55497cff 3704 OPERATOR(MY);
93a17b20 3705
79072805 3706 case KEY_next:
a0d0e21e 3707 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3708 LOOPX(OP_NEXT);
3709
3710 case KEY_ne:
3711 Eop(OP_SNE);
3712
a0d0e21e 3713 case KEY_no:
3280af22 3714 if (PL_expect != XSTATE)
a0d0e21e
LW		 3715 yyerror("\"no\" not allowed in expression");
3716 s = force_word(s,WORD,FALSE,TRUE,FALSE);
89bfa8cd 3717 s = force_version(s);
a0d0e21e
LW		 3718 yylval.ival = 0;
3719 OPERATOR(USE);
3720
3721 case KEY_not:
3722 OPERATOR(NOTOP);
3723
79072805 3724 case KEY_open:
93a17b20 3725 s = skipspace(s);
834a4ddd 3726 if (isIDFIRST_lazy(s)) {
93a17b20 3727 char *t;
834a4ddd 3728 for (d = s; isALNUM_lazy(d); d++) ;
93a17b20
LW		 3729 t = skipspace(d);
3730 if (strchr("|&*+-=!?:.", *t))
cea2e8a9 3731 Perl_warn(aTHX_ "Precedence problem: open %.*s should be open(%.*s)",
93a17b20
LW		 3732 d-s,s, d-s,s);
3733 }
a0d0e21e 3734 LOP(OP_OPEN,XTERM);
79072805 3735
463ee0b2 3736 case KEY_or:
a0d0e21e 3737 yylval.ival = OP_OR;
463ee0b2
LW		 3738 OPERATOR(OROP);
3739
79072805
LW		 3740 case KEY_ord:
3741 UNI(OP_ORD);
3742
3743 case KEY_oct:
3744 UNI(OP_OCT);
3745
3746 case KEY_opendir:
a0d0e21e 3747 LOP(OP_OPEN_DIR,XTERM);
79072805
LW		 3748
3749 case KEY_print:
3280af22 3750 checkcomma(s,PL_tokenbuf,"filehandle");
a0d0e21e 3751 LOP(OP_PRINT,XREF);
79072805
LW		 3752
3753 case KEY_printf:
3280af22 3754 checkcomma(s,PL_tokenbuf,"filehandle");
a0d0e21e 3755 LOP(OP_PRTF,XREF);
79072805 3756
c07a80fd 3757 case KEY_prototype:
3758 UNI(OP_PROTOTYPE);
3759
79072805 3760 case KEY_push:
a0d0e21e 3761 LOP(OP_PUSH,XTERM);
79072805
LW		 3762
3763 case KEY_pop:
3764 UNI(OP_POP);
3765
a0d0e21e
LW		 3766 case KEY_pos:
3767 UNI(OP_POS);
3768
79072805 3769 case KEY_pack:
a0d0e21e 3770 LOP(OP_PACK,XTERM);
79072805
LW		 3771
3772 case KEY_package:
a0d0e21e 3773 s = force_word(s,WORD,FALSE,TRUE,FALSE);
79072805
LW		 3774 OPERATOR(PACKAGE);
3775
3776 case KEY_pipe:
a0d0e21e 3777 LOP(OP_PIPE_OP,XTERM);
79072805
LW		 3778
3779 case KEY_q:
3780 s = scan_str(s);
3781 if (!s)
85e6fe83 3782 missingterm((char*)0);
79072805
LW		 3783 yylval.ival = OP_CONST;
3784 TERM(sublex_start());
3785
a0d0e21e
LW		 3786 case KEY_quotemeta:
3787 UNI(OP_QUOTEMETA);
3788
8990e307
LW		 3789 case KEY_qw:
3790 s = scan_str(s);
3791 if (!s)
85e6fe83 3792 missingterm((char*)0);
8127e0e3
GS		 3793 force_next(')');
3794 if (SvCUR(PL_lex_stuff)) {
3795 OP *words = Nullop;
3796 int warned = 0;
3280af22 3797 d = SvPV_force(PL_lex_stuff, len);
8127e0e3
GS		 3798 while (len) {
3799 for (; isSPACE(*d) && len; --len, ++d) ;
3800 if (len) {
3801 char *b = d;
3802 if (!warned && ckWARN(WARN_SYNTAX)) {
3803 for (; !isSPACE(*d) && len; --len, ++d) {
3804 if (*d == ',') {
cea2e8a9 3805 Perl_warner(aTHX_ WARN_SYNTAX,
8127e0e3
GS		 3806 "Possible attempt to separate words with commas");
3807 ++warned;
3808 }
3809 else if (*d == '#') {
cea2e8a9 3810 Perl_warner(aTHX_ WARN_SYNTAX,
8127e0e3
GS		 3811 "Possible attempt to put comments in qw() list");
3812 ++warned;
3813 }
3814 }
3815 }
3816 else {
3817 for (; !isSPACE(*d) && len; --len, ++d) ;
3818 }
3819 words = append_elem(OP_LIST, words,
3820 newSVOP(OP_CONST, 0, newSVpvn(b, d-b)));
55497cff 3821 }
3822 }
8127e0e3
GS		 3823 if (words) {
3824 PL_nextval[PL_nexttoke].opval = words;
3825 force_next(THING);
3826 }
55497cff 3827 }
8127e0e3
GS		 3828 if (PL_lex_stuff)
3829 SvREFCNT_dec(PL_lex_stuff);
3280af22 3830 PL_lex_stuff = Nullsv;
3280af22 3831 PL_expect = XTERM;
8127e0e3 3832 TOKEN('(');
8990e307 3833
79072805
LW		 3834 case KEY_qq:
3835 s = scan_str(s);
3836 if (!s)
85e6fe83 3837 missingterm((char*)0);
a0d0e21e 3838 yylval.ival = OP_STRINGIFY;
3280af22
NIS		 3839 if (SvIVX(PL_lex_stuff) == '\'')
3840 SvIVX(PL_lex_stuff) = 0; /* qq'$foo' should intepolate */
79072805
LW		 3841 TERM(sublex_start());
3842
8782bef2
GB		 3843 case KEY_qr:
3844 s = scan_pat(s,OP_QR);
3845 TERM(sublex_start());
3846
79072805
LW		 3847 case KEY_qx:
3848 s = scan_str(s);
3849 if (!s)
85e6fe83 3850 missingterm((char*)0);
79072805
LW		 3851 yylval.ival = OP_BACKTICK;
3852 set_csh();
3853 TERM(sublex_start());
3854
3855 case KEY_return:
3856 OLDLOP(OP_RETURN);
3857
3858 case KEY_require:
3280af22 3859 *PL_tokenbuf = '\0';
a0d0e21e 3860 s = force_word(s,WORD,TRUE,TRUE,FALSE);
834a4ddd 3861 if (isIDFIRST_lazy(PL_tokenbuf))
3280af22 3862 gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE);
748a9306 3863 else if (*s == '<')
a0d0e21e 3864 yyerror("<> should be quotes");
463ee0b2 3865 UNI(OP_REQUIRE);
79072805
LW		 3866
3867 case KEY_reset:
3868 UNI(OP_RESET);
3869
3870 case KEY_redo:
a0d0e21e 3871 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3872 LOOPX(OP_REDO);
3873
3874 case KEY_rename:
a0d0e21e 3875 LOP(OP_RENAME,XTERM);
79072805
LW		 3876
3877 case KEY_rand:
3878 UNI(OP_RAND);
3879
3880 case KEY_rmdir:
3881 UNI(OP_RMDIR);
3882
3883 case KEY_rindex:
a0d0e21e 3884 LOP(OP_RINDEX,XTERM);
79072805
LW		 3885
3886 case KEY_read:
a0d0e21e 3887 LOP(OP_READ,XTERM);
79072805
LW		 3888
3889 case KEY_readdir:
3890 UNI(OP_READDIR);
3891
93a17b20
LW		 3892 case KEY_readline:
3893 set_csh();
3894 UNI(OP_READLINE);
3895
3896 case KEY_readpipe:
3897 set_csh();
3898 UNI(OP_BACKTICK);
3899
79072805
LW		 3900 case KEY_rewinddir:
3901 UNI(OP_REWINDDIR);
3902
3903 case KEY_recv:
a0d0e21e 3904 LOP(OP_RECV,XTERM);
79072805
LW		 3905
3906 case KEY_reverse:
a0d0e21e 3907 LOP(OP_REVERSE,XTERM);
79072805
LW		 3908
3909 case KEY_readlink:
3910 UNI(OP_READLINK);
3911
3912 case KEY_ref:
3913 UNI(OP_REF);
3914
3915 case KEY_s:
3916 s = scan_subst(s);
3917 if (yylval.opval)
3918 TERM(sublex_start());
3919 else
3920 TOKEN(1); /* force error */
3921
a0d0e21e
LW		 3922 case KEY_chomp:
3923 UNI(OP_CHOMP);
3924
79072805
LW		 3925 case KEY_scalar:
3926 UNI(OP_SCALAR);
3927
3928 case KEY_select:
a0d0e21e 3929 LOP(OP_SELECT,XTERM);
79072805
LW		 3930
3931 case KEY_seek:
a0d0e21e 3932 LOP(OP_SEEK,XTERM);
79072805
LW		 3933
3934 case KEY_semctl:
a0d0e21e 3935 LOP(OP_SEMCTL,XTERM);
79072805
LW		 3936
3937 case KEY_semget:
a0d0e21e 3938 LOP(OP_SEMGET,XTERM);
79072805
LW		 3939
3940 case KEY_semop:
a0d0e21e 3941 LOP(OP_SEMOP,XTERM);
79072805
LW		 3942
3943 case KEY_send:
a0d0e21e 3944 LOP(OP_SEND,XTERM);
79072805
LW		 3945
3946 case KEY_setpgrp:
a0d0e21e 3947 LOP(OP_SETPGRP,XTERM);
79072805
LW		 3948
3949 case KEY_setpriority:
a0d0e21e 3950 LOP(OP_SETPRIORITY,XTERM);
79072805
LW		 3951
3952 case KEY_sethostent:
ff68c719 3953 UNI(OP_SHOSTENT);
79072805
LW		 3954
3955 case KEY_setnetent:
ff68c719 3956 UNI(OP_SNETENT);
79072805
LW		 3957
3958 case KEY_setservent:
ff68c719 3959 UNI(OP_SSERVENT);
79072805
LW		 3960
3961 case KEY_setprotoent:
ff68c719 3962 UNI(OP_SPROTOENT);
79072805
LW		 3963
3964 case KEY_setpwent:
3965 FUN0(OP_SPWENT);
3966
3967 case KEY_setgrent:
3968 FUN0(OP_SGRENT);
3969
3970 case KEY_seekdir:
a0d0e21e 3971 LOP(OP_SEEKDIR,XTERM);
79072805
LW		 3972
3973 case KEY_setsockopt:
a0d0e21e 3974 LOP(OP_SSOCKOPT,XTERM);
79072805
LW		 3975
3976 case KEY_shift:
3977 UNI(OP_SHIFT);
3978
3979 case KEY_shmctl:
a0d0e21e 3980 LOP(OP_SHMCTL,XTERM);
79072805
LW		 3981
3982 case KEY_shmget:
a0d0e21e 3983 LOP(OP_SHMGET,XTERM);
79072805
LW		 3984
3985 case KEY_shmread:
a0d0e21e 3986 LOP(OP_SHMREAD,XTERM);
79072805
LW		 3987
3988 case KEY_shmwrite:
a0d0e21e 3989 LOP(OP_SHMWRITE,XTERM);
79072805
LW		 3990
3991 case KEY_shutdown:
a0d0e21e 3992 LOP(OP_SHUTDOWN,XTERM);
79072805
LW		 3993
3994 case KEY_sin:
3995 UNI(OP_SIN);
3996
3997 case KEY_sleep:
3998 UNI(OP_SLEEP);
3999
4000 case KEY_socket:
a0d0e21e 4001 LOP(OP_SOCKET,XTERM);
79072805
LW		 4002
4003 case KEY_socketpair:
a0d0e21e 4004 LOP(OP_SOCKPAIR,XTERM);
79072805
LW		 4005
4006 case KEY_sort:
3280af22 4007 checkcomma(s,PL_tokenbuf,"subroutine name");
79072805
LW		 4008 s = skipspace(s);
4009 if (*s == ';' || *s == ')') /* probably a close */
cea2e8a9 4010 Perl_croak(aTHX_ "sort is now a reserved word");
3280af22 4011 PL_expect = XTERM;
15f0808c 4012 s = force_word(s,WORD,TRUE,TRUE,FALSE);
a0d0e21e 4013 LOP(OP_SORT,XREF);
79072805
LW		 4014
4015 case KEY_split:
a0d0e21e 4016 LOP(OP_SPLIT,XTERM);
79072805
LW		 4017
4018 case KEY_sprintf:
a0d0e21e 4019 LOP(OP_SPRINTF,XTERM);
79072805
LW		 4020
4021 case KEY_splice:
a0d0e21e 4022 LOP(OP_SPLICE,XTERM);
79072805
LW		 4023
4024 case KEY_sqrt:
4025 UNI(OP_SQRT);
4026
4027 case KEY_srand:
4028 UNI(OP_SRAND);
4029
4030 case KEY_stat:
4031 UNI(OP_STAT);
4032
4033 case KEY_study:
3280af22 4034 PL_sawstudy++;
79072805
LW		 4035 UNI(OP_STUDY);
4036
4037 case KEY_substr:
a0d0e21e 4038 LOP(OP_SUBSTR,XTERM);
79072805
LW		 4039
4040 case KEY_format:
4041 case KEY_sub:
93a17b20 4042 really_sub:
79072805 4043 s = skipspace(s);
4633a7c4 4044
834a4ddd 4045 if (isIDFIRST_lazy(s) || *s == '\'' || *s == ':') {
3280af22
NIS		 4046 char tmpbuf[sizeof PL_tokenbuf];
4047 PL_expect = XBLOCK;
8903cb82 4048 d = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
463ee0b2 4049 if (strchr(tmpbuf, ':'))
3280af22 4050 sv_setpv(PL_subname, tmpbuf);
463ee0b2 4051 else {
3280af22
NIS		 4052 sv_setsv(PL_subname,PL_curstname);
4053 sv_catpvn(PL_subname,"::",2);
4054 sv_catpvn(PL_subname,tmpbuf,len);
463ee0b2 4055 }
a0d0e21e 4056 s = force_word(s,WORD,FALSE,TRUE,TRUE);
4633a7c4 4057 s = skipspace(s);
79072805 4058 }
4633a7c4 4059 else {
3280af22
NIS		 4060 PL_expect = XTERMBLOCK;
4061 sv_setpv(PL_subname,"?");
4633a7c4
LW		 4062 }
4063
4064 if (tmp == KEY_format) {
4065 s = skipspace(s);
4066 if (*s == '=')
3280af22 4067 PL_lex_formbrack = PL_lex_brackets + 1;
4633a7c4
LW		 4068 OPERATOR(FORMAT);
4069 }
79072805 4070
4633a7c4
LW		 4071 /* Look for a prototype */
4072 if (*s == '(') {
68dc0745 4073 char *p;
4074
4633a7c4
LW		 4075 s = scan_str(s);
4076 if (!s) {
3280af22
NIS		 4077 if (PL_lex_stuff)
4078 SvREFCNT_dec(PL_lex_stuff);
4079 PL_lex_stuff = Nullsv;
cea2e8a9 4080 Perl_croak(aTHX_ "Prototype not terminated");
4633a7c4 4081 }
68dc0745 4082 /* strip spaces */
3280af22 4083 d = SvPVX(PL_lex_stuff);
68dc0745 4084 tmp = 0;
4085 for (p = d; *p; ++p) {
4086 if (!isSPACE(*p))
4087 d[tmp++] = *p;
4088 }
4089 d[tmp] = '\0';
3280af22
NIS		 4090 SvCUR(PL_lex_stuff) = tmp;
4091
4092 PL_nexttoke++;
4093 PL_nextval[1] = PL_nextval[0];
4094 PL_nexttype[1] = PL_nexttype[0];
4095 PL_nextval[0].opval = (OP*)newSVOP(OP_CONST, 0, PL_lex_stuff);
4096 PL_nexttype[0] = THING;
4097 if (PL_nexttoke == 1) {
4098 PL_lex_defer = PL_lex_state;
4099 PL_lex_expect = PL_expect;
4100 PL_lex_state = LEX_KNOWNEXT;
4633a7c4 4101 }
3280af22 4102 PL_lex_stuff = Nullsv;
4633a7c4 4103 }
79072805 4104
2d8e6c8d 4105 if (*SvPV(PL_subname,n_a) == '?') {
3280af22 4106 sv_setpv(PL_subname,"__ANON__");
4633a7c4
LW		 4107 TOKEN(ANONSUB);
4108 }
4109 PREBLOCK(SUB);
79072805
LW		 4110
4111 case KEY_system:
4112 set_csh();
a0d0e21e 4113 LOP(OP_SYSTEM,XREF);
79072805
LW		 4114
4115 case KEY_symlink:
a0d0e21e 4116 LOP(OP_SYMLINK,XTERM);
79072805
LW		 4117
4118 case KEY_syscall:
a0d0e21e 4119 LOP(OP_SYSCALL,XTERM);
79072805 4120
c07a80fd 4121 case KEY_sysopen:
4122 LOP(OP_SYSOPEN,XTERM);
4123
137443ea 4124 case KEY_sysseek:
4125 LOP(OP_SYSSEEK,XTERM);
4126
79072805 4127 case KEY_sysread:
a0d0e21e 4128 LOP(OP_SYSREAD,XTERM);
79072805
LW		 4129
4130 case KEY_syswrite:
a0d0e21e 4131 LOP(OP_SYSWRITE,XTERM);
79072805
LW		 4132
4133 case KEY_tr:
4134 s = scan_trans(s);
4135 TERM(sublex_start());
4136
4137 case KEY_tell:
4138 UNI(OP_TELL);
4139
4140 case KEY_telldir:
4141 UNI(OP_TELLDIR);
4142
463ee0b2 4143 case KEY_tie:
a0d0e21e 4144 LOP(OP_TIE,XTERM);
463ee0b2 4145
c07a80fd 4146 case KEY_tied:
4147 UNI(OP_TIED);
4148
79072805
LW		 4149 case KEY_time:
4150 FUN0(OP_TIME);
4151
4152 case KEY_times:
4153 FUN0(OP_TMS);
4154
4155 case KEY_truncate:
a0d0e21e 4156 LOP(OP_TRUNCATE,XTERM);
79072805
LW		 4157
4158 case KEY_uc:
4159 UNI(OP_UC);
4160
4161 case KEY_ucfirst:
4162 UNI(OP_UCFIRST);
4163
463ee0b2
LW		 4164 case KEY_untie:
4165 UNI(OP_UNTIE);
4166
79072805 4167 case KEY_until:
3280af22 4168 yylval.ival = PL_curcop->cop_line;
79072805
LW		 4169 OPERATOR(UNTIL);
4170
4171 case KEY_unless:
3280af22 4172 yylval.ival = PL_curcop->cop_line;
79072805
LW		 4173 OPERATOR(UNLESS);
4174
4175 case KEY_unlink:
a0d0e21e 4176 LOP(OP_UNLINK,XTERM);
79072805
LW		 4177
4178 case KEY_undef:
4179 UNI(OP_UNDEF);
4180
4181 case KEY_unpack:
a0d0e21e 4182 LOP(OP_UNPACK,XTERM);
79072805
LW		 4183
4184 case KEY_utime:
a0d0e21e 4185 LOP(OP_UTIME,XTERM);
79072805
LW		 4186
4187 case KEY_umask:
599cee73 4188 if (ckWARN(WARN_OCTAL)) {
3280af22 4189 for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
748a9306
LW		 4190 if (*d != '0' && isDIGIT(*d))
4191 yywarn("umask: argument is missing initial 0");
4192 }
79072805
LW		 4193 UNI(OP_UMASK);
4194
4195 case KEY_unshift:
a0d0e21e
LW		 4196 LOP(OP_UNSHIFT,XTERM);
4197
4198 case KEY_use:
3280af22 4199 if (PL_expect != XSTATE)
a0d0e21e 4200 yyerror("\"use\" not allowed in expression");
89bfa8cd 4201 s = skipspace(s);
4202 if(isDIGIT(*s)) {
4203 s = force_version(s);
4204 if(*s == ';' || (s = skipspace(s), *s == ';')) {
3280af22 4205 PL_nextval[PL_nexttoke].opval = Nullop;
89bfa8cd 4206 force_next(WORD);
4207 }
4208 }
4209 else {
4210 s = force_word(s,WORD,FALSE,TRUE,FALSE);
4211 s = force_version(s);
4212 }
a0d0e21e
LW		 4213 yylval.ival = 1;
4214 OPERATOR(USE);
79072805
LW		 4215
4216 case KEY_values:
4217 UNI(OP_VALUES);
4218
4219 case KEY_vec:
3280af22 4220 PL_sawvec = TRUE;
a0d0e21e 4221 LOP(OP_VEC,XTERM);
79072805
LW		 4222
4223 case KEY_while:
3280af22 4224 yylval.ival = PL_curcop->cop_line;
79072805
LW		 4225 OPERATOR(WHILE);
4226
4227 case KEY_warn:
3280af22 4228 PL_hints |= HINT_BLOCK_SCOPE;
a0d0e21e 4229 LOP(OP_WARN,XTERM);
79072805
LW		 4230
4231 case KEY_wait:
4232 FUN0(OP_WAIT);
4233
4234 case KEY_waitpid:
a0d0e21e 4235 LOP(OP_WAITPID,XTERM);
79072805
LW		 4236
4237 case KEY_wantarray:
4238 FUN0(OP_WANTARRAY);
4239
4240 case KEY_write:
9d116dd7
JH		 4241#ifdef EBCDIC
4242 {
4243 static char ctl_l[2];
4244
4245 if (ctl_l[0] == '\0')
4246 ctl_l[0] = toCTRL('L');
4247 gv_fetchpv(ctl_l,TRUE, SVt_PV);
4248 }
4249#else
4250 gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */
4251#endif
79072805
LW		 4252 UNI(OP_ENTERWRITE);
4253
4254 case KEY_x:
3280af22 4255 if (PL_expect == XOPERATOR)
79072805
LW		 4256 Mop(OP_REPEAT);
4257 check_uni();
4258 goto just_a_word;
4259
a0d0e21e
LW		 4260 case KEY_xor:
4261 yylval.ival = OP_XOR;
4262 OPERATOR(OROP);
4263
79072805
LW		 4264 case KEY_y:
4265 s = scan_trans(s);
4266 TERM(sublex_start());
4267 }
49dc05e3 4268 }}
79072805
LW		 4269}
4270
4271I32
864dbfa3 4272Perl_keyword(pTHX_ register char *d, I32 len)
79072805
LW		 4273{
4274 switch (*d) {
4275 case '_':
4276 if (d[1] == '_') {
a0d0e21e 4277 if (strEQ(d,"__FILE__")) return -KEY___FILE__;
68dc0745 4278 if (strEQ(d,"__LINE__")) return -KEY___LINE__;
4279 if (strEQ(d,"__PACKAGE__")) return -KEY___PACKAGE__;
e50aee73 4280 if (strEQ(d,"__DATA__")) return KEY___DATA__;
79072805
LW		 4281 if (strEQ(d,"__END__")) return KEY___END__;
4282 }
4283 break;
8990e307
LW		 4284 case 'A':
4285 if (strEQ(d,"AUTOLOAD")) return KEY_AUTOLOAD;
4286 break;
79072805 4287 case 'a':
463ee0b2
LW		 4288 switch (len) {
4289 case 3:
a0d0e21e
LW		 4290 if (strEQ(d,"and")) return -KEY_and;
4291 if (strEQ(d,"abs")) return -KEY_abs;
85e6fe83 4292 break;
463ee0b2 4293 case 5:
a0d0e21e
LW		 4294 if (strEQ(d,"alarm")) return -KEY_alarm;
4295 if (strEQ(d,"atan2")) return -KEY_atan2;
463ee0b2
LW		 4296 break;
4297 case 6:
a0d0e21e 4298 if (strEQ(d,"accept")) return -KEY_accept;
463ee0b2
LW		 4299 break;
4300 }
79072805
LW		 4301 break;
4302 case 'B':
4303 if (strEQ(d,"BEGIN")) return KEY_BEGIN;
93a17b20 4304 break;
79072805 4305 case 'b':
a0d0e21e
LW		 4306 if (strEQ(d,"bless")) return -KEY_bless;
4307 if (strEQ(d,"bind")) return -KEY_bind;
4308 if (strEQ(d,"binmode")) return -KEY_binmode;
4309 break;
4310 case 'C':
4311 if (strEQ(d,"CORE")) return -KEY_CORE;
79072805
LW		 4312 break;
4313 case 'c':
4314 switch (len) {
4315 case 3:
a0d0e21e
LW		 4316 if (strEQ(d,"cmp")) return -KEY_cmp;
4317 if (strEQ(d,"chr")) return -KEY_chr;
4318 if (strEQ(d,"cos")) return -KEY_cos;
79072805
LW		 4319 break;
4320 case 4:
4321 if (strEQ(d,"chop")) return KEY_chop;
4322 break;
4323 case 5:
a0d0e21e
LW		 4324 if (strEQ(d,"close")) return -KEY_close;
4325 if (strEQ(d,"chdir")) return -KEY_chdir;
4326 if (strEQ(d,"chomp")) return KEY_chomp;
4327 if (strEQ(d,"chmod")) return -KEY_chmod;
4328 if (strEQ(d,"chown")) return -KEY_chown;
4329 if (strEQ(d,"crypt")) return -KEY_crypt;
79072805
LW		 4330 break;
4331 case 6:
a0d0e21e
LW		 4332 if (strEQ(d,"chroot")) return -KEY_chroot;
4333 if (strEQ(d,"caller")) return -KEY_caller;
79072805
LW		 4334 break;
4335 case 7:
a0d0e21e 4336 if (strEQ(d,"connect")) return -KEY_connect;
79072805
LW		 4337 break;
4338 case 8:
a0d0e21e
LW		 4339 if (strEQ(d,"closedir")) return -KEY_closedir;
4340 if (strEQ(d,"continue")) return -KEY_continue;
79072805
LW		 4341 break;
4342 }
4343 break;
ed6116ce
LW		 4344 case 'D':
4345 if (strEQ(d,"DESTROY")) return KEY_DESTROY;
4346 break;
79072805
LW		 4347 case 'd':
4348 switch (len) {
4349 case 2:
4350 if (strEQ(d,"do")) return KEY_do;
4351 break;
4352 case 3:
a0d0e21e 4353 if (strEQ(d,"die")) return -KEY_die;
79072805
LW		 4354 break;
4355 case 4:
a0d0e21e 4356 if (strEQ(d,"dump")) return -KEY_dump;
79072805
LW		 4357 break;
4358 case 6:
4359 if (strEQ(d,"delete")) return KEY_delete;
4360 break;
4361 case 7:
4362 if (strEQ(d,"defined")) return KEY_defined;
a0d0e21e 4363 if (strEQ(d,"dbmopen")) return -KEY_dbmopen;
79072805
LW		 4364 break;
4365 case 8:
a0d0e21e 4366 if (strEQ(d,"dbmclose")) return -KEY_dbmclose;
79072805
LW		 4367 break;
4368 }
4369 break;
4370 case 'E':
a0d0e21e 4371 if (strEQ(d,"EQ")) { deprecate(d); return -KEY_eq;}
79072805
LW		 4372 if (strEQ(d,"END")) return KEY_END;
4373 break;
4374 case 'e':
4375 switch (len) {
4376 case 2:
a0d0e21e 4377 if (strEQ(d,"eq")) return -KEY_eq;
79072805
LW		 4378 break;
4379 case 3:
a0d0e21e
LW		 4380 if (strEQ(d,"eof")) return -KEY_eof;
4381 if (strEQ(d,"exp")) return -KEY_exp;
79072805
LW		 4382 break;
4383 case 4:
4384 if (strEQ(d,"else")) return KEY_else;
a0d0e21e 4385 if (strEQ(d,"exit")) return -KEY_exit;
79072805 4386 if (strEQ(d,"eval")) return KEY_eval;
a0d0e21e 4387 if (strEQ(d,"exec")) return -KEY_exec;
79072805
LW		 4388 if (strEQ(d,"each")) return KEY_each;
4389 break;
4390 case 5:
4391 if (strEQ(d,"elsif")) return KEY_elsif;
4392 break;
a0d0e21e
LW		 4393 case 6:
4394 if (strEQ(d,"exists")) return KEY_exists;
cea2e8a9 4395 if (strEQ(d,"elseif")) Perl_warn(aTHX_ "elseif should be elsif");
a0d0e21e 4396 break;
79072805 4397 case 8:
a0d0e21e
LW		 4398 if (strEQ(d,"endgrent")) return -KEY_endgrent;
4399 if (strEQ(d,"endpwent")) return -KEY_endpwent;
79072805
LW		 4400 break;
4401 case 9:
a0d0e21e 4402 if (strEQ(d,"endnetent")) return -KEY_endnetent;
79072805
LW		 4403 break;
4404 case 10:
a0d0e21e
LW		 4405 if (strEQ(d,"endhostent")) return -KEY_endhostent;
4406 if (strEQ(d,"endservent")) return -KEY_endservent;
79072805
LW		 4407 break;
4408 case 11:
a0d0e21e 4409 if (strEQ(d,"endprotoent")) return -KEY_endprotoent;
79072805 4410 break;
a687059c 4411 }
a687059c 4412 break;
79072805
LW		 4413 case 'f':
4414 switch (len) {
4415 case 3:
4416 if (strEQ(d,"for")) return KEY_for;
4417 break;
4418 case 4:
a0d0e21e 4419 if (strEQ(d,"fork")) return -KEY_fork;
79072805
LW		 4420 break;
4421 case 5:
a0d0e21e
LW		 4422 if (strEQ(d,"fcntl")) return -KEY_fcntl;
4423 if (strEQ(d,"flock")) return -KEY_flock;
79072805
LW		 4424 break;
4425 case 6:
4426 if (strEQ(d,"format")) return KEY_format;
a0d0e21e 4427 if (strEQ(d,"fileno")) return -KEY_fileno;
79072805
LW		 4428 break;
4429 case 7:
4430 if (strEQ(d,"foreach")) return KEY_foreach;
4431 break;
4432 case 8:
a0d0e21e 4433 if (strEQ(d,"formline")) return -KEY_formline;
79072805 4434 break;
378cc40b 4435 }
a687059c 4436 break;
79072805
LW		 4437 case 'G':
4438 if (len == 2) {
a0d0e21e
LW		 4439 if (strEQ(d,"GT")) { deprecate(d); return -KEY_gt;}
4440 if (strEQ(d,"GE")) { deprecate(d); return -KEY_ge;}
9f68db38 4441 }
a687059c 4442 break;
79072805 4443 case 'g':
a687059c
LW		 4444 if (strnEQ(d,"get",3)) {
4445 d += 3;
4446 if (*d == 'p') {
79072805
LW		 4447 switch (len) {
4448 case 7:
a0d0e21e
LW		 4449 if (strEQ(d,"ppid")) return -KEY_getppid;
4450 if (strEQ(d,"pgrp")) return -KEY_getpgrp;
79072805
LW		 4451 break;
4452 case 8:
a0d0e21e
LW		 4453 if (strEQ(d,"pwent")) return -KEY_getpwent;
4454 if (strEQ(d,"pwnam")) return -KEY_getpwnam;
4455 if (strEQ(d,"pwuid")) return -KEY_getpwuid;
79072805
LW		 4456 break;
4457 case 11:
a0d0e21e
LW		 4458 if (strEQ(d,"peername")) return -KEY_getpeername;
4459 if (strEQ(d,"protoent")) return -KEY_getprotoent;
4460 if (strEQ(d,"priority")) return -KEY_getpriority;
79072805
LW		 4461 break;
4462 case 14:
a0d0e21e 4463 if (strEQ(d,"protobyname")) return -KEY_getprotobyname;
79072805
LW		 4464 break;
4465 case 16:
a0d0e21e 4466 if (strEQ(d,"protobynumber"))return -KEY_getprotobynumber;
79072805
LW		 4467 break;
4468 }
a687059c
LW		 4469 }
4470 else if (*d == 'h') {
a0d0e21e
LW		 4471 if (strEQ(d,"hostbyname")) return -KEY_gethostbyname;
4472 if (strEQ(d,"hostbyaddr")) return -KEY_gethostbyaddr;
4473 if (strEQ(d,"hostent")) return -KEY_gethostent;
a687059c
LW		 4474 }
4475 else if (*d == 'n') {
a0d0e21e
LW		 4476 if (strEQ(d,"netbyname")) return -KEY_getnetbyname;
4477 if (strEQ(d,"netbyaddr")) return -KEY_getnetbyaddr;
4478 if (strEQ(d,"netent")) return -KEY_getnetent;
a687059c
LW		 4479 }
4480 else if (*d == 's') {
a0d0e21e
LW		 4481 if (strEQ(d,"servbyname")) return -KEY_getservbyname;
4482 if (strEQ(d,"servbyport")) return -KEY_getservbyport;
4483 if (strEQ(d,"servent")) return -KEY_getservent;
4484 if (strEQ(d,"sockname")) return -KEY_getsockname;
4485 if (strEQ(d,"sockopt")) return -KEY_getsockopt;
a687059c
LW		 4486 }
4487 else if (*d == 'g') {
a0d0e21e
LW		 4488 if (strEQ(d,"grent")) return -KEY_getgrent;
4489 if (strEQ(d,"grnam")) return -KEY_getgrnam;
4490 if (strEQ(d,"grgid")) return -KEY_getgrgid;
a687059c
LW		 4491 }
4492 else if (*d == 'l') {
a0d0e21e 4493 if (strEQ(d,"login")) return -KEY_getlogin;
a687059c 4494 }
a0d0e21e 4495 else if (strEQ(d,"c")) return -KEY_getc;
79072805 4496 break;
a687059c 4497 }
79072805
LW		 4498 switch (len) {
4499 case 2:
a0d0e21e
LW		 4500 if (strEQ(d,"gt")) return -KEY_gt;
4501 if (strEQ(d,"ge")) return -KEY_ge;
79072805
LW		 4502 break;
4503 case 4:
4504 if (strEQ(d,"grep")) return KEY_grep;
4505 if (strEQ(d,"goto")) return KEY_goto;
fb73857a 4506 if (strEQ(d,"glob")) return KEY_glob;
79072805
LW		 4507 break;
4508 case 6:
a0d0e21e 4509 if (strEQ(d,"gmtime")) return -KEY_gmtime;
79072805 4510 break;
378cc40b 4511 }
a687059c 4512 break;
79072805 4513 case 'h':
a0d0e21e 4514 if (strEQ(d,"hex")) return -KEY_hex;
a687059c 4515 break;
7d07dbc2
MB		 4516 case 'I':
4517 if (strEQ(d,"INIT")) return KEY_INIT;
4518 break;
79072805
LW		 4519 case 'i':
4520 switch (len) {
4521 case 2:
4522 if (strEQ(d,"if")) return KEY_if;
4523 break;
4524 case 3:
a0d0e21e 4525 if (strEQ(d,"int")) return -KEY_int;
79072805
LW		 4526 break;
4527 case 5:
a0d0e21e
LW		 4528 if (strEQ(d,"index")) return -KEY_index;
4529 if (strEQ(d,"ioctl")) return -KEY_ioctl;
79072805
LW		 4530 break;
4531 }
a687059c 4532 break;
79072805 4533 case 'j':
a0d0e21e 4534 if (strEQ(d,"join")) return -KEY_join;
a687059c 4535 break;
79072805
LW		 4536 case 'k':
4537 if (len == 4) {
4538 if (strEQ(d,"keys")) return KEY_keys;
a0d0e21e 4539 if (strEQ(d,"kill")) return -KEY_kill;
663a0e37 4540 }
79072805
LW		 4541 break;
4542 case 'L':
4543 if (len == 2) {
a0d0e21e
LW		 4544 if (strEQ(d,"LT")) { deprecate(d); return -KEY_lt;}
4545 if (strEQ(d,"LE")) { deprecate(d); return -KEY_le;}
378cc40b 4546 }
79072805
LW		 4547 break;
4548 case 'l':
4549 switch (len) {
4550 case 2:
a0d0e21e
LW		 4551 if (strEQ(d,"lt")) return -KEY_lt;
4552 if (strEQ(d,"le")) return -KEY_le;
4553 if (strEQ(d,"lc")) return -KEY_lc;
79072805
LW		 4554 break;
4555 case 3:
a0d0e21e 4556 if (strEQ(d,"log")) return -KEY_log;
79072805
LW		 4557 break;
4558 case 4:
4559 if (strEQ(d,"last")) return KEY_last;
a0d0e21e 4560 if (strEQ(d,"link")) return -KEY_link;
c0329465 4561 if (strEQ(d,"lock")) return -KEY_lock;
395c3793 4562 break;
79072805
LW		 4563 case 5:
4564 if (strEQ(d,"local")) return KEY_local;
a0d0e21e 4565 if (strEQ(d,"lstat")) return -KEY_lstat;
79072805
LW		 4566 break;
4567 case 6:
a0d0e21e
LW		 4568 if (strEQ(d,"length")) return -KEY_length;
4569 if (strEQ(d,"listen")) return -KEY_listen;
79072805
LW		 4570 break;
4571 case 7:
a0d0e21e 4572 if (strEQ(d,"lcfirst")) return -KEY_lcfirst;
79072805
LW		 4573 break;
4574 case 9:
a0d0e21e 4575 if (strEQ(d,"localtime")) return -KEY_localtime;
395c3793
LW		 4576 break;
4577 }
a687059c 4578 break;
79072805
LW		 4579 case 'm':
4580 switch (len) {
4581 case 1: return KEY_m;
93a17b20
LW		 4582 case 2:
4583 if (strEQ(d,"my")) return KEY_my;
4584 break;
a0d0e21e
LW		 4585 case 3:
4586 if (strEQ(d,"map")) return KEY_map;
4587 break;
79072805 4588 case 5:
a0d0e21e 4589 if (strEQ(d,"mkdir")) return -KEY_mkdir;
79072805
LW		 4590 break;
4591 case 6:
a0d0e21e
LW		 4592 if (strEQ(d,"msgctl")) return -KEY_msgctl;
4593 if (strEQ(d,"msgget")) return -KEY_msgget;
4594 if (strEQ(d,"msgrcv")) return -KEY_msgrcv;
4595 if (strEQ(d,"msgsnd")) return -KEY_msgsnd;
79072805
LW		 4596 break;
4597 }
a687059c 4598 break;
79072805 4599 case 'N':
a0d0e21e 4600 if (strEQ(d,"NE")) { deprecate(d); return -KEY_ne;}
a687059c 4601 break;
79072805
LW		 4602 case 'n':
4603 if (strEQ(d,"next")) return KEY_next;
a0d0e21e
LW		 4604 if (strEQ(d,"ne")) return -KEY_ne;
4605 if (strEQ(d,"not")) return -KEY_not;
4606 if (strEQ(d,"no")) return KEY_no;
a687059c 4607 break;
79072805
LW		 4608 case 'o':
4609 switch (len) {
463ee0b2 4610 case 2:
a0d0e21e 4611 if (strEQ(d,"or")) return -KEY_or;
463ee0b2 4612 break;
79072805 4613 case 3:
a0d0e21e
LW		 4614 if (strEQ(d,"ord")) return -KEY_ord;
4615 if (strEQ(d,"oct")) return -KEY_oct;
72311751 4616 if (strEQ(d,"our")) { deprecate("reserved word \"our\"");
85b81015 4617 return 0;}
79072805
LW		 4618 break;
4619 case 4:
a0d0e21e 4620 if (strEQ(d,"open")) return -KEY_open;
79072805
LW		 4621 break;
4622 case 7:
a0d0e21e 4623 if (strEQ(d,"opendir")) return -KEY_opendir;
79072805 4624 break;
fe14fcc3 4625 }
a687059c 4626 break;
79072805
LW		 4627 case 'p':
4628 switch (len) {
4629 case 3:
4630 if (strEQ(d,"pop")) return KEY_pop;
a0d0e21e 4631 if (strEQ(d,"pos")) return KEY_pos;
79072805
LW		 4632 break;
4633 case 4:
4634 if (strEQ(d,"push")) return KEY_push;
a0d0e21e
LW		 4635 if (strEQ(d,"pack")) return -KEY_pack;
4636 if (strEQ(d,"pipe")) return -KEY_pipe;
79072805
LW		 4637 break;
4638 case 5:
4639 if (strEQ(d,"print")) return KEY_print;
4640 break;
4641 case 6:
4642 if (strEQ(d,"printf")) return KEY_printf;
4643 break;
4644 case 7:
4645 if (strEQ(d,"package")) return KEY_package;
4646 break;
c07a80fd 4647 case 9:
4648 if (strEQ(d,"prototype")) return KEY_prototype;
663a0e37 4649 }
79072805
LW		 4650 break;
4651 case 'q':
4652 if (len <= 2) {
4653 if (strEQ(d,"q")) return KEY_q;
8782bef2 4654 if (strEQ(d,"qr")) return KEY_qr;
79072805 4655 if (strEQ(d,"qq")) return KEY_qq;
8990e307 4656 if (strEQ(d,"qw")) return KEY_qw;
79072805 4657 if (strEQ(d,"qx")) return KEY_qx;
663a0e37 4658 }
a0d0e21e 4659 else if (strEQ(d,"quotemeta")) return -KEY_quotemeta;
79072805
LW		 4660 break;
4661 case 'r':
4662 switch (len) {
4663 case 3:
a0d0e21e 4664 if (strEQ(d,"ref")) return -KEY_ref;
79072805
LW		 4665 break;
4666 case 4:
a0d0e21e
LW		 4667 if (strEQ(d,"read")) return -KEY_read;
4668 if (strEQ(d,"rand")) return -KEY_rand;
4669 if (strEQ(d,"recv")) return -KEY_recv;
79072805
LW		 4670 if (strEQ(d,"redo")) return KEY_redo;
4671 break;
4672 case 5:
a0d0e21e
LW		 4673 if (strEQ(d,"rmdir")) return -KEY_rmdir;
4674 if (strEQ(d,"reset")) return -KEY_reset;
79072805
LW		 4675 break;
4676 case 6:
4677 if (strEQ(d,"return")) return KEY_return;
a0d0e21e
LW		 4678 if (strEQ(d,"rename")) return -KEY_rename;
4679 if (strEQ(d,"rindex")) return -KEY_rindex;
79072805
LW		 4680 break;
4681 case 7:
a0d0e21e
LW		 4682 if (strEQ(d,"require")) return -KEY_require;
4683 if (strEQ(d,"reverse")) return -KEY_reverse;
4684 if (strEQ(d,"readdir")) return -KEY_readdir;
79072805
LW		 4685 break;
4686 case 8:
a0d0e21e
LW		 4687 if (strEQ(d,"readlink")) return -KEY_readlink;
4688 if (strEQ(d,"readline")) return -KEY_readline;
4689 if (strEQ(d,"readpipe")) return -KEY_readpipe;
79072805
LW		 4690 break;
4691 case 9:
a0d0e21e 4692 if (strEQ(d,"rewinddir")) return -KEY_rewinddir;
79072805 4693 break;
a687059c 4694 }
79072805
LW		 4695 break;
4696 case 's':
a687059c 4697 switch (d[1]) {
79072805 4698 case 0: return KEY_s;
a687059c 4699 case 'c':
79072805 4700 if (strEQ(d,"scalar")) return KEY_scalar;
a687059c
LW		 4701 break;
4702 case 'e':
79072805
LW		 4703 switch (len) {
4704 case 4:
a0d0e21e
LW		 4705 if (strEQ(d,"seek")) return -KEY_seek;
4706 if (strEQ(d,"send")) return -KEY_send;
79072805
LW		 4707 break;
4708 case 5:
a0d0e21e 4709 if (strEQ(d,"semop")) return -KEY_semop;
79072805
LW		 4710 break;
4711 case 6:
a0d0e21e
LW		 4712 if (strEQ(d,"select")) return -KEY_select;
4713 if (strEQ(d,"semctl")) return -KEY_semctl;
4714 if (strEQ(d,"semget")) return -KEY_semget;
79072805
LW		 4715 break;
4716 case 7:
a0d0e21e
LW		 4717 if (strEQ(d,"setpgrp")) return -KEY_setpgrp;
4718 if (strEQ(d,"seekdir")) return -KEY_seekdir;
79072805
LW		 4719 break;
4720 case 8:
a0d0e21e
LW		 4721 if (strEQ(d,"setpwent")) return -KEY_setpwent;
4722 if (strEQ(d,"setgrent")) return -KEY_setgrent;
79072805
LW		 4723 break;
4724 case 9:
a0d0e21e 4725 if (strEQ(d,"setnetent")) return -KEY_setnetent;
79072805
LW		 4726 break;
4727 case 10:
a0d0e21e
LW		 4728 if (strEQ(d,"setsockopt")) return -KEY_setsockopt;
4729 if (strEQ(d,"sethostent")) return -KEY_sethostent;
4730 if (strEQ(d,"setservent")) return -KEY_setservent;
79072805
LW		 4731 break;
4732 case 11:
a0d0e21e
LW		 4733 if (strEQ(d,"setpriority")) return -KEY_setpriority;
4734 if (strEQ(d,"setprotoent")) return -KEY_setprotoent;
79072805
LW		 4735 break;
4736 }
a687059c
LW		 4737 break;
4738 case 'h':
79072805
LW		 4739 switch (len) {
4740 case 5:
4741 if (strEQ(d,"shift")) return KEY_shift;
4742 break;
4743 case 6:
a0d0e21e
LW		 4744 if (strEQ(d,"shmctl")) return -KEY_shmctl;
4745 if (strEQ(d,"shmget")) return -KEY_shmget;
79072805
LW		 4746 break;
4747 case 7:
a0d0e21e 4748 if (strEQ(d,"shmread")) return -KEY_shmread;
79072805
LW		 4749 break;
4750 case 8:
a0d0e21e
LW		 4751 if (strEQ(d,"shmwrite")) return -KEY_shmwrite;
4752 if (strEQ(d,"shutdown")) return -KEY_shutdown;
79072805
LW		 4753 break;
4754 }
a687059c
LW		 4755 break;
4756 case 'i':
a0d0e21e 4757 if (strEQ(d,"sin")) return -KEY_sin;
a687059c
LW		 4758 break;
4759 case 'l':
a0d0e21e 4760 if (strEQ(d,"sleep")) return -KEY_sleep;
a687059c
LW		 4761 break;
4762 case 'o':
79072805 4763 if (strEQ(d,"sort")) return KEY_sort;
a0d0e21e
LW		 4764 if (strEQ(d,"socket")) return -KEY_socket;
4765 if (strEQ(d,"socketpair")) return -KEY_socketpair;
a687059c
LW		 4766 break;
4767 case 'p':
79072805 4768 if (strEQ(d,"split")) return KEY_split;
a0d0e21e 4769 if (strEQ(d,"sprintf")) return -KEY_sprintf;
79072805 4770 if (strEQ(d,"splice")) return KEY_splice;
a687059c
LW		 4771 break;
4772 case 'q':
a0d0e21e 4773 if (strEQ(d,"sqrt")) return -KEY_sqrt;
a687059c
LW		 4774 break;
4775 case 'r':
a0d0e21e 4776 if (strEQ(d,"srand")) return -KEY_srand;
a687059c
LW		 4777 break;
4778 case 't':
a0d0e21e 4779 if (strEQ(d,"stat")) return -KEY_stat;
79072805 4780 if (strEQ(d,"study")) return KEY_study;
a687059c
LW		 4781 break;
4782 case 'u':
a0d0e21e 4783 if (strEQ(d,"substr")) return -KEY_substr;
79072805 4784 if (strEQ(d,"sub")) return KEY_sub;
a687059c
LW		 4785 break;
4786 case 'y':
79072805
LW		 4787 switch (len) {
4788 case 6:
a0d0e21e 4789 if (strEQ(d,"system")) return -KEY_system;
79072805
LW		 4790 break;
4791 case 7:
a0d0e21e
LW		 4792 if (strEQ(d,"symlink")) return -KEY_symlink;
4793 if (strEQ(d,"syscall")) return -KEY_syscall;
137443ea 4794 if (strEQ(d,"sysopen")) return -KEY_sysopen;
4795 if (strEQ(d,"sysread")) return -KEY_sysread;
4796 if (strEQ(d,"sysseek")) return -KEY_sysseek;
79072805
LW		 4797 break;
4798 case 8:
a0d0e21e 4799 if (strEQ(d,"syswrite")) return -KEY_syswrite;
79072805 4800 break;
a687059c 4801 }
a687059c
LW		 4802 break;
4803 }
4804 break;
79072805
LW		 4805 case 't':
4806 switch (len) {
4807 case 2:
4808 if (strEQ(d,"tr")) return KEY_tr;
4809 break;
463ee0b2
LW		 4810 case 3:
4811 if (strEQ(d,"tie")) return KEY_tie;
4812 break;
79072805 4813 case 4:
a0d0e21e 4814 if (strEQ(d,"tell")) return -KEY_tell;
c07a80fd 4815 if (strEQ(d,"tied")) return KEY_tied;
a0d0e21e 4816 if (strEQ(d,"time")) return -KEY_time;
79072805
LW		 4817 break;
4818 case 5:
a0d0e21e 4819 if (strEQ(d,"times")) return -KEY_times;
79072805
LW		 4820 break;
4821 case 7:
a0d0e21e 4822 if (strEQ(d,"telldir")) return -KEY_telldir;
79072805
LW		 4823 break;
4824 case 8:
a0d0e21e 4825 if (strEQ(d,"truncate")) return -KEY_truncate;
79072805 4826 break;
378cc40b 4827 }
a687059c 4828 break;
79072805
LW		 4829 case 'u':
4830 switch (len) {
4831 case 2:
a0d0e21e
LW		 4832 if (strEQ(d,"uc")) return -KEY_uc;
4833 break;
4834 case 3:
4835 if (strEQ(d,"use")) return KEY_use;
79072805
LW		 4836 break;
4837 case 5:
4838 if (strEQ(d,"undef")) return KEY_undef;
4839 if (strEQ(d,"until")) return KEY_until;
463ee0b2 4840 if (strEQ(d,"untie")) return KEY_untie;
a0d0e21e
LW		 4841 if (strEQ(d,"utime")) return -KEY_utime;
4842 if (strEQ(d,"umask")) return -KEY_umask;
79072805
LW		 4843 break;
4844 case 6:
4845 if (strEQ(d,"unless")) return KEY_unless;
a0d0e21e
LW		 4846 if (strEQ(d,"unpack")) return -KEY_unpack;
4847 if (strEQ(d,"unlink")) return -KEY_unlink;
79072805
LW		 4848 break;
4849 case 7:
4850 if (strEQ(d,"unshift")) return KEY_unshift;
a0d0e21e 4851 if (strEQ(d,"ucfirst")) return -KEY_ucfirst;
79072805 4852 break;
a687059c
LW		 4853 }
4854 break;
79072805 4855 case 'v':
a0d0e21e
LW		 4856 if (strEQ(d,"values")) return -KEY_values;
4857 if (strEQ(d,"vec")) return -KEY_vec;
a687059c 4858 break;
79072805
LW		 4859 case 'w':
4860 switch (len) {
4861 case 4:
a0d0e21e
LW		 4862 if (strEQ(d,"warn")) return -KEY_warn;
4863 if (strEQ(d,"wait")) return -KEY_wait;
79072805
LW		 4864 break;
4865 case 5:
4866 if (strEQ(d,"while")) return KEY_while;
a0d0e21e 4867 if (strEQ(d,"write")) return -KEY_write;
79072805
LW		 4868 break;
4869 case 7:
a0d0e21e 4870 if (strEQ(d,"waitpid")) return -KEY_waitpid;
79072805
LW		 4871 break;
4872 case 9:
a0d0e21e 4873 if (strEQ(d,"wantarray")) return -KEY_wantarray;
79072805 4874 break;
2f3197b3 4875 }
a687059c 4876 break;
79072805 4877 case 'x':
a0d0e21e
LW		 4878 if (len == 1) return -KEY_x;
4879 if (strEQ(d,"xor")) return -KEY_xor;
a687059c 4880 break;
79072805
LW		 4881 case 'y':
4882 if (len == 1) return KEY_y;
4883 break;
4884 case 'z':
a687059c
LW		 4885 break;
4886 }
79072805 4887 return 0;
a687059c
LW		 4888}
4889
76e3520e 4890STATIC void
cea2e8a9 4891S_checkcomma(pTHX_ register char *s, char *name, char *what)
a687059c 4892{
2f3197b3
LW		 4893 char *w;
4894
d008e5eb
GS		 4895 if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */
4896 dTHR; /* only for ckWARN */
4897 if (ckWARN(WARN_SYNTAX)) {
4898 int level = 1;
4899 for (w = s+2; *w && level; w++) {
4900 if (*w == '(')
4901 ++level;
4902 else if (*w == ')')
4903 --level;
4904 }
4905 if (*w)
4906 for (; *w && isSPACE(*w); w++) ;
4907 if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */
cea2e8a9 4908 Perl_warner(aTHX_ WARN_SYNTAX, "%s (...) interpreted as function",name);
d008e5eb 4909 }
2f3197b3 4910 }
3280af22 4911 while (s < PL_bufend && isSPACE(*s))
2f3197b3 4912 s++;
a687059c
LW		 4913 if (*s == '(')
4914 s++;
3280af22 4915 while (s < PL_bufend && isSPACE(*s))
a687059c 4916 s++;
834a4ddd 4917 if (isIDFIRST_lazy(s)) {
2f3197b3 4918 w = s++;
834a4ddd 4919 while (isALNUM_lazy(s))
a687059c 4920 s++;
3280af22 4921 while (s < PL_bufend && isSPACE(*s))
a687059c 4922 s++;
e929a76b 4923 if (*s == ',') {
463ee0b2 4924 int kw;
e929a76b 4925 *s = '\0';
864dbfa3 4926 kw = keyword(w, s - w) || get_cv(w, FALSE) != 0;
e929a76b 4927 *s = ',';
463ee0b2 4928 if (kw)
e929a76b 4929 return;
cea2e8a9 4930 Perl_croak(aTHX_ "No comma allowed after %s", what);
463ee0b2
LW		 4931 }
4932 }
4933}
4934
b3ac6de7 4935STATIC SV *
cea2e8a9 4936S_new_constant(pTHX_ char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
b3ac6de7 4937{
b3ac6de7 4938 dSP;
3280af22 4939 HV *table = GvHV(PL_hintgv); /* ^H */
b3ac6de7
IZ		 4940 BINOP myop;
4941 SV *res;
4942 bool oldcatch = CATCH_GET;
4943 SV **cvp;
4944 SV *cv, *typesv;
b3ac6de7
IZ		 4945
4946 if (!table) {
4947 yyerror("%^H is not defined");
4948 return sv;
4949 }
4950 cvp = hv_fetch(table, key, strlen(key), FALSE);
4951 if (!cvp || !SvOK(*cvp)) {
a30ac152 4952 char buf[128];
b3ac6de7
IZ		 4953 sprintf(buf,"$^H{%s} is not defined", key);
4954 yyerror(buf);
4955 return sv;
4956 }
4957 sv_2mortal(sv); /* Parent created it permanently */
4958 cv = *cvp;
4959 if (!pv)
79cb57f6 4960 pv = sv_2mortal(newSVpvn(s, len));
b3ac6de7
IZ		 4961 if (type)
4962 typesv = sv_2mortal(newSVpv(type, 0));
4963 else
3280af22 4964 typesv = &PL_sv_undef;
b3ac6de7
IZ		 4965 CATCH_SET(TRUE);
4966 Zero(&myop, 1, BINOP);
4967 myop.op_last = (OP *) &myop;
4968 myop.op_next = Nullop;
4969 myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
4970
e788e7d3 4971 PUSHSTACKi(PERLSI_OVERLOAD);
b3ac6de7
IZ		 4972 ENTER;
4973 SAVEOP();
533c011a 4974 PL_op = (OP *) &myop;
3280af22 4975 if (PERLDB_SUB && PL_curstash != PL_debstash)
533c011a 4976 PL_op->op_private |= OPpENTERSUB_DB;
b3ac6de7 4977 PUTBACK;
cea2e8a9 4978 Perl_pp_pushmark(aTHX);
b3ac6de7 4979
25eaa213 4980 EXTEND(sp, 4);
b3ac6de7
IZ		 4981 PUSHs(pv);
4982 PUSHs(sv);
4983 PUSHs(typesv);
4984 PUSHs(cv);
4985 PUTBACK;
4986
cea2e8a9
GS		 4987 if (PL_op = Perl_pp_entersub(aTHX))
4988 CALLRUNOPS(aTHX);
b3ac6de7
IZ		 4989 LEAVE;
4990 SPAGAIN;
4991
4992 res = POPs;
4993 PUTBACK;
4994 CATCH_SET(oldcatch);
4995 POPSTACK;
4996
4997 if (!SvOK(res)) {
a30ac152 4998 char buf[128];
b3ac6de7
IZ		 4999 sprintf(buf,"Call to &{$^H{%s}} did not return a defined value", key);
5000 yyerror(buf);
5001 }
5002 return SvREFCNT_inc(res);
5003}
5004
76e3520e 5005STATIC char *
cea2e8a9 5006S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
463ee0b2
LW		 5007{
5008 register char *d = dest;
8903cb82 5009 register char *e = d + destlen - 3; /* two-character token, ending NUL */
463ee0b2 5010 for (;;) {
8903cb82 5011 if (d >= e)
cea2e8a9 5012 Perl_croak(aTHX_ ident_too_long);
834a4ddd 5013 if (isALNUM(*s)) /* UTF handled below */
463ee0b2 5014 *d++ = *s++;
834a4ddd 5015 else if (*s == '\'' && allow_package && isIDFIRST_lazy(s+1)) {
463ee0b2
LW		 5016 *d++ = ':';
5017 *d++ = ':';
5018 s++;
5019 }
c3e0f903 5020 else if (*s == ':' && s[1] == ':' && allow_package && s[2] != '$') {
463ee0b2
LW		 5021 *d++ = *s++;
5022 *d++ = *s++;
5023 }
834a4ddd 5024 else if (UTF && *(U8*)s >= 0xc0 && isALNUM_utf8((U8*)s)) {
a0ed51b3 5025 char *t = s + UTF8SKIP(s);
dfe13c55 5026 while (*t & 0x80 && is_utf8_mark((U8*)t))
a0ed51b3
LW		 5027 t += UTF8SKIP(t);
5028 if (d + (t - s) > e)
cea2e8a9 5029 Perl_croak(aTHX_ ident_too_long);
a0ed51b3
LW		 5030 Copy(s, d, t - s, char);
5031 d += t - s;
5032 s = t;
5033 }
463ee0b2
LW		 5034 else {
5035 *d = '\0';
5036 *slp = d - dest;
5037 return s;
e929a76b 5038 }
378cc40b
LW		 5039 }
5040}
5041
76e3520e 5042STATIC char *
cea2e8a9 5043S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni)
378cc40b
LW		 5044{
5045 register char *d;
8903cb82 5046 register char *e;
79072805 5047 char *bracket = 0;
748a9306 5048 char funny = *s++;
378cc40b 5049
3280af22
NIS		 5050 if (PL_lex_brackets == 0)
5051 PL_lex_fakebrack = 0;
a0d0e21e
LW		 5052 if (isSPACE(*s))
5053 s = skipspace(s);
378cc40b 5054 d = dest;
8903cb82 5055 e = d + destlen - 3; /* two-character token, ending NUL */
de3bb511 5056 if (isDIGIT(*s)) {
8903cb82 5057 while (isDIGIT(*s)) {
5058 if (d >= e)
cea2e8a9 5059 Perl_croak(aTHX_ ident_too_long);
378cc40b 5060 *d++ = *s++;
8903cb82 5061 }
378cc40b
LW		 5062 }
5063 else {
463ee0b2 5064 for (;;) {
8903cb82 5065 if (d >= e)
cea2e8a9 5066 Perl_croak(aTHX_ ident_too_long);
834a4ddd 5067 if (isALNUM(*s)) /* UTF handled below */
463ee0b2 5068 *d++ = *s++;
834a4ddd 5069 else if (*s == '\'' && isIDFIRST_lazy(s+1)) {
463ee0b2
LW		 5070 *d++ = ':';
5071 *d++ = ':';
5072 s++;
5073 }
a0d0e21e 5074 else if (*s == ':' && s[1] == ':') {
463ee0b2
LW		 5075 *d++ = *s++;
5076 *d++ = *s++;
5077 }
834a4ddd 5078 else if (UTF && *(U8*)s >= 0xc0 && isALNUM_utf8((U8*)s)) {
a0ed51b3 5079 char *t = s + UTF8SKIP(s);
dfe13c55 5080 while (*t & 0x80 && is_utf8_mark((U8*)t))
a0ed51b3
LW		 5081 t += UTF8SKIP(t);
5082 if (d + (t - s) > e)
cea2e8a9 5083 Perl_croak(aTHX_ ident_too_long);
a0ed51b3
LW		 5084 Copy(s, d, t - s, char);
5085 d += t - s;
5086 s = t;
5087 }
463ee0b2
LW		 5088 else
5089 break;
5090 }
378cc40b
LW		 5091 }
5092 *d = '\0';
5093 d = dest;
79072805 5094 if (*d) {
3280af22
NIS		 5095 if (PL_lex_state != LEX_NORMAL)
5096 PL_lex_state = LEX_INTERPENDMAYBE;
79072805 5097 return s;
378cc40b 5098 }
748a9306 5099 if (*s == '$' && s[1] &&
834a4ddd 5100 (isALNUM_lazy(s+1) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
5cd24f17 5101 {
4810e5ec 5102 return s;
5cd24f17 5103 }
79072805
LW		 5104 if (*s == '{') {
5105 bracket = s;
5106 s++;
5107 }
5108 else if (ck_uni)
5109 check_uni();
93a17b20 5110 if (s < send)
79072805
LW		 5111 *d = *s++;
5112 d[1] = '\0';
2b92dfce 5113 if (*d == '^' && *s && isCONTROLVAR(*s)) {
bbce6d69 5114 *d = toCTRL(*s);
5115 s++;
de3bb511 5116 }
79072805 5117 if (bracket) {
748a9306 5118 if (isSPACE(s[-1])) {
fa83b5b6 5119 while (s < send) {
5120 char ch = *s++;
5121 if (ch != ' ' && ch != '\t') {
5122 *d = ch;
5123 break;
5124 }
5125 }
748a9306 5126 }
834a4ddd 5127 if (isIDFIRST_lazy(d)) {
79072805 5128 d++;
a0ed51b3
LW		 5129 if (UTF) {
5130 e = s;
834a4ddd 5131 while (e < send && isALNUM_lazy(e) || *e == ':') {
a0ed51b3 5132 e += UTF8SKIP(e);
dfe13c55 5133 while (e < send && *e & 0x80 && is_utf8_mark((U8*)e))
a0ed51b3
LW		 5134 e += UTF8SKIP(e);
5135 }
5136 Copy(s, d, e - s, char);
5137 d += e - s;
5138 s = e;
5139 }
5140 else {
2b92dfce 5141 while ((isALNUM(*s) || *s == ':') && d < e)
a0ed51b3 5142 *d++ = *s++;
2b92dfce 5143 if (d >= e)
cea2e8a9 5144 Perl_croak(aTHX_ ident_too_long);
a0ed51b3 5145 }
79072805 5146 *d = '\0';
748a9306 5147 while (s < send && (*s == ' ' || *s == '\t')) s++;
ff68c719 5148 if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
d008e5eb 5149 dTHR; /* only for ckWARN */
599cee73 5150 if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
748a9306 5151 char *brack = *s == '[' ? "[...]" : "{...}";
cea2e8a9 5152 Perl_warner(aTHX_ WARN_AMBIGUOUS,
599cee73 5153 "Ambiguous use of %c{%s%s} resolved to %c%s%s",
748a9306
LW		 5154 funny, dest, brack, funny, dest, brack);
5155 }
3280af22 5156 PL_lex_fakebrack = PL_lex_brackets+1;
79072805 5157 bracket++;
3280af22 5158 PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
79072805
LW		 5159 return s;
5160 }
2b92dfce
GS		 5161 }
5162 /* Handle extended ${^Foo} variables
5163 * 1999-02-27 mjd-perl-patch@plover.com */
5164 else if (!isALNUM(*d) && !isPRINT(*d) /* isCTRL(d) */
5165 && isALNUM(*s))
5166 {
5167 d++;
5168 while (isALNUM(*s) && d < e) {
5169 *d++ = *s++;
5170 }
5171 if (d >= e)
cea2e8a9 5172 Perl_croak(aTHX_ ident_too_long);
2b92dfce 5173 *d = '\0';
79072805
LW		 5174 }
5175 if (*s == '}') {
5176 s++;
3280af22
NIS		 5177 if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets)
5178 PL_lex_state = LEX_INTERPEND;
748a9306
LW		 5179 if (funny == '#')
5180 funny = '@';
d008e5eb
GS		 5181 if (PL_lex_state == LEX_NORMAL) {
5182 dTHR; /* only for ckWARN */
5183 if (ckWARN(WARN_AMBIGUOUS) &&
864dbfa3 5184 (keyword(dest, d - dest) || get_cv(dest, FALSE)))
d008e5eb 5185 {
cea2e8a9 5186 Perl_warner(aTHX_ WARN_AMBIGUOUS,
d008e5eb
GS		 5187 "Ambiguous use of %c{%s} resolved to %c%s",
5188 funny, dest, funny, dest);
5189 }
5190 }
79072805
LW		 5191 }
5192 else {
5193 s = bracket; /* let the parser handle it */
93a17b20 5194 *dest = '\0';
79072805
LW		 5195 }
5196 }
3280af22
NIS		 5197 else if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets && !intuit_more(s))
5198 PL_lex_state = LEX_INTERPEND;
378cc40b
LW		 5199 return s;
5200}
5201
cea2e8a9
GS		 5202void
5203Perl_pmflag(pTHX_ U16 *pmfl, int ch)
a0d0e21e 5204{
bbce6d69 5205 if (ch == 'i')
a0d0e21e 5206 *pmfl |= PMf_FOLD;
a0d0e21e
LW		 5207 else if (ch == 'g')
5208 *pmfl |= PMf_GLOBAL;
c90c0ff4 5209 else if (ch == 'c')
5210 *pmfl |= PMf_CONTINUE;
a0d0e21e
LW		 5211 else if (ch == 'o')
5212 *pmfl |= PMf_KEEP;
5213 else if (ch == 'm')
5214 *pmfl |= PMf_MULTILINE;
5215 else if (ch == 's')
5216 *pmfl |= PMf_SINGLELINE;
5217 else if (ch == 'x')
5218 *pmfl |= PMf_EXTENDED;
5219}
378cc40b 5220
76e3520e 5221STATIC char *
cea2e8a9 5222S_scan_pat(pTHX_ char *start, I32 type)
378cc40b 5223{
79072805
LW		 5224 PMOP *pm;
5225 char *s;
378cc40b 5226
79072805
LW		 5227 s = scan_str(start);
5228 if (!s) {
3280af22
NIS		 5229 if (PL_lex_stuff)
5230 SvREFCNT_dec(PL_lex_stuff);
5231 PL_lex_stuff = Nullsv;
cea2e8a9 5232 Perl_croak(aTHX_ "Search pattern not terminated");
378cc40b 5233 }
bbce6d69 5234
8782bef2 5235 pm = (PMOP*)newPMOP(type, 0);
3280af22 5236 if (PL_multi_open == '?')
79072805 5237 pm->op_pmflags |= PMf_ONCE;
8782bef2
GB		 5238 if(type == OP_QR) {
5239 while (*s && strchr("iomsx", *s))
5240 pmflag(&pm->op_pmflags,*s++);
5241 }
5242 else {
5243 while (*s && strchr("iogcmsx", *s))
5244 pmflag(&pm->op_pmflags,*s++);
5245 }
4633a7c4 5246 pm->op_pmpermflags = pm->op_pmflags;
bbce6d69 5247
3280af22 5248 PL_lex_op = (OP*)pm;
79072805 5249 yylval.ival = OP_MATCH;
378cc40b
LW		 5250 return s;
5251}
5252
76e3520e 5253STATIC char *
cea2e8a9 5254S_scan_subst(pTHX_ char *start)
79072805 5255{
a0d0e21e 5256 register char *s;
79072805 5257 register PMOP *pm;
4fdae800 5258 I32 first_start;
79072805
LW		 5259 I32 es = 0;
5260
79072805
LW		 5261 yylval.ival = OP_NULL;
5262
a0d0e21e 5263 s = scan_str(start);
79072805
LW		 5264
5265 if (!s) {
3280af22
NIS		 5266 if (PL_lex_stuff)
5267 SvREFCNT_dec(PL_lex_stuff);
5268 PL_lex_stuff = Nullsv;
cea2e8a9 5269 Perl_croak(aTHX_ "Substitution pattern not terminated");
a687059c 5270 }
79072805 5271
3280af22 5272 if (s[-1] == PL_multi_open)
79072805
LW		 5273 s--;
5274
3280af22 5275 first_start = PL_multi_start;
79072805
LW		 5276 s = scan_str(s);
5277 if (!s) {
3280af22
NIS		 5278 if (PL_lex_stuff)
5279 SvREFCNT_dec(PL_lex_stuff);
5280 PL_lex_stuff = Nullsv;
5281 if (PL_lex_repl)
5282 SvREFCNT_dec(PL_lex_repl);
5283 PL_lex_repl = Nullsv;
cea2e8a9 5284 Perl_croak(aTHX_ "Substitution replacement not terminated");
a687059c 5285 }
3280af22 5286 PL_multi_start = first_start; /* so whole substitution is taken together */
2f3197b3 5287
79072805 5288 pm = (PMOP*)newPMOP(OP_SUBST, 0);
48c036b1 5289 while (*s) {
a687059c
LW		 5290 if (*s == 'e') {
5291 s++;
2f3197b3 5292 es++;
a687059c 5293 }
b3eb6a9b 5294 else if (strchr("iogcmsx", *s))
a0d0e21e 5295 pmflag(&pm->op_pmflags,*s++);
48c036b1
GS		 5296 else
5297 break;
378cc40b 5298 }
79072805
LW		 5299
5300 if (es) {
5301 SV *repl;
0244c3a4
GS		 5302 PL_sublex_info.super_bufptr = s;
5303 PL_sublex_info.super_bufend = PL_bufend;
5304 PL_multi_end = 0;
79072805 5305 pm->op_pmflags |= PMf_EVAL;
79cb57f6 5306 repl = newSVpvn("",0);
463ee0b2 5307 while (es-- > 0)
a0d0e21e 5308 sv_catpv(repl, es ? "eval " : "do ");
79072805 5309 sv_catpvn(repl, "{ ", 2);
3280af22 5310 sv_catsv(repl, PL_lex_repl);
79072805 5311 sv_catpvn(repl, " };", 2);
25da4f38 5312 SvEVALED_on(repl);
3280af22
NIS		 5313 SvREFCNT_dec(PL_lex_repl);
5314 PL_lex_repl = repl;
378cc40b 5315 }
79072805 5316
4633a7c4 5317 pm->op_pmpermflags = pm->op_pmflags;
3280af22 5318 PL_lex_op = (OP*)pm;
79072805 5319 yylval.ival = OP_SUBST;
378cc40b
LW		 5320 return s;
5321}
5322
76e3520e 5323STATIC char *
cea2e8a9 5324S_scan_trans(pTHX_ char *start)
378cc40b 5325{
a0d0e21e 5326 register char* s;
11343788 5327 OP *o;
79072805
LW		 5328 short *tbl;
5329 I32 squash;
a0ed51b3 5330 I32 del;
79072805 5331 I32 complement;
a0ed51b3
LW		 5332 I32 utf8;
5333 I32 count = 0;
79072805
LW		 5334
5335 yylval.ival = OP_NULL;
5336
a0d0e21e 5337 s = scan_str(start);
79072805 5338 if (!s) {
3280af22
NIS		 5339 if (PL_lex_stuff)
5340 SvREFCNT_dec(PL_lex_stuff);
5341 PL_lex_stuff = Nullsv;
cea2e8a9 5342 Perl_croak(aTHX_ "Transliteration pattern not terminated");
a687059c 5343 }
3280af22 5344 if (s[-1] == PL_multi_open)
2f3197b3
LW		 5345 s--;
5346
93a17b20 5347 s = scan_str(s);
79072805 5348 if (!s) {
3280af22
NIS		 5349 if (PL_lex_stuff)
5350 SvREFCNT_dec(PL_lex_stuff);
5351 PL_lex_stuff = Nullsv;
5352 if (PL_lex_repl)
5353 SvREFCNT_dec(PL_lex_repl);
5354 PL_lex_repl = Nullsv;
cea2e8a9 5355 Perl_croak(aTHX_ "Transliteration replacement not terminated");
a687059c 5356 }
79072805 5357
a0ed51b3
LW		 5358 if (UTF) {
5359 o = newSVOP(OP_TRANS, 0, 0);
5360 utf8 = OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF;
5361 }
5362 else {
5363 New(803,tbl,256,short);
5364 o = newPVOP(OP_TRANS, 0, (char*)tbl);
5365 utf8 = 0;
5366 }
2f3197b3 5367
a0ed51b3
LW		 5368 complement = del = squash = 0;
5369 while (strchr("cdsCU", *s)) {
395c3793 5370 if (*s == 'c')
79072805 5371 complement = OPpTRANS_COMPLEMENT;
395c3793 5372 else if (*s == 'd')
a0ed51b3
LW		 5373 del = OPpTRANS_DELETE;
5374 else if (*s == 's')
79072805 5375 squash = OPpTRANS_SQUASH;
a0ed51b3
LW		 5376 else {
5377 switch (count++) {
5378 case 0:
5379 if (*s == 'C')
5380 utf8 &= ~OPpTRANS_FROM_UTF;
5381 else
5382 utf8 |= OPpTRANS_FROM_UTF;
5383 break;
5384 case 1:
5385 if (*s == 'C')
5386 utf8 &= ~OPpTRANS_TO_UTF;
5387 else
5388 utf8 |= OPpTRANS_TO_UTF;
5389 break;
5390 default:
cea2e8a9 5391 Perl_croak(aTHX_ "Too many /C and /U options");
a0ed51b3
LW		 5392 }
5393 }
395c3793
LW		 5394 s++;
5395 }
a0ed51b3 5396 o->op_private = del|squash|complement|utf8;
79072805 5397
3280af22 5398 PL_lex_op = o;
79072805
LW		 5399 yylval.ival = OP_TRANS;
5400 return s;
5401}
5402
76e3520e 5403STATIC char *
cea2e8a9 5404S_scan_heredoc(pTHX_ register char *s)
79072805 5405{
11343788 5406 dTHR;
79072805
LW		 5407 SV *herewas;
5408 I32 op_type = OP_SCALAR;
5409 I32 len;
5410 SV *tmpstr;
5411 char term;
5412 register char *d;
fc36a67e 5413 register char *e;
4633a7c4 5414 char *peek;
3280af22 5415 int outer = (PL_rsfp && !(PL_lex_inwhat == OP_SCALAR));
79072805
LW		 5416
5417 s += 2;
3280af22
NIS		 5418 d = PL_tokenbuf;
5419 e = PL_tokenbuf + sizeof PL_tokenbuf - 1;
fd2d0953 5420 if (!outer)
79072805 5421 *d++ = '\n';
4633a7c4
LW		 5422 for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
5423 if (*peek && strchr("`'\"",*peek)) {
5424 s = peek;
79072805 5425 term = *s++;
3280af22 5426 s = delimcpy(d, e, s, PL_bufend, term, &len);
fc36a67e 5427 d += len;
3280af22 5428 if (s < PL_bufend)
79072805 5429 s++;
79072805
LW		 5430 }
5431 else {
5432 if (*s == '\\')
5433 s++, term = '\'';
5434 else
5435 term = '"';
834a4ddd 5436 if (!isALNUM_lazy(s))
4633a7c4 5437 deprecate("bare << to mean <<\"\"");
834a4ddd 5438 for (; isALNUM_lazy(s); s++) {
fc36a67e 5439 if (d < e)
5440 *d++ = *s;
5441 }
5442 }
3280af22 5443 if (d >= PL_tokenbuf + sizeof PL_tokenbuf - 1)
cea2e8a9 5444 Perl_croak(aTHX_ "Delimiter for here document is too long");
79072805
LW		 5445 *d++ = '\n';
5446 *d = '\0';
3280af22 5447 len = d - PL_tokenbuf;
6a27c188 5448#ifndef PERL_STRICT_CR
f63a84b2
LW		 5449 d = strchr(s, '\r');
5450 if (d) {
5451 char *olds = s;
5452 s = d;
3280af22 5453 while (s < PL_bufend) {
f63a84b2
LW		 5454 if (*s == '\r') {
5455 *d++ = '\n';
5456 if (*++s == '\n')
5457 s++;
5458 }
5459 else if (*s == '\n' && s[1] == '\r') { /* \015\013 on a mac? */
5460 *d++ = *s++;
5461 s++;
5462 }
5463 else
5464 *d++ = *s++;
5465 }
5466 *d = '\0';
3280af22
NIS		 5467 PL_bufend = d;
5468 SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr));
f63a84b2
LW		 5469 s = olds;
5470 }
5471#endif
79072805 5472 d = "\n";
3280af22 5473 if (outer || !(d=ninstr(s,PL_bufend,d,d+1)))
79cb57f6 5474 herewas = newSVpvn(s,PL_bufend-s);
79072805 5475 else
79cb57f6 5476 s--, herewas = newSVpvn(s,d-s);
79072805 5477 s += SvCUR(herewas);
748a9306 5478
8d6dde3e 5479 tmpstr = NEWSV(87,79);
748a9306
LW		 5480 sv_upgrade(tmpstr, SVt_PVIV);
5481 if (term == '\'') {
79072805 5482 op_type = OP_CONST;
748a9306
LW		 5483 SvIVX(tmpstr) = -1;
5484 }
5485 else if (term == '`') {
79072805 5486 op_type = OP_BACKTICK;
748a9306
LW		 5487 SvIVX(tmpstr) = '\\';
5488 }
79072805
LW		 5489
5490 CLINE;
3280af22
NIS		 5491 PL_multi_start = PL_curcop->cop_line;
5492 PL_multi_open = PL_multi_close = '<';
5493 term = *PL_tokenbuf;
0244c3a4
GS		 5494 if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
5495 char *bufptr = PL_sublex_info.super_bufptr;
5496 char *bufend = PL_sublex_info.super_bufend;
5497 char *olds = s - SvCUR(herewas);
5498 s = strchr(bufptr, '\n');
5499 if (!s)
5500 s = bufend;
5501 d = s;
5502 while (s < bufend &&
5503 (*s != term || memNE(s,PL_tokenbuf,len)) ) {
5504 if (*s++ == '\n')
5505 PL_curcop->cop_line++;
5506 }
5507 if (s >= bufend) {
5508 PL_curcop->cop_line = PL_multi_start;
5509 missingterm(PL_tokenbuf);
5510 }
5511 sv_setpvn(herewas,bufptr,d-bufptr+1);
5512 sv_setpvn(tmpstr,d+1,s-d);
5513 s += len - 1;
5514 sv_catpvn(herewas,s,bufend-s);
5515 (void)strcpy(bufptr,SvPVX(herewas));
5516
5517 s = olds;
5518 goto retval;
5519 }
5520 else if (!outer) {
79072805 5521 d = s;
3280af22
NIS		 5522 while (s < PL_bufend &&
5523 (*s != term || memNE(s,PL_tokenbuf,len)) ) {
79072805 5524 if (*s++ == '\n')
3280af22 5525 PL_curcop->cop_line++;
79072805 5526 }
3280af22
NIS		 5527 if (s >= PL_bufend) {
5528 PL_curcop->cop_line = PL_multi_start;
5529 missingterm(PL_tokenbuf);
79072805
LW		 5530 }
5531 sv_setpvn(tmpstr,d+1,s-d);
5532 s += len - 1;
3280af22 5533 PL_curcop->cop_line++; /* the preceding stmt passes a newline */
49d8d3a1 5534
3280af22
NIS		 5535 sv_catpvn(herewas,s,PL_bufend-s);
5536 sv_setsv(PL_linestr,herewas);
5537 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
5538 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
79072805
LW		 5539 }
5540 else
5541 sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */
3280af22 5542 while (s >= PL_bufend) { /* multiple line string? */
fd2d0953 5543 if (!outer ||
3280af22
NIS		 5544 !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
5545 PL_curcop->cop_line = PL_multi_start;
5546 missingterm(PL_tokenbuf);
79072805 5547 }
3280af22
NIS		 5548 PL_curcop->cop_line++;
5549 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
6a27c188 5550#ifndef PERL_STRICT_CR
3280af22 5551 if (PL_bufend - PL_linestart >= 2) {
a1529941
NIS		 5552 if ((PL_bufend[-2] == '\r' && PL_bufend[-1] == '\n') ||
5553 (PL_bufend[-2] == '\n' && PL_bufend[-1] == '\r'))
c6f14548 5554 {
3280af22
NIS		 5555 PL_bufend[-2] = '\n';
5556 PL_bufend--;
5557 SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr));
f63a84b2 5558 }
3280af22
NIS		 5559 else if (PL_bufend[-1] == '\r')
5560 PL_bufend[-1] = '\n';
f63a84b2 5561 }
3280af22
NIS		 5562 else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
5563 PL_bufend[-1] = '\n';
f63a84b2 5564#endif
3280af22 5565 if (PERLDB_LINE && PL_curstash != PL_debstash) {
79072805
LW		 5566 SV *sv = NEWSV(88,0);
5567
93a17b20 5568 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 5569 sv_setsv(sv,PL_linestr);
5570 av_store(GvAV(PL_curcop->cop_filegv),
5571 (I32)PL_curcop->cop_line,sv);
79072805 5572 }
3280af22
NIS		 5573 if (*s == term && memEQ(s,PL_tokenbuf,len)) {
5574 s = PL_bufend - 1;
79072805 5575 *s = ' ';
3280af22
NIS		 5576 sv_catsv(PL_linestr,herewas);
5577 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
79072805
LW		 5578 }
5579 else {
3280af22
NIS		 5580 s = PL_bufend;
5581 sv_catsv(tmpstr,PL_linestr);
395c3793
LW		 5582 }
5583 }
79072805 5584 s++;
0244c3a4
GS		 5585retval:
5586 PL_multi_end = PL_curcop->cop_line;
79072805
LW		 5587 if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
5588 SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
463ee0b2 5589 Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
79072805 5590 }
8990e307 5591 SvREFCNT_dec(herewas);
3280af22 5592 PL_lex_stuff = tmpstr;
79072805
LW		 5593 yylval.ival = op_type;
5594 return s;
5595}
5596
02aa26ce
NT		 5597/* scan_inputsymbol
5598 takes: current position in input buffer
5599 returns: new position in input buffer
5600 side-effects: yylval and lex_op are set.
5601
5602 This code handles:
5603
5604 <> read from ARGV
5605 <FH> read from filehandle
5606 <pkg::FH> read from package qualified filehandle
5607 <pkg'FH> read from package qualified filehandle
5608 <$fh> read from filehandle in $fh
5609 <*.h> filename glob
5610
5611*/
5612
76e3520e 5613STATIC char *
cea2e8a9 5614S_scan_inputsymbol(pTHX_ char *start)
79072805 5615{
02aa26ce 5616 register char *s = start; /* current position in buffer */
79072805 5617 register char *d;
fc36a67e 5618 register char *e;
1b420867 5619 char *end;
79072805
LW		 5620 I32 len;
5621
3280af22
NIS		 5622 d = PL_tokenbuf; /* start of temp holding space */
5623 e = PL_tokenbuf + sizeof PL_tokenbuf; /* end of temp holding space */
1b420867
GS		 5624 end = strchr(s, '\n');
5625 if (!end)
5626 end = PL_bufend;
5627 s = delimcpy(d, e, s + 1, end, '>', &len); /* extract until > */
02aa26ce
NT		 5628
5629 /* die if we didn't have space for the contents of the <>,
1b420867 5630 or if it didn't end, or if we see a newline
02aa26ce
NT		 5631 */
5632
3280af22 5633 if (len >= sizeof PL_tokenbuf)
cea2e8a9 5634 Perl_croak(aTHX_ "Excessively long <> operator");
1b420867 5635 if (s >= end)
cea2e8a9 5636 Perl_croak(aTHX_ "Unterminated <> operator");
02aa26ce 5637
fc36a67e 5638 s++;
02aa26ce
NT		 5639
5640 /* check for <$fh>
5641 Remember, only scalar variables are interpreted as filehandles by
5642 this code. Anything more complex (e.g., <$fh{$num}>) will be
5643 treated as a glob() call.
5644 This code makes use of the fact that except for the $ at the front,
5645 a scalar variable and a filehandle look the same.
5646 */
4633a7c4 5647 if (*d == '$' && d[1]) d++;
02aa26ce
NT		 5648
5649 /* allow <Pkg'VALUE> or <Pkg::VALUE> */
834a4ddd 5650 while (*d && (isALNUM_lazy(d) || *d == '\'' || *d == ':'))
79072805 5651 d++;
02aa26ce
NT		 5652
5653 /* If we've tried to read what we allow filehandles to look like, and
5654 there's still text left, then it must be a glob() and not a getline.
5655 Use scan_str to pull out the stuff between the <> and treat it
5656 as nothing more than a string.
5657 */
5658
3280af22 5659 if (d - PL_tokenbuf != len) {
79072805
LW		 5660 yylval.ival = OP_GLOB;
5661 set_csh();
5662 s = scan_str(start);
5663 if (!s)
cea2e8a9 5664 Perl_croak(aTHX_ "Glob not terminated");
79072805
LW		 5665 return s;
5666 }
395c3793 5667 else {
02aa26ce 5668 /* we're in a filehandle read situation */
3280af22 5669 d = PL_tokenbuf;
02aa26ce
NT		 5670
5671 /* turn <> into <ARGV> */
79072805
LW		 5672 if (!len)
5673 (void)strcpy(d,"ARGV");
02aa26ce
NT		 5674
5675 /* if <$fh>, create the ops to turn the variable into a
5676 filehandle
5677 */
79072805 5678 if (*d == '$') {
a0d0e21e 5679 I32 tmp;
02aa26ce
NT		 5680
5681 /* try to find it in the pad for this block, otherwise find
5682 add symbol table ops
5683 */
11343788
MB		 5684 if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
5685 OP *o = newOP(OP_PADSV, 0);
5686 o->op_targ = tmp;
f5284f61 5687 PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, o);
a0d0e21e
LW		 5688 }
5689 else {
5690 GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
3280af22 5691 PL_lex_op = (OP*)newUNOP(OP_READLINE, 0,
a0d0e21e 5692 newUNOP(OP_RV2SV, 0,
f5284f61 5693 newGVOP(OP_GV, 0, gv)));
a0d0e21e 5694 }
f5284f61
IZ		 5695 PL_lex_op->op_flags |= OPf_SPECIAL;
5696 /* we created the ops in PL_lex_op, so make yylval.ival a null op */
79072805
LW		 5697 yylval.ival = OP_NULL;
5698 }
02aa26ce
NT		 5699
5700 /* If it's none of the above, it must be a literal filehandle
5701 (<Foo::BAR> or <FOO>) so build a simple readline OP */
79072805 5702 else {
85e6fe83 5703 GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO);
3280af22 5704 PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
79072805
LW		 5705 yylval.ival = OP_NULL;
5706 }
5707 }
02aa26ce 5708
79072805
LW		 5709 return s;
5710}
5711
02aa26ce
NT		 5712
5713/* scan_str
5714 takes: start position in buffer
5715 returns: position to continue reading from buffer
5716 side-effects: multi_start, multi_close, lex_repl or lex_stuff, and
5717 updates the read buffer.
5718
5719 This subroutine pulls a string out of the input. It is called for:
5720 q single quotes q(literal text)
5721 ' single quotes 'literal text'
5722 qq double quotes qq(interpolate $here please)
5723 " double quotes "interpolate $here please"
5724 qx backticks qx(/bin/ls -l)
5725 ` backticks `/bin/ls -l`
5726 qw quote words @EXPORT_OK = qw( func() $spam )
5727 m// regexp match m/this/
5728 s/// regexp substitute s/this/that/
5729 tr/// string transliterate tr/this/that/
5730 y/// string transliterate y/this/that/
5731 ($*@) sub prototypes sub foo ($)
5732 <> readline or globs <FOO>, <>, <$fh>, or <*.c>
5733
5734 In most of these cases (all but <>, patterns and transliterate)
5735 yylex() calls scan_str(). m// makes yylex() call scan_pat() which
5736 calls scan_str(). s/// makes yylex() call scan_subst() which calls
5737 scan_str(). tr/// and y/// make yylex() call scan_trans() which
5738 calls scan_str().
5739
5740 It skips whitespace before the string starts, and treats the first
5741 character as the delimiter. If the delimiter is one of ([{< then
5742 the corresponding "close" character )]}> is used as the closing
5743 delimiter. It allows quoting of delimiters, and if the string has
5744 balanced delimiters ([{<>}]) it allows nesting.
5745
5746 The lexer always reads these strings into lex_stuff, except in the
5747 case of the operators which take *two* arguments (s/// and tr///)
5748 when it checks to see if lex_stuff is full (presumably with the 1st
5749 arg to s or tr) and if so puts the string into lex_repl.
5750
5751*/
5752
76e3520e 5753STATIC char *
cea2e8a9 5754S_scan_str(pTHX_ char *start)
79072805 5755{
11343788 5756 dTHR;
02aa26ce
NT		 5757 SV *sv; /* scalar value: string */
5758 char *tmps; /* temp string, used for delimiter matching */
5759 register char *s = start; /* current position in the buffer */
5760 register char term; /* terminating character */
5761 register char *to; /* current position in the sv's data */
5762 I32 brackets = 1; /* bracket nesting level */
5763
5764 /* skip space before the delimiter */
fb73857a 5765 if (isSPACE(*s))
5766 s = skipspace(s);
02aa26ce
NT		 5767
5768 /* mark where we are, in case we need to report errors */
79072805 5769 CLINE;
02aa26ce
NT		 5770
5771 /* after skipping whitespace, the next character is the terminator */
a0d0e21e 5772 term = *s;
02aa26ce 5773 /* mark where we are */
3280af22
NIS		 5774 PL_multi_start = PL_curcop->cop_line;
5775 PL_multi_open = term;
02aa26ce
NT		 5776
5777 /* find corresponding closing delimiter */
93a17b20 5778 if (term && (tmps = strchr("([{< )]}> )]}>",term)))
79072805 5779 term = tmps[5];
3280af22 5780 PL_multi_close = term;
79072805 5781
02aa26ce 5782 /* create a new SV to hold the contents. 87 is leak category, I'm
8d6dde3e
IZ		 5783 assuming. 79 is the SV's initial length. What a random number. */
5784 sv = NEWSV(87,79);
ed6116ce
LW		 5785 sv_upgrade(sv, SVt_PVIV);
5786 SvIVX(sv) = term;
a0d0e21e 5787 (void)SvPOK_only(sv); /* validate pointer */
02aa26ce
NT		 5788
5789 /* move past delimiter and try to read a complete string */
93a17b20
LW		 5790 s++;
5791 for (;;) {
02aa26ce 5792 /* extend sv if need be */
3280af22 5793 SvGROW(sv, SvCUR(sv) + (PL_bufend - s) + 1);
02aa26ce 5794 /* set 'to' to the next character in the sv's string */
463ee0b2 5795 to = SvPVX(sv)+SvCUR(sv);
02aa26ce
NT		 5796
5797 /* if open delimiter is the close delimiter read unbridle */
3280af22
NIS		 5798 if (PL_multi_open == PL_multi_close) {
5799 for (; s < PL_bufend; s++,to++) {
02aa26ce 5800 /* embedded newlines increment the current line number */
3280af22
NIS		 5801 if (*s == '\n' && !PL_rsfp)
5802 PL_curcop->cop_line++;
02aa26ce 5803 /* handle quoted delimiters */
3280af22 5804 if (*s == '\\' && s+1 < PL_bufend && term != '\\') {
a0d0e21e
LW		 5805 if (s[1] == term)
5806 s++;
02aa26ce 5807 /* any other quotes are simply copied straight through */
a0d0e21e
LW		 5808 else
5809 *to++ = *s++;
5810 }
02aa26ce
NT		 5811 /* terminate when run out of buffer (the for() condition), or
5812 have found the terminator */
93a17b20
LW		 5813 else if (*s == term)
5814 break;
5815 *to = *s;
5816 }
5817 }
02aa26ce
NT		 5818
5819 /* if the terminator isn't the same as the start character (e.g.,
5820 matched brackets), we have to allow more in the quoting, and
5821 be prepared for nested brackets.
5822 */
93a17b20 5823 else {
02aa26ce 5824 /* read until we run out of string, or we find the terminator */
3280af22 5825 for (; s < PL_bufend; s++,to++) {
02aa26ce 5826 /* embedded newlines increment the line count */
3280af22
NIS		 5827 if (*s == '\n' && !PL_rsfp)
5828 PL_curcop->cop_line++;
02aa26ce 5829 /* backslashes can escape the open or closing characters */
3280af22
NIS		 5830 if (*s == '\\' && s+1 < PL_bufend) {
5831 if ((s[1] == PL_multi_open) || (s[1] == PL_multi_close))
a0d0e21e
LW		 5832 s++;
5833 else
5834 *to++ = *s++;
5835 }
02aa26ce 5836 /* allow nested opens and closes */
3280af22 5837 else if (*s == PL_multi_close && --brackets <= 0)
93a17b20 5838 break;
3280af22 5839 else if (*s == PL_multi_open)
93a17b20
LW		 5840 brackets++;
5841 *to = *s;
5842 }
5843 }
02aa26ce 5844 /* terminate the copied string and update the sv's end-of-string */
93a17b20 5845 *to = '\0';
463ee0b2 5846 SvCUR_set(sv, to - SvPVX(sv));
93a17b20 5847
02aa26ce
NT		 5848 /*
5849 * this next chunk reads more into the buffer if we're not done yet
5850 */
5851
3280af22 5852 if (s < PL_bufend) break; /* handle case where we are done yet :-) */
79072805 5853
6a27c188 5854#ifndef PERL_STRICT_CR
f63a84b2 5855 if (to - SvPVX(sv) >= 2) {
c6f14548
GS		 5856 if ((to[-2] == '\r' && to[-1] == '\n') ||
5857 (to[-2] == '\n' && to[-1] == '\r'))
5858 {
f63a84b2
LW		 5859 to[-2] = '\n';
5860 to--;
5861 SvCUR_set(sv, to - SvPVX(sv));
5862 }
5863 else if (to[-1] == '\r')
5864 to[-1] = '\n';
5865 }
5866 else if (to - SvPVX(sv) == 1 && to[-1] == '\r')
5867 to[-1] = '\n';
5868#endif
5869
02aa26ce
NT		 5870 /* if we're out of file, or a read fails, bail and reset the current
5871 line marker so we can report where the unterminated string began
5872 */
3280af22
NIS		 5873 if (!PL_rsfp ||
5874 !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
c07a80fd 5875 sv_free(sv);
3280af22 5876 PL_curcop->cop_line = PL_multi_start;
79072805
LW		 5877 return Nullch;
5878 }
02aa26ce 5879 /* we read a line, so increment our line counter */
3280af22 5880 PL_curcop->cop_line++;
a0ed51b3 5881
02aa26ce 5882 /* update debugger info */
3280af22 5883 if (PERLDB_LINE && PL_curstash != PL_debstash) {
79072805
LW		 5884 SV *sv = NEWSV(88,0);
5885
93a17b20 5886 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 5887 sv_setsv(sv,PL_linestr);
5888 av_store(GvAV(PL_curcop->cop_filegv),
5889 (I32)PL_curcop->cop_line, sv);
395c3793 5890 }
a0ed51b3 5891
3280af22
NIS		 5892 /* having changed the buffer, we must update PL_bufend */
5893 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
378cc40b 5894 }
02aa26ce
NT		 5895
5896 /* at this point, we have successfully read the delimited string */
5897
3280af22 5898 PL_multi_end = PL_curcop->cop_line;
79072805 5899 s++;
02aa26ce
NT		 5900
5901 /* if we allocated too much space, give some back */
93a17b20
LW		 5902 if (SvCUR(sv) + 5 < SvLEN(sv)) {
5903 SvLEN_set(sv, SvCUR(sv) + 1);
463ee0b2 5904 Renew(SvPVX(sv), SvLEN(sv), char);
79072805 5905 }
02aa26ce
NT		 5906
5907 /* decide whether this is the first or second quoted string we've read
5908 for this op
5909 */
5910
3280af22
NIS		 5911 if (PL_lex_stuff)
5912 PL_lex_repl = sv;
79072805 5913 else
3280af22 5914 PL_lex_stuff = sv;
378cc40b
LW		 5915 return s;
5916}
5917
02aa26ce
NT		 5918/*
5919 scan_num
5920 takes: pointer to position in buffer
5921 returns: pointer to new position in buffer
5922 side-effects: builds ops for the constant in yylval.op
5923
5924 Read a number in any of the formats that Perl accepts:
5925
4f19785b 5926 0(x[0-7A-F]+)|([0-7]+)|(b[01])
02aa26ce
NT		 5927 [\d_]+(\.[\d_]*)?[Ee](\d+)
5928
5929 Underbars (_) are allowed in decimal numbers. If -w is on,
5930 underbars before a decimal point must be at three digit intervals.
5931
3280af22 5932 Like most scan_ routines, it uses the PL_tokenbuf buffer to hold the
02aa26ce
NT		 5933 thing it reads.
5934
5935 If it reads a number without a decimal point or an exponent, it will
5936 try converting the number to an integer and see if it can do so
5937 without loss of precision.
5938*/
5939
378cc40b 5940char *
864dbfa3 5941Perl_scan_num(pTHX_ char *start)
378cc40b 5942{
02aa26ce
NT		 5943 register char *s = start; /* current position in buffer */
5944 register char *d; /* destination in temp buffer */
5945 register char *e; /* end of temp buffer */
5946 I32 tryiv; /* used to see if it can be an int */
5947 double value; /* number read, as a double */
5948 SV *sv; /* place to put the converted number */
5949 I32 floatit; /* boolean: int or float? */
5950 char *lastub = 0; /* position of last underbar */
fc36a67e 5951 static char number_too_long[] = "Number too long";
378cc40b 5952
02aa26ce
NT		 5953 /* We use the first character to decide what type of number this is */
5954
378cc40b 5955 switch (*s) {
79072805 5956 default:
cea2e8a9 5957 Perl_croak(aTHX_ "panic: scan_num");
02aa26ce
NT		 5958
5959 /* if it starts with a 0, it could be an octal number, a decimal in
4f19785b 5960 0.13 disguise, or a hexadecimal number, or a binary number.
02aa26ce 5961 */
378cc40b
LW		 5962 case '0':
5963 {
02aa26ce
NT		 5964 /* variables:
5965 u holds the "number so far"
4f19785b
WSI		 5966 shift the power of 2 of the base
5967 (hex == 4, octal == 3, binary == 1)
02aa26ce
NT		 5968 overflowed was the number more than we can hold?
5969
5970 Shift is used when we add a digit. It also serves as an "are
4f19785b
WSI		 5971 we in octal/hex/binary?" indicator to disallow hex characters
5972 when in octal mode.
02aa26ce 5973 */
55497cff 5974 UV u;
79072805 5975 I32 shift;
55497cff 5976 bool overflowed = FALSE;
378cc40b 5977
02aa26ce 5978 /* check for hex */
378cc40b
LW		 5979 if (s[1] == 'x') {
5980 shift = 4;
5981 s += 2;
4f19785b
WSI		 5982 } else if (s[1] == 'b') {
5983 shift = 1;
5984 s += 2;
378cc40b 5985 }
02aa26ce 5986 /* check for a decimal in disguise */
378cc40b
LW		 5987 else if (s[1] == '.')
5988 goto decimal;
02aa26ce 5989 /* so it must be octal */
378cc40b
LW		 5990 else
5991 shift = 3;
55497cff 5992 u = 0;
02aa26ce 5993
4f19785b 5994 /* read the rest of the number */
378cc40b 5995 for (;;) {
02aa26ce 5996 UV n, b; /* n is used in the overflow test, b is the digit we're adding on */
55497cff 5997
378cc40b 5998 switch (*s) {
02aa26ce
NT		 5999
6000 /* if we don't mention it, we're done */
378cc40b
LW		 6001 default:
6002 goto out;
02aa26ce
NT		 6003
6004 /* _ are ignored */
de3bb511
LW		 6005 case '_':
6006 s++;
6007 break;
02aa26ce
NT		 6008
6009 /* 8 and 9 are not octal */
378cc40b 6010 case '8': case '9':
4f19785b 6011 if (shift == 3)
cea2e8a9 6012 yyerror(Perl_form(aTHX_ "Illegal octal digit '%c'", *s));
4f19785b
WSI		 6013 else
6014 if (shift == 1)
cea2e8a9 6015 yyerror(Perl_form(aTHX_ "Illegal binary digit '%c'", *s));
378cc40b 6016 /* FALL THROUGH */
02aa26ce
NT		 6017
6018 /* octal digits */
4f19785b 6019 case '2': case '3': case '4':
378cc40b 6020 case '5': case '6': case '7':
4f19785b 6021 if (shift == 1)
cea2e8a9 6022 yyerror(Perl_form(aTHX_ "Illegal binary digit '%c'", *s));
4f19785b
WSI		 6023 /* FALL THROUGH */
6024
6025 case '0': case '1':
02aa26ce 6026 b = *s++ & 15; /* ASCII digit -> value of digit */
55497cff 6027 goto digit;
02aa26ce
NT		 6028
6029 /* hex digits */
378cc40b
LW		 6030 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
6031 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
02aa26ce 6032 /* make sure they said 0x */
378cc40b
LW		 6033 if (shift != 4)
6034 goto out;
55497cff 6035 b = (*s++ & 7) + 9;
02aa26ce
NT		 6036
6037 /* Prepare to put the digit we have onto the end
6038 of the number so far. We check for overflows.
6039 */
6040
55497cff 6041 digit:
02aa26ce 6042 n = u << shift; /* make room for the digit */
b3ac6de7 6043 if (!overflowed && (n >> shift) != u
3280af22 6044 && !(PL_hints & HINT_NEW_BINARY)) {
cea2e8a9 6045 Perl_warn(aTHX_ "Integer overflow in %s number",
4f19785b
WSI		 6046 (shift == 4) ? "hex"
6047 : ((shift == 3) ? "octal" : "binary"));
55497cff 6048 overflowed = TRUE;
6049 }
02aa26ce 6050 u = n | b; /* add the digit to the end */
378cc40b
LW		 6051 break;
6052 }
6053 }
02aa26ce
NT		 6054
6055 /* if we get here, we had success: make a scalar value from
6056 the number.
6057 */
378cc40b 6058 out:
79072805 6059 sv = NEWSV(92,0);
55497cff 6060 sv_setuv(sv, u);
3280af22 6061 if ( PL_hints & HINT_NEW_BINARY)
b3ac6de7 6062 sv = new_constant(start, s - start, "binary", sv, Nullsv, NULL);
378cc40b
LW		 6063 }
6064 break;
02aa26ce
NT		 6065
6066 /*
6067 handle decimal numbers.
6068 we're also sent here when we read a 0 as the first digit
6069 */
378cc40b
LW		 6070 case '1': case '2': case '3': case '4': case '5':
6071 case '6': case '7': case '8': case '9': case '.':
6072 decimal:
3280af22
NIS		 6073 d = PL_tokenbuf;
6074 e = PL_tokenbuf + sizeof PL_tokenbuf - 6; /* room for various punctuation */
79072805 6075 floatit = FALSE;
02aa26ce
NT		 6076
6077 /* read next group of digits and _ and copy into d */
de3bb511 6078 while (isDIGIT(*s) || *s == '_') {
02aa26ce
NT		 6079 /* skip underscores, checking for misplaced ones
6080 if -w is on
6081 */
93a17b20 6082 if (*s == '_') {
d008e5eb 6083 dTHR; /* only for ckWARN */
599cee73 6084 if (ckWARN(WARN_SYNTAX) && lastub && s - lastub != 3)
cea2e8a9 6085 Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number");
93a17b20
LW		 6086 lastub = ++s;
6087 }
fc36a67e 6088 else {
02aa26ce 6089 /* check for end of fixed-length buffer */
fc36a67e 6090 if (d >= e)
cea2e8a9 6091 Perl_croak(aTHX_ number_too_long);
02aa26ce 6092 /* if we're ok, copy the character */
378cc40b 6093 *d++ = *s++;
fc36a67e 6094 }
378cc40b 6095 }
02aa26ce
NT		 6096
6097 /* final misplaced underbar check */
d008e5eb
GS		 6098 if (lastub && s - lastub != 3) {
6099 dTHR;
6100 if (ckWARN(WARN_SYNTAX))
cea2e8a9 6101 Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number");
d008e5eb 6102 }
02aa26ce
NT		 6103
6104 /* read a decimal portion if there is one. avoid
6105 3..5 being interpreted as the number 3. followed
6106 by .5
6107 */
2f3197b3 6108 if (*s == '.' && s[1] != '.') {
79072805 6109 floatit = TRUE;
378cc40b 6110 *d++ = *s++;
02aa26ce
NT		 6111
6112 /* copy, ignoring underbars, until we run out of
6113 digits. Note: no misplaced underbar checks!
6114 */
fc36a67e 6115 for (; isDIGIT(*s) || *s == '_'; s++) {
02aa26ce 6116 /* fixed length buffer check */
fc36a67e 6117 if (d >= e)
cea2e8a9 6118 Perl_croak(aTHX_ number_too_long);
fc36a67e 6119 if (*s != '_')
6120 *d++ = *s;
378cc40b
LW		 6121 }
6122 }
02aa26ce
NT		 6123
6124 /* read exponent part, if present */
93a17b20 6125 if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
79072805
LW		 6126 floatit = TRUE;
6127 s++;
02aa26ce
NT		 6128
6129 /* regardless of whether user said 3E5 or 3e5, use lower 'e' */
79072805 6130 *d++ = 'e'; /* At least some Mach atof()s don't grok 'E' */
02aa26ce
NT		 6131
6132 /* allow positive or negative exponent */
378cc40b
LW		 6133 if (*s == '+' || *s == '-')
6134 *d++ = *s++;
02aa26ce
NT		 6135
6136 /* read digits of exponent (no underbars :-) */
fc36a67e 6137 while (isDIGIT(*s)) {
6138 if (d >= e)
cea2e8a9 6139 Perl_croak(aTHX_ number_too_long);
378cc40b 6140 *d++ = *s++;
fc36a67e 6141 }
378cc40b 6142 }
02aa26ce
NT		 6143
6144 /* terminate the string */
378cc40b 6145 *d = '\0';
02aa26ce
NT		 6146
6147 /* make an sv from the string */
79072805 6148 sv = NEWSV(92,0);
02aa26ce 6149 /* reset numeric locale in case we were earlier left in Swaziland */
36477c24 6150 SET_NUMERIC_STANDARD();
3280af22 6151 value = atof(PL_tokenbuf);
02aa26ce
NT		 6152
6153 /*
6154 See if we can make do with an integer value without loss of
6155 precision. We use I_V to cast to an int, because some
6156 compilers have issues. Then we try casting it back and see
6157 if it was the same. We only do this if we know we
6158 specifically read an integer.
6159
6160 Note: if floatit is true, then we don't need to do the
6161 conversion at all.
6162 */
1e422769 6163 tryiv = I_V(value);
6164 if (!floatit && (double)tryiv == value)
6165 sv_setiv(sv, tryiv);
2f3197b3 6166 else
1e422769 6167 sv_setnv(sv, value);
3280af22
NIS		 6168 if ( floatit ? (PL_hints & HINT_NEW_FLOAT) : (PL_hints & HINT_NEW_INTEGER) )
6169 sv = new_constant(PL_tokenbuf, d - PL_tokenbuf,
b3ac6de7 6170 (floatit ? "float" : "integer"), sv, Nullsv, NULL);
378cc40b 6171 break;
79072805 6172 }
a687059c 6173
02aa26ce
NT		 6174 /* make the op for the constant and return */
6175
79072805 6176 yylval.opval = newSVOP(OP_CONST, 0, sv);
a687059c 6177
378cc40b
LW		 6178 return s;
6179}
6180
76e3520e 6181STATIC char *
cea2e8a9 6182S_scan_formline(pTHX_ register char *s)
378cc40b 6183{
11343788 6184 dTHR;
79072805 6185 register char *eol;
378cc40b 6186 register char *t;
79cb57f6 6187 SV *stuff = newSVpvn("",0);
79072805 6188 bool needargs = FALSE;
378cc40b 6189
79072805 6190 while (!needargs) {
85e6fe83 6191 if (*s == '.' || *s == '}') {
79072805 6192 /*SUPPRESS 530*/
51882d45
GS		 6193#ifdef PERL_STRICT_CR
6194 for (t = s+1;*t == ' ' || *t == '\t'; t++) ;
6195#else
6196 for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ;
6197#endif
6a65c6a0 6198 if (*t == '\n' || t == PL_bufend)
79072805
LW		 6199 break;
6200 }
3280af22 6201 if (PL_in_eval && !PL_rsfp) {
93a17b20 6202 eol = strchr(s,'\n');
0f85fab0 6203 if (!eol++)
3280af22 6204 eol = PL_bufend;
0f85fab0
LW		 6205 }
6206 else
3280af22 6207 eol = PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
79072805 6208 if (*s != '#') {
a0d0e21e
LW		 6209 for (t = s; t < eol; t++) {
6210 if (*t == '~' && t[1] == '~' && SvCUR(stuff)) {
6211 needargs = FALSE;
6212 goto enough; /* ~~ must be first line in formline */
378cc40b 6213 }
a0d0e21e
LW		 6214 if (*t == '@' || *t == '^')
6215 needargs = TRUE;
378cc40b 6216 }
a0d0e21e 6217 sv_catpvn(stuff, s, eol-s);
79072805
LW		 6218 }
6219 s = eol;
3280af22
NIS		 6220 if (PL_rsfp) {
6221 s = filter_gets(PL_linestr, PL_rsfp, 0);
6222 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
6223 PL_bufend = PL_bufptr + SvCUR(PL_linestr);
79072805 6224 if (!s) {
3280af22 6225 s = PL_bufptr;
79072805 6226 yyerror("Format not terminated");
378cc40b
LW		 6227 break;
6228 }
378cc40b 6229 }
463ee0b2 6230 incline(s);
79072805 6231 }
a0d0e21e
LW		 6232 enough:
6233 if (SvCUR(stuff)) {
3280af22 6234 PL_expect = XTERM;
79072805 6235 if (needargs) {
3280af22
NIS		 6236 PL_lex_state = LEX_NORMAL;
6237 PL_nextval[PL_nexttoke].ival = 0;
79072805
LW		 6238 force_next(',');
6239 }
a0d0e21e 6240 else
3280af22
NIS		 6241 PL_lex_state = LEX_FORMLINE;
6242 PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
79072805 6243 force_next(THING);
3280af22 6244 PL_nextval[PL_nexttoke].ival = OP_FORMLINE;
79072805 6245 force_next(LSTOP);
378cc40b 6246 }
79072805 6247 else {
8990e307 6248 SvREFCNT_dec(stuff);
3280af22
NIS		 6249 PL_lex_formbrack = 0;
6250 PL_bufptr = s;
79072805
LW		 6251 }
6252 return s;
378cc40b 6253}
a687059c 6254
76e3520e 6255STATIC void
cea2e8a9 6256S_set_csh(pTHX)
a687059c 6257{
ae986130 6258#ifdef CSH
3280af22
NIS		 6259 if (!PL_cshlen)
6260 PL_cshlen = strlen(PL_cshname);
ae986130 6261#endif
a687059c 6262}
463ee0b2 6263
ba6d6ac9 6264I32
864dbfa3 6265Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
8990e307 6266{
11343788 6267 dTHR;
3280af22
NIS		 6268 I32 oldsavestack_ix = PL_savestack_ix;
6269 CV* outsidecv = PL_compcv;
748a9306 6270 AV* comppadlist;
8990e307 6271
3280af22
NIS		 6272 if (PL_compcv) {
6273 assert(SvTYPE(PL_compcv) == SVt_PVCV);
e9a444f0 6274 }
3280af22
NIS		 6275 save_I32(&PL_subline);
6276 save_item(PL_subname);
6277 SAVEI32(PL_padix);
6278 SAVESPTR(PL_curpad);
6279 SAVESPTR(PL_comppad);
6280 SAVESPTR(PL_comppad_name);
6281 SAVESPTR(PL_compcv);
6282 SAVEI32(PL_comppad_name_fill);
6283 SAVEI32(PL_min_intro_pending);
6284 SAVEI32(PL_max_intro_pending);
6285 SAVEI32(PL_pad_reset_pending);
6286
6287 PL_compcv = (CV*)NEWSV(1104,0);
6288 sv_upgrade((SV *)PL_compcv, is_format ? SVt_PVFM : SVt_PVCV);
6289 CvFLAGS(PL_compcv) |= flags;
6290
6291 PL_comppad = newAV();
6292 av_push(PL_comppad, Nullsv);
6293 PL_curpad = AvARRAY(PL_comppad);
6294 PL_comppad_name = newAV();
6295 PL_comppad_name_fill = 0;
6296 PL_min_intro_pending = 0;
6297 PL_padix = 0;
6298 PL_subline = PL_curcop->cop_line;
6d4ff0d2 6299#ifdef USE_THREADS
79cb57f6 6300 av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
533c011a
NIS		 6301 PL_curpad[0] = (SV*)newAV();
6302 SvPADMY_on(PL_curpad[0]); /* XXX Needed? */
6d4ff0d2 6303#endif /* USE_THREADS */
748a9306
LW		 6304
6305 comppadlist = newAV();
6306 AvREAL_off(comppadlist);
3280af22
NIS		 6307 av_store(comppadlist, 0, (SV*)PL_comppad_name);
6308 av_store(comppadlist, 1, (SV*)PL_comppad);
748a9306 6309
3280af22
NIS		 6310 CvPADLIST(PL_compcv) = comppadlist;
6311 CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv);
11343788 6312#ifdef USE_THREADS
533c011a
NIS		 6313 CvOWNER(PL_compcv) = 0;
6314 New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
6315 MUTEX_INIT(CvMUTEXP(PL_compcv));
11343788 6316#endif /* USE_THREADS */
748a9306 6317
8990e307
LW		 6318 return oldsavestack_ix;
6319}
6320
6321int
864dbfa3 6322Perl_yywarn(pTHX_ char *s)
8990e307 6323{
11343788 6324 dTHR;
3280af22 6325 --PL_error_count;
faef0170 6326 PL_in_eval |= EVAL_WARNONLY;
748a9306 6327 yyerror(s);
faef0170 6328 PL_in_eval &= ~EVAL_WARNONLY;
748a9306 6329 return 0;
8990e307
LW		 6330}
6331
6332int
864dbfa3 6333Perl_yyerror(pTHX_ char *s)
463ee0b2 6334{
11343788 6335 dTHR;
68dc0745 6336 char *where = NULL;
6337 char *context = NULL;
6338 int contlen = -1;
46fc3d4c 6339 SV *msg;
463ee0b2 6340
3280af22 6341 if (!yychar || (yychar == ';' && !PL_rsfp))
54310121 6342 where = "at EOF";
3280af22
NIS		 6343 else if (PL_bufptr > PL_oldoldbufptr && PL_bufptr - PL_oldoldbufptr < 200 &&
6344 PL_oldoldbufptr != PL_oldbufptr && PL_oldbufptr != PL_bufptr) {
6345 while (isSPACE(*PL_oldoldbufptr))
6346 PL_oldoldbufptr++;
6347 context = PL_oldoldbufptr;
6348 contlen = PL_bufptr - PL_oldoldbufptr;
463ee0b2 6349 }
3280af22
NIS		 6350 else if (PL_bufptr > PL_oldbufptr && PL_bufptr - PL_oldbufptr < 200 &&
6351 PL_oldbufptr != PL_bufptr) {
6352 while (isSPACE(*PL_oldbufptr))
6353 PL_oldbufptr++;
6354 context = PL_oldbufptr;
6355 contlen = PL_bufptr - PL_oldbufptr;
463ee0b2
LW		 6356 }
6357 else if (yychar > 255)
68dc0745 6358 where = "next token ???";
463ee0b2 6359 else if ((yychar & 127) == 127) {
3280af22
NIS		 6360 if (PL_lex_state == LEX_NORMAL ||
6361 (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL))
68dc0745 6362 where = "at end of line";
3280af22 6363 else if (PL_lex_inpat)
68dc0745 6364 where = "within pattern";
463ee0b2 6365 else
68dc0745 6366 where = "within string";
463ee0b2 6367 }
46fc3d4c 6368 else {
79cb57f6 6369 SV *where_sv = sv_2mortal(newSVpvn("next char ", 10));
46fc3d4c 6370 if (yychar < 32)
cea2e8a9 6371 Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
46fc3d4c 6372 else if (isPRINT_LC(yychar))
cea2e8a9 6373 Perl_sv_catpvf(aTHX_ where_sv, "%c", yychar);
463ee0b2 6374 else
cea2e8a9 6375 Perl_sv_catpvf(aTHX_ where_sv, "\\%03o", yychar & 255);
46fc3d4c 6376 where = SvPVX(where_sv);
463ee0b2 6377 }
46fc3d4c 6378 msg = sv_2mortal(newSVpv(s, 0));
cea2e8a9 6379 Perl_sv_catpvf(aTHX_ msg, " at %_ line %ld, ",
3280af22 6380 GvSV(PL_curcop->cop_filegv), (long)PL_curcop->cop_line);
68dc0745 6381 if (context)
cea2e8a9 6382 Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
463ee0b2 6383 else
cea2e8a9 6384 Perl_sv_catpvf(aTHX_ msg, "%s\n", where);
3280af22 6385 if (PL_multi_start < PL_multi_end && (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) {
cea2e8a9 6386 Perl_sv_catpvf(aTHX_ msg,
4fdae800 6387 " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
3280af22
NIS		 6388 (int)PL_multi_open,(int)PL_multi_close,(long)PL_multi_start);
6389 PL_multi_end = 0;
a0d0e21e 6390 }
faef0170 6391 if (PL_in_eval & EVAL_WARNONLY)
cea2e8a9 6392 Perl_warn(aTHX_ "%_", msg);
3280af22 6393 else if (PL_in_eval)
38a03e6e 6394 sv_catsv(ERRSV, msg);
463ee0b2 6395 else
46fc3d4c 6396 PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
3280af22 6397 if (++PL_error_count >= 10)
cea2e8a9 6398 Perl_croak(aTHX_ "%_ has too many errors.\n", GvSV(PL_curcop->cop_filegv));
3280af22
NIS		 6399 PL_in_my = 0;
6400 PL_in_my_stash = Nullhv;
463ee0b2
LW		 6401 return 0;
6402}
4e35701f 6403
161b471a 6404
Unnamed repository; edit this file 'description' to name the repository.