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