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