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