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